From 2eab822f4e47949f0e5cd40c65a502d293f9737a Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 23 Oct 2025 14:38:31 -0400 Subject: [PATCH 01/66] add kernel generation for EM. The kernels are empty for now. --- maxima/g0/gk_collisionless/dg_gk-surf.mac | 138 ++++++++++ maxima/g0/gk_collisionless/dg_gk-vol.mac | 35 +++ .../gk_collisionless_flux-surf-vpar.mac | 239 ++++++++++++++++++ .../ms-dg_gyrokinetic-header.mac | 17 +- .../ms-dg_gyrokinetic-surf_add_em.mac | 83 ++++++ .../ms-dg_gyrokinetic-vol_add_em.mac | 72 ++++++ .../ms-gk_collisionless_flux-header.mac | 50 ++-- .../ms-gk_collisionless_flux_add_em.mac | 84 ++++++ 8 files changed, 694 insertions(+), 24 deletions(-) create mode 100644 maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf_add_em.mac create mode 100644 maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_add_em.mac create mode 100644 maxima/g0/gk_collisionless/ms-gk_collisionless_flux_add_em.mac diff --git a/maxima/g0/gk_collisionless/dg_gk-surf.mac b/maxima/g0/gk_collisionless/dg_gk-surf.mac index 77901135..0ee3b64b 100644 --- a/maxima/g0/gk_collisionless/dg_gk-surf.mac +++ b/maxima/g0/gk_collisionless/dg_gk-surf.mac @@ -272,3 +272,141 @@ calcGKBoundarySurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrd )$ +calcGKAddEMSurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB) := block( + [pDim,varsC,bC,varsP,bP,vSub,surfVar,varLabel,dirLabel, + surfIntVars,surf_cvars,surf_vvars,surfNodes,bSurf,basisStr,NSurf,numNodes, + tempVars,tempBasis,NSurfIndexing,numNodesIndexing, + rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e, + BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, + hamil_e,alphaSurfL_e,alphaSurfR_e, + fl_e,fc_e,fr_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL, + fnodal_l_e, fnodal_r_e, fmodproj_e], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), + basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) + ), + NSurf : length(bSurf), + numNodes : length(surfNodes), + /* if polyOrder = 1 and we're doing the vpar update, we need to be careful about + indexing input arrays since the surface hybrid basis has a different size at the + vparallel surfaces */ + if (surfDir = cdim+1 and polyOrder = 1) then ( + tempVars : delete(x,varsP), + tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), + NSurfIndexing : length(tempBasis), + numNodesIndexing : length(tempBasis), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) + ) else ( + NSurfIndexing : NSurf, + numNodesIndexing : numNodes, + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) + ), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_c, const double *vmap_prime_r, + const double *flux_surf_l, const double *flux_surf_r, + double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap_prime_l,vmap_prime_c,vmap_prime_r: velocity space mapping derivative in left, center and right cells.~%"), + printf(fh, " // flux_surf_l: Surface expansion of phase space flux on the left.~%"), + printf(fh, " // flux_surf_r: Surface expansion of phase space flux on the right.~%"), + printf(fh, " // out: output increment in center cell.~%"), + printf(fh, "~%"), + printf(fh, " return 0.0; ~%"), + printf(fh, "~%"), + + printf(fh, "} ~%"), + flush_output(fh) + +)$ + +calcGKAddEMBoundarySurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB) := block( + [pDim,varsC,bC,varsP,bP,vSub,surfVar,varLabel,dirLabel, + surfIntVars,surf_cvars,surf_vvars,surfNodes,bSurf,basisStr,NSurf,numNodes, + tempVars,tempBasis,NSurfIndexing,numNodesIndexing, + rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e, + BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, + hamil_e,alphaUpL_e,alphaSurfL_e,alphaUpSurfL_e,alphaUpR_e,alphaSurfR_e,alphaUpSurfR_e, + fEdge_e,fSkin_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), + basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) + ), + NSurf : length(bSurf), + numNodes : length(surfNodes), + + /* if polyOrder = 1 and we're doing the vpar update, we need to be careful about + indexing input arrays since the surface hybrid basis has a different size at the + vparallel surfaces */ + if (surfDir = cdim+1 and polyOrder = 1) then ( + tempVars : delete(x,varsP), + tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), + NSurfIndexing : length(tempBasis), + numNodesIndexing : length(tempBasis), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) + ) else ( + NSurfIndexing : NSurf, + numNodesIndexing : numNodes, + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) + ), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, + const double *vmap_prime_edge, const double *vmap_prime_skin, + const double *flux_surf_edge, const double *flux_surf_skin, + const int edge, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap_prime_edge,vmap_prime_skin: velocity space mapping derivative in edge and skin cells.~%"), + printf(fh, " // flux_surf_edge: Surface expansion of phase space flux on the lower edges of the edge cell.~%"), + printf(fh, " // flux_surf_skin: Surface expansion of phase space flux on the lower edges of the skin cell.~%"), + printf(fh, " // edge: determines if the update is for the left edge (-1) or right edge (+1).~%"), + printf(fh, " // out: output increment in center cell.~%"), + printf(fh, "~%"), + printf(fh, " return 0.0; ~%"), + printf(fh, "~%"), + + printf(fh, "} ~%"), + flush_output(fh) + +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 01905ad3..5021a5f9 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -257,3 +257,38 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := printf(fh, "} ~%") )$ + +buildGKAddEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( + [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, + bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, + hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, + dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + varLabel : makelist(string(varsP[d]),d,1,pDim), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, const double *vmap, const double *vmapSq, + const double q_, const double m_, const double *bmag, const double *phi, + const double *apar, const double *rtg33inv, const double *bioverJB, + const double *fin, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // bmag: magnetic field amplitude.~%"), + printf(fh, " // phi: electrostatic potential .~%"), + printf(fh, " // apar: parallel component of vector potential.~%"), + printf(fh, " // fin: Distribution function.~%"), + printf(fh, " // out: output increment.~%"), + printf(fh, "~%"), + + printf(fh, " return 0.; ~%"), + printf(fh, "} ~%") +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index a172abb2..617facd2 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -240,3 +240,242 @@ buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, "} ~%") )$ + +buildGKFluxVparAddEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge) := block( + [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, + surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, + numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, + bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, + hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr + ], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + surfIntVarsC : delete(surfVar,varsC), + bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + nodeVars : surfIntVars, + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + nodeVars : surfIntVars, + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) + ), + configNodes : gaussOrd(polyOrder+1, cdim), + numSurfNodes : length(surfNodes), + numConfigNodes : length(configNodes), + numVelNodes : numSurfNodes/numConfigNodes, + + /* if polyOrder = 1, we need to be careful about + indexing input arrays since the surface hybrid basis has a different size in the + vparallel surfaces and/or we are more directly exploiting the sparsity of + alpha (e.g., in the x and z direction when no toroidal field, by=0) + and thus utilize fewer coefficients to reduce the number of operations */ + if (polyOrder = 1) then ( + tempVars : delete(x,varsP), + tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), + NSurfIndexing : length(tempBasis), + numNodesIndexing : length(tempBasis) + ) else ( + NSurfIndexing : NSurf, + numNodesIndexing : numNodes + ), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // dgv: volume DG geometry.~%"), + printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), + printf(fh, " // bmag: magnetic field amplitude.~%"), + printf(fh, " // phi: electrostatic potential.~%"), + printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), + printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), + printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), + printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), + printf(fh, "~%"), + if false then ( + /* Declare cell-center variables and variables multiplying gradients. */ + for d : 1 thru cdim+1 do ( + printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) + ), + printf(fh, "~%"), + rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + /* Axisymmetric basis (independent of y). */ + bmagBasis : getAxisymmetricConfBasis(bC), + + /* Expand input fields for Hamiltonian calculation */ + phi_e : doExpand1(phi,bC), + bmag_e : doExpand1(bmag, bmagBasis), + + /* Velocity mapping fields. */ + [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + + /* Redefine vmap_prime to exploit the relationship between it and vmap. */ + /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ + vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), + + if edge = true then ( + evPoint : 1 + ) else ( + evPoint : -1 + ), + + /* Finally write out the hamiltonian*/ + hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), + hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), + printf(fh, " double hamil[~a] = {0.}; ~%", numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + hamilCvar : eval_string(sconcat("hamil")), + writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), + printf(fh, "~%"), + flush_output(fh), + hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), + /* Expand projected Hamiltonian on basis. */ + hamil_e : hamilNoZero_c . bP, + /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ + + /*fl and fr */ + JfL_e : doExpand1(JfL, bP), + JfR_e : doExpand1(JfR, bP), + JfL_c : calcInnerProdList(varsP, 1, bP, JfL_e), + JfR_c : calcInnerProdList(varsP, 1, bP, JfR_e), + + JfL_e : subst(surfVar=1,JfL_e), + JfR_e : subst(surfVar=-1,JfR_e), + + JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), + JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), + + vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), + + vpardim : pDim-1, + if vdim = 1 then ( vpardim : pDim ), + dH_dz_nodes : makelist(0, i, 1, pDim), + for i : 1 thru vpardim do ( + if i = vpardim then ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars)), + dH_dz_nodes[i] : subst(surfVar=evPoint, dH_dz_nodes[i]) + ) + else ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ) + ), + + /* Now calculate apha at all quadrature nodes */ + /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ + printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), + printf(fh, " double cfl = 0.0; ~%"), + printf(fh, " double bmag_quad = 0.0; ~%"), + printf(fh, " double B3_quad = 0.0; ~%"), + printf(fh, " double Jc_quad = 0.0; ~%"), + printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), + + printf(fh, " double alpha_quad = 0.0; ~%"), + printf(fh, " double JfL_quad = 0.0; ~%"), + printf(fh, " double JfR_quad = 0.0; ~%"), + printf(fh, " double Jfavg_quad = 0.0; ~%"), + printf(fh, " double Jfjump_quad = 0.0; ~%"), + printf(fh, "~%"), + + for i : 1 thru numConfigNodes do ( + printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i-1), + printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i-1), + printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i-1), + printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i-1), + printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i-1), + printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i-1), + printf(fh, "~%"), + for j : 1 thru numVelNodes do ( + j0index : j-1+(i-1)*numVelNodes, + j1index : j+(i-1)*numVelNodes, + printf(fh, "~%"), + if no_by = true then ( + printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ;~%", dH_dz_nodes[cdim][j1index]) + ), + if no_by = false then ( + printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ", dH_dz_nodes[cdim][j1index]), + if cdim = 3 then ( + for k : 1 thru cdim do ( + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[k][j1index], k-1, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) + ) + ), + if cdim = 2 then ( + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 0, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) + ), + if cdim = 1 then ( + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) + ), + printf(fh, ";~%") + ), + + printf(fh, "~%"), + printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), + printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), + printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), + printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), + printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) + ), + printf(fh, "~%") + ), + + /* Do the quad nodal to modal ops directly here*/ + /*printf(fh, "~%"), + printf(fh, " double *fmodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), + flux_surf_nodal_e : doExpand1(flux_surf_nodal,basisNodal), + fmodproj_e : fullratsimp(calcInnerProdList(surfIntVars, 1, bSurf, flux_surf_nodal_e)), + + for i : 1 thru length(fmodproj_e) do ( + printf(fh, " fmodal[~a] = ~a; ~%", i-1, float(expand(fmodproj_e[i]))) + ), + + printf(fh, "~%"),*/ + /*Calculate the cfl*/ + pOrderCFL : polyOrder, + if polyOrder=1 then ( pOrderCFL : 2 ), + printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), + vprimeStr : "/vmap_prime_min", + printf(fh, "~%"), + printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), + + printf(fh, "~%") + ) else ( + printf(fh, " return 0.; ~%") + ), + flush_output(fh), + printf(fh, "} ~%") + +)$ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac index 08e41563..7282821a 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac @@ -53,7 +53,12 @@ printPrototypes() := block([], const double *bmag, const double *phi, const double *dualcurlbhatoverB, const double *rtg33inv, const double* bioverJB, const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), - + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_vol_~ax~av_~a_p~a(const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const double *bmag, const double *phi, + const double *dualcurlbhatoverB, const double *rtg33inv, const double* bioverJB, + const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), + for surfDir : 1 thru c+1 do ( if surfDir<=c then ( dirlabel : varsC[surfDir] @@ -78,9 +83,19 @@ printPrototypes() := block([], const double *flux_surf_l, const double *flux_surf_r, double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder), printf(fh, "GKYL_CU_DH double dg_gyrokinetic_boundary_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, + const double *vmap_prime_edge, const double *vmap_prime_skin, + const double *flux_surf_edge, const double *flux_surf_skin, + const int edge, double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder), + if dirlabel=vpar then ( + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_c, const double *vmap_prime_r, + const double *flux_surf_l, const double *flux_surf_r, + double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder), + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_boundary_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, const double *vmap_prime_edge, const double *vmap_prime_skin, const double *flux_surf_edge, const double *flux_surf_skin, const int edge, double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder) + ) ), printf(fh, "~%") ) diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf_add_em.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf_add_em.mac new file mode 100644 index 00000000..b4519e55 --- /dev/null +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf_add_em.mac @@ -0,0 +1,83 @@ +/* + Generate the surface kernels for gyrokinetics with general geometry. + Assumes surface alpha pre-computed so kernels are agnostic to different + forms of gyrokinetics (electrostatic vs. electromagnetic, etc.) + + The functions called in this file are in gkFuncs-surf.mac. +*/ +load("gk_collisionless/dg_gk-surf")$ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 1$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor order basis. No need to generate p=1. */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 1$ +maxCdim_Tensor : 0$ + +/* Vdim possibilities for each of Cdim=[1,2,3]. */ +gkVdims : [[1,2], [2], [2]]$ + +/* ...... END OF USER INPUTS........ */ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +clabels : ["x","y","z"]$ +vlabels : ["vpar","mu"]$ + +/* Possible combinations of variable dependence of background magnetic field. + with [] = const. Note that we assume axisymmetry, which means B cannot depend on y. */ +bVarsList : [x,z]$ + +includeSurfHeaders(fhIn, bname, c, v, porder, dir) := block([], + printf(fhIn, "#include ~%"), + if porder = 1 then ( /* Force hybrid basis (p=2 in velocity space). */ + printf(fhIn, "#include ~%", c, v) + ) elseif porder > 1 then ( + printf(fhIn, "#include ~%", bname, c+v, porder) + ) +)$ + +/* Generate kernels of selected types. */ +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ + for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + /* Advection in velocity space.*/ + fname : sconcat("~/max-out/dg_gyrokinetic_add_em_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), + disp(printf(false,"Creating surface file: ~a",fname)), + + fh : openw(fname), + includeSurfHeaders(fh, bName[bInd], c, v, polyOrder, c+1), + funcName : sconcat("dg_gyrokinetic_add_em_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + calcGKAddEMSurfUpdateInDir(c+1, fh, funcName, c, v, bName[bInd], polyOrder, bVarsList), + close(fh), + + /* Advection in velocity space in the skin cell along vpar (for zero-flux BCs).*/ + fname : sconcat("~/max-out/dg_gyrokinetic_add_em_boundary_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), + disp(printf(false,"Creating surface file: ~a",fname)), + + fh : openw(fname), + includeSurfHeaders(fh, bName[bInd], c, v, polyOrder, c+1), + funcName : sconcat("dg_gyrokinetic_add_em_boundary_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + calcGKAddEMBoundarySurfUpdateInDir(c+1, fh, funcName, c, v, bName[bInd], polyOrder, bVarsList), + close(fh) + ) + ) + ) +)$ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_add_em.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_add_em.mac new file mode 100644 index 00000000..06d70168 --- /dev/null +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_add_em.mac @@ -0,0 +1,72 @@ +/* + Generate the volume kernels for collisionless gyrokinetic terms. + + The functions called in this file are in gkFuncs-vol.mac. +*/ +load("gk_collisionless/dg_gk-vol")$ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 1$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor order basis. No need to generate p=1. */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 2$ +minCdim_Tensor : 1$ +maxCdim_Tensor : 0$ + +/* Vdim possibilities for each of Cdim=[1,2,3]. */ +gkVdims : [[1,2], [2], [2]]$ + +/* ...... END OF USER INPUTS........ */ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +/* Possible combinations of variable dependence of background magnetic field. + with [] = const. Note that we assume axisymmetry, which means B cannot depend on y. */ +bVarsList : [x,z]$ + +/* Generate kernels of selected types. */ +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ + for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + fname : sconcat("~/max-out/dg_gyrokinetic_add_em_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating volume file: ~a",fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("dg_gyrokinetic_add_em_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + buildGKAddEMVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, false), + close(fh) + + /* if cdim > 1, also generate a set of kernels for the case where there is no toroidal field (by = 0) */ + /* if (c > 1) then ( + fname : sconcat("~/max-out/dg_gyrokinetic_no_by_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating volume file (no by): ~a",fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("dg_gyrokinetic_no_by_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + buildGKVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, true), + close(fh) + ) */ + ) + ) + ) +)$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index ebef045a..1a8bdcef 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -34,9 +34,10 @@ maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ maxVdim : [maxVdim_Ser, maxVdim_Tensor]$ /* Options for writing kernels with and without toroidal field (b_y=0), one per - dimension. */ -byOpt : [[false], [false, true], [false, true]]$ -byStr : ["", "no_by_"]$ + dimension, or make the kernel only add electromagnetic terms. */ +byOpt : [[false, false], [false, false, false], [false, false, true]]$ +emOpt : [[false, true], [false, true, false], [false, true, false]]$ +optStr : ["", "add_em_", "no_by_"]$ /* Options for writing kernels used at multiblock boundaries. One for each dimension. */ @@ -55,48 +56,51 @@ printPrototypes() := block([], for byI : 1 thru length(byOpt[c]) do ( no_by : byOpt[c][byI], - no_byStr : byStr[byI], - - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], - - for surfDir : 1 thru c do ( - dirlabel : varsC[surfDir], - extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", - vprimeargs : "", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~asurf~a_~ax~av_~a_p~a( + add_em : emOpt[c][byI], + opt_str : optStr[byI], + if not(add_em) then ( + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], + + for surfDir : 1 thru c do ( + dirlabel : varsC[surfDir], + extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", + vprimeargs : "", + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~asurf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + double* GKYL_RESTRICT flux_surf); ~%", opt_str, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + double* GKYL_RESTRICT flux_surf); ~%", opt_str, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + ) ) ), - dirlabel : varsV[1], - extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", - vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~asurf~a_~ax~av_~a_p~a( + dirlabel : varsV[1], + extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", + vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~asurf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", no_byStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + double* GKYL_RESTRICT flux_surf); ~%", opt_str, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) ), printf(fh, "~%") diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_add_em.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_add_em.mac new file mode 100644 index 00000000..5f4b9bfc --- /dev/null +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_add_em.mac @@ -0,0 +1,84 @@ +/* + Generate the kernel for surface expansions of the phase space characteristics. + + The functions called in this file are in gkFuncs-alpha-surf.mac. +*/ +load("gk_collisionless/gk_collisionless_flux-surf-conf")$ +load("gk_collisionless/gk_collisionless_flux-surf-vpar")$ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 1$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor order basis. No need to generate p=1. */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 2$ +minCdim_Tensor : 1$ +maxCdim_Tensor : 0$ + +/* ...... END OF USER INPUTS........ */ + +/* Vdim possibilities for each of Cdim=[1,2,3]. */ +gkVdims : [[1,2], [2], [2]]$ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +clabels : ["x","y","z"]$ +vlabels : ["vpar","mu"]$ + +/* Options for writing kernels with and without toroidal field (b_y=0), one per + dimension, or make the kernel only add electromagnetic terms. */ +byOpt : [[false, false], [false, false, false], [false, false, true]]$ +emOpt : [[false, true], [false, true, false], [false, true, false]]$ +optStr : ["", "add_em_", "no_by_"]$ + +/* Options for writing kernels used at multiblock boundaries. One for each + dimension. */ +mb_bcOpt : [[false,true],[false,true],[false,true]]$ +mb_bcStr : ["", "multib_boundary_"]$ + +/* Generate kernels of selected types. */ +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ + + for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + for byI : 1 thru length(byOpt[c]) do ( + no_by : byOpt[c][byI], + add_em : emOpt[c][byI], + opt_str : optStr[byI], + + if add_em then ( + /* Surface flux in vparallel direction.*/ + fname : sconcat("~/max-out/gk_collisionless_flux_",opt_str,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar ~a file: ~a",opt_str,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_collisionless_flux_",opt_str,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + if add_em then ( + buildGKFluxVparAddEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false) + ) else ( + buildGKFluxVparESKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false) + ), + close(fh) + ) + ) + ) + ) + ) +)$ From 598b7a0ddf4f5d533b5cc1d767a754bef9b84f7e Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 23 Oct 2025 14:40:28 -0400 Subject: [PATCH 02/66] change the path to a generic path --- maxima/g0/twist_shift_calc/twistShift-calc.mac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/maxima/g0/twist_shift_calc/twistShift-calc.mac b/maxima/g0/twist_shift_calc/twistShift-calc.mac index 097320c4..868f546d 100644 --- a/maxima/g0/twist_shift_calc/twistShift-calc.mac +++ b/maxima/g0/twist_shift_calc/twistShift-calc.mac @@ -41,7 +41,7 @@ for bInd : 1 thru length(bName) do ( print("pOrder = ",pOrder), vStr : "", if (v>0) then (vStr: sconcat(v,"v")), - fname : sconcat("/home/akash/max-out/bc_twistshift_gyrokinetic_", bName[bInd], "_", c, "x", vStr, "_p", pOrder, ".c"), + fname : sconcat("~/max-out/bc_twistshift_gyrokinetic_", bName[bInd], "_", c, "x", vStr, "_p", pOrder, ".c"), fh : openw(fname), disp(printf(false,sconcat("Creating ~ax", vStr, "P~a ", bName[bInd]),c,pOrder)), From ea126b3fb4a9dc7b0d47c3407cea4c5b520b98a6 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 23 Oct 2025 14:59:38 -0400 Subject: [PATCH 03/66] reorganize the em scripts and code. The em kernels are still empty --- maxima/g0/gk_collisionless/dg_gk-surf.mac | 139 --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 35 - .../g0/gk_collisionless/em/dg_gk-surf_em.mac | 158 +++ .../g0/gk_collisionless/em/dg_gk-vol_em.mac | 327 ++++++ maxima/g0/gk_collisionless/em/gkUtil.mac | 954 ++++++++++++++++++ .../em/gk_collisionless_flux-surf-vpar_em.mac | 244 +++++ .../ms-dg_gyrokinetic-surf_em.mac} | 0 .../ms-dg_gyrokinetic-vol_em.mac} | 0 .../em/ms-gk_collisionless_flux-header_em.mac | 126 +++ .../ms-gk_collisionless_flux_em.mac} | 0 .../gk_collisionless_flux-surf-conf.mac | 2 +- .../gk_collisionless_flux-surf-vpar.mac | 241 +---- .../ms-dg_gyrokinetic-header.mac | 19 +- .../ms-dg_gyrokinetic-surf.mac | 2 +- .../ms-dg_gyrokinetic-vol.mac | 2 +- .../ms-gk_collisionless_flux-header.mac | 52 +- .../ms-gk_collisionless_flux.mac | 2 +- 17 files changed, 1840 insertions(+), 463 deletions(-) create mode 100644 maxima/g0/gk_collisionless/em/dg_gk-surf_em.mac create mode 100644 maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac create mode 100644 maxima/g0/gk_collisionless/em/gkUtil.mac create mode 100644 maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac rename maxima/g0/gk_collisionless/{ms-dg_gyrokinetic-surf_add_em.mac => em/ms-dg_gyrokinetic-surf_em.mac} (100%) rename maxima/g0/gk_collisionless/{ms-dg_gyrokinetic-vol_add_em.mac => em/ms-dg_gyrokinetic-vol_em.mac} (100%) create mode 100644 maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac rename maxima/g0/gk_collisionless/{ms-gk_collisionless_flux_add_em.mac => em/ms-gk_collisionless_flux_em.mac} (100%) diff --git a/maxima/g0/gk_collisionless/dg_gk-surf.mac b/maxima/g0/gk_collisionless/dg_gk-surf.mac index 0ee3b64b..b657bab1 100644 --- a/maxima/g0/gk_collisionless/dg_gk-surf.mac +++ b/maxima/g0/gk_collisionless/dg_gk-surf.mac @@ -271,142 +271,3 @@ calcGKBoundarySurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrd flush_output(fh) )$ - -calcGKAddEMSurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB) := block( - [pDim,varsC,bC,varsP,bP,vSub,surfVar,varLabel,dirLabel, - surfIntVars,surf_cvars,surf_vvars,surfNodes,bSurf,basisStr,NSurf,numNodes, - tempVars,tempBasis,NSurfIndexing,numNodesIndexing, - rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e, - BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, - hamil_e,alphaSurfL_e,alphaSurfR_e, - fl_e,fc_e,fr_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL, - fnodal_l_e, fnodal_r_e, fmodproj_e], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), - basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) - ), - NSurf : length(bSurf), - numNodes : length(surfNodes), - /* if polyOrder = 1 and we're doing the vpar update, we need to be careful about - indexing input arrays since the surface hybrid basis has a different size at the - vparallel surfaces */ - if (surfDir = cdim+1 and polyOrder = 1) then ( - tempVars : delete(x,varsP), - tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), - NSurfIndexing : length(tempBasis), - numNodesIndexing : length(tempBasis), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) - ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes, - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) - ), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_c, const double *vmap_prime_r, - const double *flux_surf_l, const double *flux_surf_r, - double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap_prime_l,vmap_prime_c,vmap_prime_r: velocity space mapping derivative in left, center and right cells.~%"), - printf(fh, " // flux_surf_l: Surface expansion of phase space flux on the left.~%"), - printf(fh, " // flux_surf_r: Surface expansion of phase space flux on the right.~%"), - printf(fh, " // out: output increment in center cell.~%"), - printf(fh, "~%"), - printf(fh, " return 0.0; ~%"), - printf(fh, "~%"), - - printf(fh, "} ~%"), - flush_output(fh) - -)$ - -calcGKAddEMBoundarySurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB) := block( - [pDim,varsC,bC,varsP,bP,vSub,surfVar,varLabel,dirLabel, - surfIntVars,surf_cvars,surf_vvars,surfNodes,bSurf,basisStr,NSurf,numNodes, - tempVars,tempBasis,NSurfIndexing,numNodesIndexing, - rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e, - BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, - hamil_e,alphaUpL_e,alphaSurfL_e,alphaUpSurfL_e,alphaUpR_e,alphaSurfR_e,alphaUpSurfR_e, - fEdge_e,fSkin_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), - basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) - ), - NSurf : length(bSurf), - numNodes : length(surfNodes), - - /* if polyOrder = 1 and we're doing the vpar update, we need to be careful about - indexing input arrays since the surface hybrid basis has a different size at the - vparallel surfaces */ - if (surfDir = cdim+1 and polyOrder = 1) then ( - tempVars : delete(x,varsP), - tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), - NSurfIndexing : length(tempBasis), - numNodesIndexing : length(tempBasis), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) - ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes, - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) - ), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, - const double *vmap_prime_edge, const double *vmap_prime_skin, - const double *flux_surf_edge, const double *flux_surf_skin, - const int edge, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap_prime_edge,vmap_prime_skin: velocity space mapping derivative in edge and skin cells.~%"), - printf(fh, " // flux_surf_edge: Surface expansion of phase space flux on the lower edges of the edge cell.~%"), - printf(fh, " // flux_surf_skin: Surface expansion of phase space flux on the lower edges of the skin cell.~%"), - printf(fh, " // edge: determines if the update is for the left edge (-1) or right edge (+1).~%"), - printf(fh, " // out: output increment in center cell.~%"), - printf(fh, "~%"), - printf(fh, " return 0.0; ~%"), - printf(fh, "~%"), - - printf(fh, "} ~%"), - flush_output(fh) - -)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 5021a5f9..fccd4ab1 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -256,39 +256,4 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := printf(fh, " return 0.; ~%"), printf(fh, "} ~%") -)$ - -buildGKAddEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( - [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, - bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, - hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - varLabel : makelist(string(varsP[d]),d,1,pDim), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, const double *vmap, const double *vmapSq, - const double q_, const double m_, const double *bmag, const double *phi, - const double *apar, const double *rtg33inv, const double *bioverJB, - const double *fin, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // bmag: magnetic field amplitude.~%"), - printf(fh, " // phi: electrostatic potential .~%"), - printf(fh, " // apar: parallel component of vector potential.~%"), - printf(fh, " // fin: Distribution function.~%"), - printf(fh, " // out: output increment.~%"), - printf(fh, "~%"), - - printf(fh, " return 0.; ~%"), - printf(fh, "} ~%") )$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/em/dg_gk-surf_em.mac b/maxima/g0/gk_collisionless/em/dg_gk-surf_em.mac new file mode 100644 index 00000000..f2facaa3 --- /dev/null +++ b/maxima/g0/gk_collisionless/em/dg_gk-surf_em.mac @@ -0,0 +1,158 @@ +/* + Create kernels for the surface term of the gyrokinetic collisionless terms. +*/ +load("modal-basis")$ +load("out-scripts")$ +load(stringproc)$ +load("scifac")$ +load("utilities_gyrokinetic")$ +load("nodal_operations/nodal_functions")$ +fpprec : 24$ + +/* Types of boundary stencils: + - domain_bound: Domain boundary. + - interblock_bound: Interblock boundary. +*/ +bound_surf_bc_type : ["domain_bound","interblock_bound"]$ + +/* Boundary sidex. */ +bound_side : ["lower","upper"]$ + +calcGKAddEMSurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB) := block( + [pDim,varsC,bC,varsP,bP,vSub,surfVar,varLabel,dirLabel, + surfIntVars,surf_cvars,surf_vvars,surfNodes,bSurf,basisStr,NSurf,numNodes, + tempVars,tempBasis,NSurfIndexing,numNodesIndexing, + rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e, + BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, + hamil_e,alphaSurfL_e,alphaSurfR_e, + fl_e,fc_e,fr_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL, + fnodal_l_e, fnodal_r_e, fmodproj_e], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), + basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) + ), + NSurf : length(bSurf), + numNodes : length(surfNodes), + /* if polyOrder = 1 and we're doing the vpar update, we need to be careful about + indexing input arrays since the surface hybrid basis has a different size at the + vparallel surfaces */ + if (surfDir = cdim+1 and polyOrder = 1) then ( + tempVars : delete(x,varsP), + tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), + NSurfIndexing : length(tempBasis), + numNodesIndexing : length(tempBasis), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) + ) else ( + NSurfIndexing : NSurf, + numNodesIndexing : numNodes, + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) + ), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_c, const double *vmap_prime_r, + const double *flux_surf_l, const double *flux_surf_r, + double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap_prime_l,vmap_prime_c,vmap_prime_r: velocity space mapping derivative in left, center and right cells.~%"), + printf(fh, " // flux_surf_l: Surface expansion of phase space flux on the left.~%"), + printf(fh, " // flux_surf_r: Surface expansion of phase space flux on the right.~%"), + printf(fh, " // out: output increment in center cell.~%"), + printf(fh, "~%"), + printf(fh, " return 0.0; ~%"), + printf(fh, "~%"), + + printf(fh, "} ~%"), + flush_output(fh) + +)$ + +calcGKAddEMBoundarySurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB) := block( + [pDim,varsC,bC,varsP,bP,vSub,surfVar,varLabel,dirLabel, + surfIntVars,surf_cvars,surf_vvars,surfNodes,bSurf,basisStr,NSurf,numNodes, + tempVars,tempBasis,NSurfIndexing,numNodesIndexing, + rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e, + BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, + hamil_e,alphaUpL_e,alphaSurfL_e,alphaUpSurfL_e,alphaUpR_e,alphaSurfR_e,alphaUpSurfR_e, + fEdge_e,fSkin_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), + basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) + ), + NSurf : length(bSurf), + numNodes : length(surfNodes), + + /* if polyOrder = 1 and we're doing the vpar update, we need to be careful about + indexing input arrays since the surface hybrid basis has a different size at the + vparallel surfaces */ + if (surfDir = cdim+1 and polyOrder = 1) then ( + tempVars : delete(x,varsP), + tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), + NSurfIndexing : length(tempBasis), + numNodesIndexing : length(tempBasis), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) + ) else ( + NSurfIndexing : NSurf, + numNodesIndexing : numNodes, + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) + ), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, + const double *vmap_prime_edge, const double *vmap_prime_skin, + const double *flux_surf_edge, const double *flux_surf_skin, + const int edge, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap_prime_edge,vmap_prime_skin: velocity space mapping derivative in edge and skin cells.~%"), + printf(fh, " // flux_surf_edge: Surface expansion of phase space flux on the lower edges of the edge cell.~%"), + printf(fh, " // flux_surf_skin: Surface expansion of phase space flux on the lower edges of the skin cell.~%"), + printf(fh, " // edge: determines if the update is for the left edge (-1) or right edge (+1).~%"), + printf(fh, " // out: output increment in center cell.~%"), + printf(fh, "~%"), + printf(fh, " return 0.0; ~%"), + printf(fh, "~%"), + + printf(fh, "} ~%"), + flush_output(fh) + +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac b/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac new file mode 100644 index 00000000..678f4a6a --- /dev/null +++ b/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac @@ -0,0 +1,327 @@ +/* + Create kernels for the volume term of the gyrokinetic collisionless terms. +*/ + +load("modal-basis")$ +load("out-scripts")$ +load(stringproc)$ +load("scifac")$ +load("utilities_gyrokinetic")$ +load("utilities")$ +fpprec : 24$ + +buildGKAddEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( + [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, + bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, + hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, + dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + varLabel : makelist(string(varsP[d]),d,1,pDim), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, const double *vmap, const double *vmapSq, + const double q_, const double m_, const double *bmag, const double *phi, + const double *apar, const double *rtg33inv, const double *bioverJB, + const double *fin, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // bmag: magnetic field amplitude.~%"), + printf(fh, " // phi: electrostatic potential .~%"), + printf(fh, " // apar: parallel component of vector potential.~%"), + printf(fh, " // fin: Distribution function.~%"), + printf(fh, " // out: output increment.~%"), + printf(fh, "~%"), + + + /* Declare cell-center variables and variables multiplying gradients. */ + for d : 1 thru pDim do ( + printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) + ), + printf(fh, "~%"), + rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + + /* Declare variables with squared of cell centers and rdx2 variables (only need vpar^2). */ + printf(fh, " double rdvpar2Sq = rdvpar2*rdvpar2;~%"), + printf(fh, " double dvparSq = dxv[~a]*dxv[~a];~%", cdim, cdim), + printf(fh, "~%"), + replaceList : [rdvpar2^2=rdvpar2Sq,dxv[cdim]^2=dvparSq,rdvpar2Sq=4/dvparSq], + dvparSimp : append(makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pDim), + [dvparSq=4/rdvpar2Sq]), + + /* Create pointers to the components of b_i. */ + allVarLabelsC : ["x","y","z"], + for d : 1 thru 3 do ( + printf(fh, " const double *bioverJB_~a = &bioverJB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) + ), + printf(fh, "~%"), + + /* Create pointers to the components of dualcurlbhatoverB. */ + allVarLabelsC : ["x","y","z"], + for d : 1 thru 3 do ( + printf(fh, " const double *dualcurlbhatoverB_~a = &dualcurlbhatoverB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) + ), + printf(fh, "~%"), + + /* Axisymmetric basis (independent of y). */ + bmagBasis : getAxisymmetricConfBasis(bC), + /* Expand input fields for Hamiltonian calculation */ + phi_e : doExpand1(phi,bC), + apar_e : doExpand1(apar,bC), + bmag_e : doExpand1(bmag, bmagBasis), + + + /* dualcurlbhatoverB_x_e : doExpand1(dualcurlbhatoverB_x, bmagBasis), + dualcurlbhatoverB_y_e : doExpand1(dualcurlbhatoverB_y, bmagBasis), + dualcurlbhatoverB_z_e : doExpand1(dualcurlbhatoverB_z, bmagBasis), */ + /* Zero out some terms below to avoid the discontinuity of alpha in the + parallel direction (due to the discontinuity of Apar). Otherwise some + other treatment of some Apar terms or alpha may be needed. Initially we + had a step averaging alpha across the surface (just for the parallel + direction), but NRM suspects this might've caused instability in some + cases. Hence the zeros below. */ + discontFac : 0, + if cdim > 1 then (rdy2 : rdx2vec[2]) else (rdy2 : 0), + if cdim > 2 then (rdz2 : rdx2vec[3]) else (rdz2 : 0), + /* Expand e^x . \nabla \times A_\parallel / Bmag on basis. */ + dualcurlbAparoverB_x_e : (rdy2*diff(apar_e*b_z_e,y) - discontFac*rdz2*diff(apar_e*b_y_e,z))*jacobTotInv_e, + /* Expand e^y . \nabla \times A_\parallel / Bmag on basis. */ + dualcurlbAparoverB_y_e : (discontFac*rdz2*diff(apar_e*b_x_e,z) - rdx2vec[1]*diff(apar_e*b_z_e,x))*jacobTotInv_e, + /* Expand e^z . \nabla \times A_\parallel / Bmag on basis. */ + dualcurlbAparoverB_z_e : (discontFac*(rdx2vec[1]*diff(apar_e*b_y_e,x) - rdy2*diff(apar_e*b_x_e,y)))*jacobTotInv_e, + + varsP : listofvars(bP), + numP : length(bP), + + /* Project Bstar's onto basis, and print to arrays. */ + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + if cdim > 1 then ( + dualcurlbAparoverB_c : calcInnerProdList(varsP, 1, bP, dualcurlbAparoverB_x_e), + if (surfDir = 0 or surfDir = 1 or surfDir = cdim+1) then ( + printf(fh, " double dualcurlbAparoverB~a[~a] = {0.}; ~%", sideStr,numP), + writeCExprsNoExpand1(eval_string(sconcat("dualcurlbAparoverB",sideStr)), gcfac(subst(replaceList, dualcurlbAparoverB_c))), + printf(fh, "~%"), + flush_output(fh) + ), + dualcurlbAparoverB_noZero_c : makelistNoZeros1(dualcurlbAparoverB_c, eval_string(sconcat("dualcurlbAparoverB",sideStr))), + dualcurlbAparoverB_e : dualcurlbAparoverB_noZero_c . bP, + + dualcurlbAparoverB_y_c : calcInnerProdList(varsP, 1, bP, dualcurlbAparoverB_y_e), + if (surfDir = 0 or surfDir = 2 or surfDir = cdim+1) then ( + printf(fh, " double dualcurlbAparoverB_y~a[~a] = {0.}; ~%", sideStr, numP), + writeCExprsNoExpand1(eval_string(sconcat("dualcurlbAparoverB_y",sideStr)), gcfac(subst(replaceList, dualcurlbAparoverB_y_c))), + printf(fh, "~%"), + flush_output(fh) + ), + dualcurlbAparoverB_y_noZero_c : makelistNoZeros1(dualcurlbAparoverB_y_c, eval_string(sconcat("dualcurlbAparoverB_y",sideStr))), + dualcurlbAparoverB_y_e : dualcurlbAparoverB_y_noZero_c . bP + ), + if cdim # 2 then ( + dualcurlbAparoverB_z_c : calcInnerProdList(varsP, 1, bP, dualcurlbAparoverB_z_e), + if (surfDir=0 or surfDir>=cdim) then ( + printf(fh, " double dualcurlbAparoverB_z~a[~a] = {0.}; ~%", sideStr, numP), + writeCExprsNoExpand1(eval_string(sconcat("dualcurlbAparoverB_z",sideStr)), gcfac(subst(replaceList, dualcurlbAparoverB_z_c))), + printf(fh, "~%"), + flush_output(fh) + ), + dualcurlbAparoverB_z_noZero_c : makelistNoZeros1(dualcurlbAparoverB_z_c, eval_string(sconcat("dualcurlbAparoverB_z",sideStr))), + dualcurlbAparoverB_z_e : dualcurlbAparoverB_z_noZero_c . bP + ), + + /* Make Bstar/Bmag vector. */ + /* if cdim = 1 then ( + dualcurlbAparoverB_list : [dualcurlbAparoverB_z_e] + ) elseif cdim = 2 then ( + dualcurlbAparoverB_list : [dualcurlbAparoverB_x_e, dualcurlbAparoverB_y_e] + ) elseif cdim = 3 then ( + dualcurlbAparoverB_list : [dualcurlbAparoverB_x_e, dualcurlbAparoverB_y_e, dualcurlbAparoverB_z_e] + ), */ + + rtg33inv_e : doExpand1(rtg33inv, bmagBasis), + bioverJB_x_e : doExpand1(bioverJB_x, bmagBasis), + bioverJB_y_e : doExpand1(bioverJB_y, bmagBasis), + bioverJB_z_e : doExpand1(bioverJB_z, bmagBasis), + + dualcurlbAparoverB_list : [dualcurlbAparoverB_x_e, dualcurlbAparoverB_y_e, dualcurlbAparoverB_z_e], + bioverJB_list : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e], + + /* Velocity mapping fields. */ + [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + + /* Redefine vmap_prime to exploit the relationship between it and vmap. */ + vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), + + /* Finally write out the hamiltonian*/ + hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), + hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), + printf(fh, " double hamil[~a] = {0.}; ~%", numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + hamilCvar : eval_string(sconcat("hamil")), + writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), + printf(fh, "~%"), + flush_output(fh), + hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), + /* Expand projected Hamiltonian on basis. */ + hamil_e : hamilNoZero_c . bP, + + /*Expand Jf*/ + Jf_e : doExpand1(fin,bP), + + /* Calculate expressions for dericatives of the hamiltonian*/ + vpardim : pDim-1, + if vdim = 1 then ( vpardim : pDim ), + dH_dz_e : makelist(0, i, 1, pDim), + for i : 1 thru vpardim do ( + if i = vpardim then ( + dH_dz_e[i] : diff(hamil_e,varsP[i]) + ) + else ( + dH_dz_e[i] : diff(hamil_e*rdx2vec[i],varsP[i]) + ) + ), + + /*Make sure to avoid having hamil[i]^2 or vmap[i]^2 in expressions*/ + replaceListVpar : [vmap[1]^2=vmap2], + printf(fh, " double vmap2 = vmap[1]*vmap[1]; ~%"), + printf(fh, "~%"), + + mvpar_e : dH_dz_e[vpardim]/vmap_prime_e[1], + mvparsq_e : mvpar_e*mvpar_e/m_, + isqlist : [], + for i : 1 thru numP do ( + if freeof(hamil[i]^2, expand(mvparsq_e)) = false then ( + isqlist : append(isqlist,[i]) + ) + ), + + replaceListHamil : [], + printf(fh, " double hamil2[~a] = {0.}; ~%", length(isqlist)), + for i : 1 thru length(isqlist) do ( + printf(fh, " hamil2[~a] = hamil[~a]*hamil[~a]; ~%", i-1, isqlist[i], isqlist[i]), + replaceListHamil : append(replaceListHamil, [hamil[isqlist[i]]^2=hamil2[i-1]]) + ), + printf(fh, "~%"), + + /* Note: no contribution from mu. */ + for dir : 1 thru cdim+1 do ( + + dirLabel : varLabel[dir], + + wDir : eval_string(sconcat("w",dirLabel)), + rdDirVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + dirVar : varsP[dir], /* Variable in current direction. */ + + if dir = cdim then ( + alpha_e : rtg33inv_e*dH_dz_e[vpardim]/vmap_prime_e[1]/m_ + ) + else if dir = vpardim then ( + alpha_e : -rtg33inv_e * dH_dz_e[cdim]/m_ + ) + else ( + alpha_e : 0 + ), + + + if no_by = false then ( + if cdim = 3 then ( + curvdriftdir : dir + ), + if cdim = 2 then ( + if dir = 1 then ( + curvdriftdir : dir + ), + if dir = 2 then ( + curvdriftdir : 3 + ) + ), + if cdim = 1 then ( + curvdriftdir : 3 + ), + + if dir < vpardim then ( + alpha_e : alpha_e + dualcurlbAparoverB_list[curvdriftdir]*dH_dz_e[vpardim]/vmap_prime_e[1]*dH_dz_e[vpardim]/vmap_prime_e[1]/m_/q_ + ), + if cdim = 3 then ( + if dir = 1 then ( + alpha_e : alpha_e + 1/q_ * (bioverJB_list[2]*dH_dz_e[3] - bioverJB_list[3]*dH_dz_e[2]) + ), + if dir = 2 then ( + alpha_e : alpha_e + 1/q_ * (bioverJB_list[3]*dH_dz_e[1] - bioverJB_list[1]*dH_dz_e[3]) + ), + if dir = 3 then ( + alpha_e : alpha_e + 1/q_ * (bioverJB_list[1]*dH_dz_e[2] - bioverJB_list[2]*dH_dz_e[1]) + ) + ), + if cdim = 2 then ( + if dir = 1 then ( + alpha_e : alpha_e + 1/q_ * (bioverJB_list[2]*dH_dz_e[2]) + ), + if dir = 2 then ( + alpha_e : alpha_e - 1/q_ * (bioverJB_list[2]*dH_dz_e[1]) + ) + ), + if dir = vpardim then ( + if cdim = 3 then ( + for k : 1 thru cdim do ( + alpha_e : alpha_e - dualcurlbAparoverB_list[k]*dH_dz_e[k]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ + ) + ), + if cdim = 2 then ( + alpha_e : alpha_e - dualcurlbAparoverB_list[1]*dH_dz_e[1]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ - dualcurlbAparoverB_list[3]*dH_dz_e[2]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ + ), + if cdim = 1 then ( + alpha_e : alpha_e - dualcurlbAparoverB_list[3]*dH_dz_e[1]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ + ) + ) + + ), + + if dir < vpardim then ( + alpha_e : alpha_e*rdx2vec[dir] + ) + else if dir = vpardim then ( + alpha_e : alpha_e/vmap_prime_e[1] + ), + + /* Project alpha on basis and write to array. */ + printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), + alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), + alpha_c : subst(replaceList, alpha_c), + alpha_c : subst(replaceListHamil, alpha_c), + alpha_c : subst(replaceListVpar, alpha_c), + alpha_c : subst(dvparSimp, alpha_c), + alphaLabel : eval_string(sconcat(alpha, dirLabel)), + clst : [rdx2vec, rdv2vec, m_, q_, wvpar, rdvpar2Sq, + makelist(dxv[i-1],i,1,pDim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], + writeCExprsCollect1(alphaLabel, alpha_c, clst), + printf(fh, "~%"), + flush_output(fh), + alphaNoZero_c : makelistNoZeros1(alpha_c, alphaLabel), + alpha_e : doExpand(alphaNoZero_c, bP), + + alphaJf_e : alpha_e*Jf_e, + + printf(fh, "~%"), + volTerm_c : fullratsimp(calcInnerProdList(varsP, 1, diff(bP,varsP[dir]), alphaJf_e)), + volTerm_c : subst(replaceList, volTerm_c), + writeCIncrExprsNoExpand(gcfac(float(expand(volTerm_c)))), + flush_output(fh), + printf(fh, "~%") + + ), + + + printf(fh, " return 0.; ~%"), + printf(fh, "} ~%") +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/em/gkUtil.mac b/maxima/g0/gk_collisionless/em/gkUtil.mac new file mode 100644 index 00000000..b5914a42 --- /dev/null +++ b/maxima/g0/gk_collisionless/em/gkUtil.mac @@ -0,0 +1,954 @@ +/* + Utility functions for GK Maxima scripts. +*/ +load("vect")$ +load("nodal_operations/nodal_functions")$ +load("nodal_operations/quadrature_functions")$ +load("utilities_gyrokinetic")$ + +expandInputFields(bC,bP,dxv,bmagBasis) := block( + [varsP,pdim,cdim,vdim,bmag_e,bmagInv_e,phi_e,Apar_e,dApardt_e,dApardtPrev_e, + AparL_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,BdriftX_e,BdriftY_e,jnk, + vmapBasis,vmapSqBasis,vmap_c,vmapSq_c,vmapBnum,vmapSqBnum,d], + + varsP : listofvars(bP), + pdim : length(varsP), + cdim : length(listofvars(bC)), + vdim : pdim-cdim, + + /* Expand background magnetic field and potentials. */ + bmag_e : doExpand1(bmag,bmagBasis), + phi_e : doExpand1(phi,bC), + Apar_e : doExpand1(apar,bC), + dApardt_e : doExpand1(apardot,bC), + dApardtPrev_e : doExpand1(apardot_prev,bC), + /* NOTE: even though Apar and dApar/dt are allowed to be discontinuous + in the parallel (z) direction, the surface term in the z direction + does not involve Apar. Since Apar is continuous in the other directions, + it does not matter if we use the right or left value. */ + + cmag_e : doExpand1(cmag,bmagBasis), + + b_x_e : doExpand1(b_x, bmagBasis), + b_y_e : doExpand1(b_y, bmagBasis), + b_z_e : doExpand1(b_z, bmagBasis), + jacobTotInv_e : doExpand1(jacobtot_inv, bmagBasis), + + /* Basis for the velocity space mapping. */ + [jnk,vmapBasis] : loadBasis("Ser", 1, 1), [jnk,vmapSqBasis] : loadBasis("Ser", 1, 2), + vmapBnum : length(vmapBasis), vmapSqBnum : length(vmapSqBasis), + + vmap_e : [], vmapSq_e : [], vmap_prime_e : [], + for d : 1 thru vdim do ( + vmap_c : makelist(vmap[(d-1)*vmapBnum+i-1],i,1,vmapBnum), + vmap_e : endcons(doExpand(vmap_c,subst(x=varsP[cdim+d],vmapBasis)), vmap_e), + + vmapSq_c : makelist(vmapSq[(d-1)*vmapSqBnum+i-1],i,1,vmapSqBnum), + vmapSq_e : endcons(doExpand(vmapSq_c,subst(x=varsP[cdim+d],vmapSqBasis)), vmapSq_e), + + vmap_prime_e : endcons(vmap_prime[d-1], vmap_prime_e) + ), + + expOut : [bmag_e,cmag_e,phi_e,Apar_e,dApardt_e,dApardtPrev_e, + b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,vmapSq_e, + vmap_prime_e], + + return(expOut) +)$ + +calcAndWrite_HamilES(fH,charge,mass,wv,rdv2,bP,inFlds,sideStr) := block( + [varsP,numP,pDim,vdim,bmag_e,phi_e,hamil_e,hamil_c,replaceList,hamilCvar,hamilNoZero_c], + /* Expand the Hamiltonian, and write them out. */ + + varsP : listofvars(bP), + numP : length(bP), + pDim : length(varsP), + vdim : 1, + if isInList(mu,varsP) then vdim : 2, + + /* Extract magnetic field and electrostatic potential. */ + bmag_e : inFlds[1], + phi_e : inFlds[3], + vmap_e : inFlds[11], + vmapSq_e : inFlds[12], + + hamil_e : charge*phi_e + (1/2)*mass*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), + + /* Project Hamiltonian onto basis functions */ + hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), + + /* Write Hamiltonian. */ + printf(fh, " double hamil~a[~a] = {0.}; ~%", sideStr, numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + hamilCvar : eval_string(sconcat("hamil",sideStr)), + writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), + printf(fH, "~%"), + flush_output(fH), + + hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), + /* Expand projected Hamiltonian on basis. */ + hamil_e : hamilNoZero_c . bP, + + return(hamil_e) +)$ + +calc_HamilES_no_write(charge,mass,wv,rdv2,bP,inFlds) := block( + [varsP,numP,pDim,vdim,bmag_e,phi_e,hamil_e,hamil_c,hamilNoZero_c], + /* Expand the Hamiltonian, and write them out. */ + + varsP : listofvars(bP), + numP : length(bP), + pDim : length(varsP), + vdim : 0, + if isInList(vpar,varsP) then vdim : vdim+1, + if isInList(mu,varsP) then vdim : vdim+1, + + /* Extract magnetic field and electrostatic potential. */ + bmag_e : inFlds[1], + phi_e : inFlds[3], + vmap_e : inFlds[11], + vmapSq_e : inFlds[12], + + hamil_e : charge*phi_e + (1/2)*mass*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), + + /* Project Hamiltonian onto basis functions */ + hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), + + hamilNoZero_c : makelistNoZeros1(hamil_c, hamil), + /* Expand projected Hamiltonian on basis. */ + hamil_e : hamilNoZero_c . bP, + + return(hamil_e) +)$ + +calcAndWrite_BstardBmag(fH,cdim,bP,bmagBasis,surfDir,mass,charge,wvpar,rdx2,rdv2,inFlds,sideStr) := block ( + [cmag_e,Apar_e,BmagInv_e,BdriftX_e,BdriftY_e,BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,b_x_e,b_y_e,b_z_e, + jacobTotInv_e,rdy2,rdz2,AparL_e,BstarZdBmagL_e,varsP,numP,replaceList,BstarXdBmag_c,BstarYdBmag_c,BstarZdBmag_c, + BstarXdBmag_noZero_c,BstarYdBmag_noZero_c,BstarZdBmag_noZero_c,BstarZdBmagL_c,BstarZdBmagL_noZero_c,BstardBmagL_e], + /* Compute the Bstar divided by B and write it out. */ + + cmag_e : inFlds[2], + Apar_e : inFlds[4], + b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], + jacobTotInv_e : inFlds[10], + + if cdim > 1 then (rdy2 : rdx2[2]) else (rdy2 : 0), + if cdim > 2 then (rdz2 : rdx2[3]) else (rdz2 : 0), + + /* Zero out some terms below to avoid the discontinuity of alpha in the + parallel direction (due to the discontinuity of Apar). Otherwise some + other treatment of some Apar terms or alpha may be needed. Initially we + had a step averaging alpha across the surface (just for the parallel + direction), but NRM suspects this might've caused instability in some + cases. Hence the zeros below. */ + discontFac : 0, + + /* Expand BstarX/Bmag on basis. */ + BstarXdBmag_e : (-((mass/charge)*(wvpar+vpar/rdv2[1]))*rdz2*diff(b_y_e,z) + + rdy2*diff(Apar_e*b_z_e,y) - discontFac*rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e, + /* Expand BstarY/Bmag on basis. */ + BstarYdBmag_e : (-((mass/charge)*(wvpar+vpar/rdv2[1]))*(rdx2[1]*diff(b_z_e,x) - rdz2*diff(b_x_e,z)) + + discontFac*rdz2*diff(Apar_e*b_x_e,z) - rdx2[1]*diff(Apar_e*b_z_e,x))*jacobTotInv_e, + /* Expand BstarZ/Bmag on basis. */ + BstarZdBmag_e : (cmag_e + ((mass/charge)*(wvpar+vpar/rdv2[1]))*rdx2[1]*diff(b_y_e,x) + + discontFac*(rdx2[1]*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y)))*jacobTotInv_e, + + varsP : listofvars(bP), + numP : length(bP), + + /* Project Bstar's onto basis, and print to arrays. */ + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + if cdim > 1 then ( + BstarXdBmag_c : calcInnerProdList(varsP, 1, bP, BstarXdBmag_e), + if (surfDir = 0 or surfDir = 1 or surfDir = cdim+1) then ( + printf(fh, " double BstarXdBmag~a[~a] = {0.}; ~%", sideStr,numP), + writeCExprsNoExpand1(eval_string(sconcat("BstarXdBmag",sideStr)), gcfac(subst(replaceList, BstarXdBmag_c))), + printf(fh, "~%"), + flush_output(fh) + ), + BstarXdBmag_noZero_c : makelistNoZeros1(BstarXdBmag_c, eval_string(sconcat("BstarXdBmag",sideStr))), + BstarXdBmag_e : BstarXdBmag_noZero_c . bP, + + BstarYdBmag_c : calcInnerProdList(varsP, 1, bP, BstarYdBmag_e), + if (surfDir = 0 or surfDir = 2 or surfDir = cdim+1) then ( + printf(fh, " double BstarYdBmag~a[~a] = {0.}; ~%", sideStr, numP), + writeCExprsNoExpand1(eval_string(sconcat("BstarYdBmag",sideStr)), gcfac(subst(replaceList, BstarYdBmag_c))), + printf(fh, "~%"), + flush_output(fh) + ), + BstarYdBmag_noZero_c : makelistNoZeros1(BstarYdBmag_c, eval_string(sconcat("BstarYdBmag",sideStr))), + BstarYdBmag_e : BstarYdBmag_noZero_c . bP + ), + if cdim # 2 then ( + BstarZdBmag_c : calcInnerProdList(varsP, 1, bP, BstarZdBmag_e), + if (surfDir=0 or surfDir>=cdim) then ( + printf(fh, " double BstarZdBmag~a[~a] = {0.}; ~%", sideStr, numP), + writeCExprsNoExpand1(eval_string(sconcat("BstarZdBmag",sideStr)), gcfac(subst(replaceList, BstarZdBmag_c))), + printf(fh, "~%"), + flush_output(fh) + ), + BstarZdBmag_noZero_c : makelistNoZeros1(BstarZdBmag_c, eval_string(sconcat("BstarZdBmag",sideStr))), + BstarZdBmag_e : BstarZdBmag_noZero_c . bP + ), + + /* Make Bstar/Bmag vector. */ + if cdim = 1 then ( + BstardBmag_e : [BstarZdBmag_e] + ) elseif cdim = 2 then ( + BstardBmag_e : [BstarXdBmag_e, BstarYdBmag_e] + ) elseif cdim = 3 then ( + BstardBmag_e : [BstarXdBmag_e, BstarYdBmag_e, BstarZdBmag_e] + ), + + return(BstardBmag_e) +)$ + +calcAndWrite_BstarZdBmag(fH,cdim,bP,bmagBasis,surfDir,mass,charge,wvpar,rdx2,rdv2,inFlds,sideStr) := block ( + [cmag_e,Apar_e,BmagInv_e,BdriftX_e,BdriftY_e,BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,b_x_e,b_y_e,b_z_e, + jacobTotInv_e,rdy2,rdz2,AparL_e,BstarZdBmagL_e,varsP,numP,replaceList,BstarXdBmag_c,BstarYdBmag_c,BstarZdBmag_c, + BstarXdBmag_noZero_c,BstarYdBmag_noZero_c,BstarZdBmag_noZero_c,BstarZdBmagL_c,BstarZdBmagL_noZero_c,BstardBmagL_e], + /* Compute the Bstar divided by B and write it out. */ + + cmag_e : inFlds[2], + b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], + jacobTotInv_e : inFlds[10], + + if cdim > 1 then (rdy2 : rdx2[2]) else (rdy2 : 0), + if cdim > 2 then (rdz2 : rdx2[3]) else (rdz2 : 0), + + if (sideStr="L") then (Apar_e : inFlds[11]) + elseif (sideStr="R") then (Apar_e : inFlds[12]) + else (Apar_e : inFlds[4]), + + /* Expand BstarZ/Bmag on basis. */ + BstarZdBmag_e : (cmag_e + ((mass/charge)*(wvpar+vpar/rdv2[1]))*rdx2[1]*diff(b_y_e,x) + + (rdx2[1]*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y)))*jacobTotInv_e, + + varsP : listofvars(bP), + numP : length(bP), + + /* Project Bstar's onto basis, and print to arrays. */ + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + BstarZdBmag_c : calcInnerProdList(varsP, 1, bP, BstarZdBmag_e), + printf(fh, " double BstarZdBmag~a[~a]; ~%", sideStr, numP), + writeCExprsNoExpand1(eval_string(sconcat("BstarZdBmag",sideStr)), gcfac(subst(replaceList, BstarZdBmag_c))), + printf(fh, "~%"), + flush_output(fh), + BstarZdBmag_noZero_c : makelistNoZeros1(BstarZdBmag_c, eval_string(sconcat("BstarZdBmag",sideStr))), + BstarZdBmag_e : BstarZdBmag_noZero_c . bP, + + return(BstarZdBmag_e) +)$ + +poissonBracket(f,g,mass,charge,rdx2V,rdv2V,pbFacs,no_by) := block( + [varsCall,cdim,varsC,rdy2,rdz2,BstardBmag_e,bmagInv_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e], + /* Compute the Poisson bracket in general geometry. */ + + /* Function that computes the gradient. */ + /* + For some reason the following use of "vect" functions was giving extra + brackets when generating volume kernels. Opt for our own function instead. + scalefactors(varsC), + fgrad(fIn) := ev(express(grad(fIn)),diff)*rdx2V, + */ + fgrad(fIn,vars,diffFacs) := makelist(diff(fIn,vars[d]),d,1,length(vars))*diffFacs, + + cdim : length(rdx2V), + if (cdim = 1) then ( + varsCall : [x], + rdy2 : 0, + rdz2 : 0 + ) else if (cdim = 2) then ( + varsCall : [x,z], + rdy2 : 0, + rdz2 : rdx2V[2] + ) else if (cdim = 3) then ( + varsCall : [x,y,z], + rdy2 : rdx2V[2], + rdz2 : rdx2V[3] + ), + + varsC : makelist(varsCall[d],d,1,cdim), + BstardBmag_e : pbFacs[1], + b_x_e : pbFacs[2], b_y_e : pbFacs[3], b_z_e : pbFacs[4], + jacobTotInv_e : pbFacs[5], vmap_prime_e : pbFacs[6], + + if (no_by) then ( b_y_e : 0 ), + + pb_e : (1/mass)*BstardBmag_e . + ((rdv2V[1]/vmap_prime_e[1])*(fgrad(f,varsC,rdx2V)*diff(g,vpar)-fgrad(g,varsC,rdx2V)*diff(f,vpar))) + +(-(1/charge)*b_z_e*rdx2V[1]*rdy2*(diff(f,x)*diff(g,y)-diff(f,y)*diff(g,x)) + +(1/charge)*b_y_e*rdx2V[1]*rdz2*(diff(f,x)*diff(g,z)-diff(f,z)*diff(g,x)) + -(1/charge)*b_x_e*rdy2*rdz2*(diff(f,y)*diff(g,z)-diff(f,z)*diff(g,y)))*jacobTotInv_e, + + return(pb_e) +)$ + +calcAndWrite_alphaEM(fH,surfDir,bP,polyOrder,basisType,mass,charge,rdx2V,rdv2V, + inFlds,hamil_e,BstardBmag_e,sideStr,isStep2) := block( + [varsP,varLabel,dirLabel,wSurf,rdSurfVar2,surfVar,surfIntVars,pbAuxFlds,bmagInv_e,b_x_e, + b_y_e,b_z_e,jacobTotInv_e,alpha_e,Apar_e,dApardt_e,dApardtPrev_e,alphaL_e, + bSurf,numSurf,evPoint,alpha_c,alphaCvar,alphaNoZero_c,alphaUpCvar,alphaUpNoZero_c], + /* Calculate phase space velocity alpha in direction of surfVar. */ + /* We assume alpha.n is continuous across boundary, although H may not be. */ + /* Distinguish between alpha and alphaUp, where alphaUp is the one used to + determine upwind direction. */ + + varsP : listofvars(bP), + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + wSurf : eval_string(sconcat("w",dirLabel)), + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + surfVar : varsP[surfDir], /* Surface variable. */ + surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ + + b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], + jacobTotInv_e : inFlds[10], + + pbAuxFlds : [BstardBmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,vmapSq_e], + alpha_e : poissonBracket(wSurf+surfVar/rdSurfVar2,hamil_e,mass,charge,rdx2V,rdv2V,pbAuxFlds), + + Apar_e : inFlds[4], dApardt_e : inFlds[5], + + alphaUp_e : alpha_e, + if surfVar = vpar then ( + alpha_e : alpha_e - (charge/mass)*dApardt_e, + alphaUp_e : alpha_e + ), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder) + ) else ( + bSurf : basisFromVars(basisType,surfIntVars,polyOrder) + ), + numSurf : length(bSurf), + + if sideStr="L" then (evPoint : -1) + elseif sideStr="R" then (evPoint : 1), + + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + /* Project full alpha expression evaluated at interior surface + onto surface basis and print to C variable alpha. */ + alpha_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,alpha_e)), + printf(fh, " double alpha~a[~a] = {0.}; ~%", sideStr, numSurf), + alphaCvar : eval_string(sconcat("alpha",sideStr)), + writeCExprsNoExpand1(alphaCvar, subst(replaceList,alpha_c)), + printf(fh, "~%"), + flush_output(fh), + alphaNoZero_c : makelistNoZeros1(alpha_c, alphaCvar), + alphaSurf_e : doExpand(alphaNoZero_c, bSurf), + + alphaUpSurf_e : alphaSurf_e, + + return([alphaUp_e,alphaSurf_e,alphaUpSurf_e]) +)$ + +calcAndWrite_alpha(fH,surfDir,bP,polyOrder,basisType,mass,charge,rdx2V,rdv2V, + inFlds,hamil_e,BstardBmag_e,sideStr,no_by,isStep2) := block( + [varsP,varLabel,dirLabel,wSurf,rdSurfVar2,surfVar,surfIntVars,b_x_e,b_y_e,b_z_e, + jacobTotInv_e,vmap_e,vmap_prime_e,pbAuxFlds,cdim,surfVar_phys,alpha_e,bSurf, + numSurf,evPoint,alpha_c,alphaCvar,clst,alphaNoZero_c], + /* Calculate phase space velocity alpha in direction of surfVar. */ + /* We assume alpha.n is continuous across boundary, although H may not be. */ + /* Distinguish between alpha and alphaUp, where alphaUp is the one used to + determine upwind direction. */ + + varsP : listofvars(bP), + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + wSurf : eval_string(sconcat("w",dirLabel)), + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + surfVar : varsP[surfDir], /* Surface variable. */ + surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ + + b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], + jacobTotInv_e : inFlds[10], vmap_e : inFlds[11], vmap_prime_e : inFlds[13], + + pbAuxFlds : [BstardBmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_prime_e], + + cdim : length(rdx2V), + surfVar_phys : wSurf+surfVar/rdSurfVar2, + if (surfDir > cdim) then ( surfVar_phys : vmap_e[surfDir-cdim] ), + + alpha_e : poissonBracket(surfVar_phys,hamil_e,mass,charge,rdx2V,rdv2V,pbAuxFlds,no_by), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder) + ) else ( + bSurf : basisFromVars(basisType,surfIntVars,polyOrder) + ), + numSurf : length(bSurf), + + if sideStr="L" then (evPoint : -1) + elseif sideStr="R" then (evPoint : 1), + + dvparSimp : makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pDim), + + /* Project full alpha expression evaluated at interior surface + onto surface basis and print to C variable alpha. */ + alpha_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,alpha_e)), + alpha_c : subst(dvparSimp, alpha_c), + clst : [rdx2vec, rdv2vec, m_, q_, wvpar, rdvpar2Sq, + makelist(dxv[i-1],i,1,pDim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], + alphaCvar : eval_string(sconcat("alpha",sideStr)), + writeCExprsCollect1(alphaCvar, alpha_c, clst), + printf(fh, "~%"), + flush_output(fh), + alphaNoZero_c : makelistNoZeros1(alpha_c, alphaCvar), + alphaSurf_e : doExpand(alphaNoZero_c, bSurf), + + return(alphaSurf_e) +)$ + +calc_alpha_no_write(fH,surfDir,bP,polyOrder,basisType,mass,charge,rdx2V,rdv2V, + inFlds,hamil_e,BstardBmag_e,sideStr,no_by,isStep2) := block( + [varsP,varLabel,dirLabel,wSurf,rdSurfVar2,surfVar,surfIntVars,b_x_e,b_y_e,b_z_e, + jacobTotInv_e,vmap_e,vmap_prime_e,pbAuxFlds,cdim,surfVar_phys,alpha_e,bSurf, + numSurf,evPoint,alpha_c,alphaCvar,clst,alphaNoZero_c], + /* Calculate phase space velocity alpha in direction of surfVar. */ + /* We assume alpha.n is continuous across boundary, although H may not be. */ + /* Distinguish between alpha and alphaUp, where alphaUp is the one used to + determine upwind direction. */ + + varsP : listofvars(bP), + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + wSurf : eval_string(sconcat("w",dirLabel)), + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + surfVar : varsP[surfDir], /* Surface variable. */ + surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ + + b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], + jacobTotInv_e : inFlds[10], vmap_e : inFlds[11], vmap_prime_e : inFlds[13], + + pbAuxFlds : [BstardBmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_prime_e], + + cdim : length(rdx2V), + surfVar_phys : wSurf+surfVar/rdSurfVar2, + if (surfDir > cdim) then ( surfVar_phys : vmap_e[surfDir-cdim] ), + + alpha_e : poissonBracket(surfVar_phys,hamil_e,mass,charge,rdx2V,rdv2V,pbAuxFlds,no_by), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder) + ) else ( + bSurf : basisFromVars(basisType,surfIntVars,polyOrder) + ), + numSurf : length(bSurf), + + if sideStr="L" then (evPoint : -1) + elseif sideStr="R" then (evPoint : 1), + + /* Project full alpha expression evaluated at interior surface + onto surface basis and print to C variable alpha. */ + alpha_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,alpha_e)), + alphaCvar : eval_string(sconcat("alpha",sideStr)), + alphaNoZero_c : makelistNoZeros1(alpha_c, alphaCvar), + alphaSurf_e : doExpand(alphaNoZero_c, bSurf), + + return(alphaSurf_e) +)$ + +calc_surfAvgAlpha(bP,surfVar,alpha_e,evAtLower) := block( + [i,v,varsP,numP,surfIntVars,surfBasis,ignoreVars,alphaSurfAvg_c,alphaSurfAvg_e,evPoint], + /* Calculate the surface-averaged alpha. */ + + varsP : listofvars(bP), + numP : length(bP), + surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ + + if evAtLower then (evPoint:-1) else (evPoint:1), + + /* alpha coefficients are for an expansion in the full-dim phase basis. We + need to project onto the a basis on the surface with the right normalization + and dimensionality. */ + surfBasis : copylist(bP), + ignoreVars : listify(setdifference(setify(varsP),setify(surfIntVars))), + for i : 1 thru numP do ( + for v : 1 thru length(ignoreVars) do ( + if not freeof(ignoreVars[v],bP[i]) then ( surfBasis[i] : 0 ) + )), + alphaSurfAvg_c : calcInnerProdList(surfIntVars,1,surfBasis,subst(surfVar=evPoint,alpha_e)), + alphaSurfAvg_e : doExpand(alphaSurfAvg_c,surfBasis), + alphaSurfAvg_s : fullratsimp(innerProd(surfIntVars,1,alphaSurfAvg_e,1)/innerProd(surfIntVars,1,1,1)), + + return(alphaSurfAvg_s) +)$ + +calcAndWrite_surfAvgAlpha(fH,bP,surfDir,alpha_e,sideStr) := block([replaceList,evAtLower], + /* Given the phase-space velocity alpha, compute the average over the surface + perpendicular to the surfVar dimension, and at the lower/upper boundary if + sideStr=R/L. Write it out too.*/ + + surfVar : varsP[surfDir], /* Surface variable. */ + + if sideStr="R" then (evAtLower:true) else (evAtLower:false), + + alphaSurfAvg_s : calc_surfAvgAlpha(bP,surfVar,alpha_e,evAtLower), + + printf(fH, " // Surface-averaged phase velocity in this direction.~%"), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, + wvparL^2=wvparSqL, rdvpar2L^2=rdvpar2SqL, rdx2L^2=rdx2SqL, + wvparR^2=wvparSqR, rdvpar2R^2=rdvpar2SqR, rdx2R^2=rdx2SqR, m_^2=mSq, q_^2=qSq], + printf(fH, " double alphaSurfAvg~a = ~a; ~%~%", sideStr, float(subst(replaceList, alphaSurfAvg_s))), + flush_output(fH), + + return(alphaSurfAvg_s) +)$ + +calcAndWrite_upwindIncr_wSurfAvgAlpha(fH,bP,polyOrder,surfDir,sideStr,alphaSurf_e,isStep2) := block( + [varsP,numP,surfIntVars,fL_e,fR_e,fhatSurf_e,replaceList,fhatAlpha_c,incr_r,tMod,incrMod_r], + /* Given a surface expansion of the phase-space velocity, alpha, determine the upwinding + based on the surface average of alpha. Write the common increment to left/right cells + (the actual output from the C kernel should be this increment times some scaling factor). */ + + varsP : listofvars(bP), + numP : length(bP), + surfVar : varsP[surfDir], /* Surface variable. */ + surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ + + /* Expand distribution function. */ + fL_e : doExpand1(fL,bP), fR_e : doExpand1(fR,bP), + + printf(fH, " if (alphaSurfAvg~a>0) { ~%", sideStr), + + fhatSurf_e : subst(surfVar=1, fL_e), + + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, + wvparL^2=wvparSqL, rdvpar2L^2=rdvpar2SqL, rdx2L^2=rdx2SqL, + wvparR^2=wvparSqR, rdvpar2R^2=rdvpar2SqR, rdx2R^2=rdx2SqR, m_^2=mSq, q_^2=qSq], + /* Write out the increment to the right cell. Omit a dxv factor we incorporate later. */ + fhatAlpha_c : calcInnerProdList(surfIntVars, alphaSurf_e, subst(surfVar=-1, bP), fhatSurf_e), + incrR_c : fullratsimp(fhatAlpha_c), + writeCExprsNoExpand1(incr, subst(replaceList, incrR_c)), + flush_output(fH), + + if surfVar=vpar and polyOrder=1 and (not isStep2) then ( + tMod : calcInnerProdList(surfIntVars, 1, subst(surfVar=-1, bP), fhatSurf_e), + incrModR_c : fullratsimp(tMod), + writeCExprsNoExpand1(incrEmMod, subst(replaceList, incrModR_c)) + ), + + printf(fH, " } else { ~%"), + + fhatSurf_e : subst(surfVar=-1, fR_e), + + if surfVar=vpar and polyOrder=1 and (not isStep2) then ( + tMod : calcInnerProdList(surfIntVars, 1, subst(surfVar=-1, bP), fhatSurf_e), + incrModR_c : fullratsimp(tMod), + writeCExprsNoExpand1(incrEmMod, subst(replaceList, incrModR_c)) + ), + + fhatAlpha_c : calcInnerProdList(surfIntVars, alphaSurf_e, subst(surfVar=-1, bP), fhatSurf_e), + incrR_c : fullratsimp(fhatAlpha_c), + + fhatAlpha_c : calcInnerProdList(surfIntVars, alphaSurf_e, subst(surfVar=1, bP), fhatSurf_e), + incrL_c : -fullratsimp(fhatAlpha_c), + + writeCExprsNoExpand1(incr, subst(replaceList, incrR_c)), + printf(fH, " }~%"), + flush_output(fH), + + return([incrL_c,incrR_c]) +)$ + +calcAndWrite_upwindIncr_wQuadNodeAlpha(fH,basisType,polyOrder,bP,surfDir,sideStr, + alphaSurf_e,alphaUpSurf_e,fLR,isStep2) := block( + [varsP,numP,pDim,surfIntVars,vdim,cdim,surf_cvars,surf_vvars,surfNodes, + numNodes,fL_e,fR_e,fOrdL_n,fOrdR_n,alphaOrd_n, + fHatSurf_e,replaceList,Ghat_c,evPoint], + /* Compute the common increment to left/right cells with upwinding based on + the quadrature-node values of the phase-space velocity alpha. Write them + out. The actual output should be these increments scaled by some + cell-length factor. */ + + varsP : listofvars(bP), + numP : length(bP), + surfVar : varsP[surfDir], /* Surface variable. */ + surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ + pDim : length(varsP), + + vdim : 0, + if isInList(vpar,varsP) then vdim : vdim+1, + if isInList(mu,varsP) then vdim : vdim+1, + cdim : pDim-vdim, + + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), + basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) + ), + numNodes : length(surfNodes), + + /* Expand distribution function. */ + fL_e : doExpand1(fLR[1],bP), + fR_e : doExpand1(fLR[2],bP), + + /* Evaluate alpha at ordinates. + Note: alphaSurf_e is already a surface expansion. */ + alphaOrd_n : gcfac(float(evAtNodes(alphaUpSurf_e,surfNodes,surfIntVars))), + /* Determine upwinding at each surface quadrature node. */ + printf(fH, " double fUpOrd~a[~a] = {0.};~%", sideStr, numNodes), + for i : 1 thru numNodes do ( + printf(fH, " if (~a > 0.) {~%", float(expand(fullratsimp(alphaOrd_n[i]/abs(content(args(alphaOrd_n[i])[1])[1]))))), + printf(fh, " fUpOrd~a[~a] = ~a_surfx~a_eval_quad_node_~a_r(~a); ~%", sideStr, i-1, basisStr, surfDir, i-1, fLR[1]), + printf(fh, " } else { ~%"), + printf(fh, " fUpOrd~a[~a] = ~a_surfx~a_eval_quad_node_~a_l(~a); ~%", sideStr, i-1, basisStr, surfDir, i-1, fLR[2]), + printf(fh, " } ~%") + ), + printf(fH, "~%"), + flush_output(fH), + + /* Write coefficients of modal surface expansion fupwind. */ + printf(fh, " // Project tensor nodal quadrature basis back onto modal basis. ~%"), + printf(fH, " double fUp~a[~a] = {0.};~%", sideStr, length(bSurf)), + if polyOrder=1 then ( /* Force p=1 to use hybrid basis. */ + dirStr : "x", + if surfDir = cdim+1 then (dirStr : "vpar") elseif surfDir = cdim+2 then (dirStr : "mu"), + printf(fh, " ~a_~adir_upwind_quad_to_modal(fUpOrd~a, fUp~a); ~%", basisStr, dirStr, sideStr, sideStr) + ) else ( + printf(fh, " ~a_upwind_quad_to_modal(fUpOrd~a, fUp~a); ~%", basisStr, sideStr, sideStr) + ), + printf(fh, "~%"), + flush_output(fH), + fHatSurf_e : doExpand1(eval_string(sconcat("fUp",sideStr)), bSurf), + + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + + if (sideStr="L") then (evPoint : -1) + elseif (sideStr="R") then (evPoint : 1), + + Ghat_c : calcInnerProdList(surfIntVars, alphaSurf_e, bSurf, fHatSurf_e), + Ghat_e : doExpand(Ghat_c, bSurf), + printf(fH, " double Ghat~a[~a] = {0.}; ~%", sideStr, length(bSurf)), + writeCExprs1(eval_string(sconcat("Ghat",sideStr)), Ghat_c), + printf(fH, "~%"), + flush_output(fH), + /* Zero out components of Ghat which are empty. */ + GhatNoZero : makelistNoZeros1(Ghat_c, eval_string(sconcat("Ghat",sideStr))), + Ghat_e : doExpand(GhatNoZero, bSurf), + + incr_c : fullratsimp(calcInnerProdList(surfIntVars, -evPoint, subst(surfVar=evPoint, bP), Ghat_e)), + + return(incr_c) +)$ + +calcAndWrite_upwindIncr_cflFreq_wQuadNodeAlpha(fH,basisType,polyOrder,bP,surfDir,sideStr, + alphaSurf_e,alphaUpSurf_e,fLR,isStep2) := block( + [varsP,numP,surfVar,surfIntVars,pDim,vdim,cdim,surf_cvars,surf_vvars,surfNodes, + bSurf,basisStr,numNodes,fL_e,fR_e,alphaOrd_n,i, + dirStr,fHatSurf_e,evPoint,Ghat_c,Ghat_e,GhatNoZero,incr_c], + + varsP : listofvars(bP), + numP : length(bP), + surfVar : varsP[surfDir], /* Surface variable. */ + surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ + pDim : length(varsP), + + vdim : 0, + if isInList(vpar,varsP) then vdim : vdim+1, + if isInList(mu,varsP) then vdim : vdim+1, + cdim : pDim-vdim, + + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), + basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) + ), + numNodes : length(surfNodes), + + /* Expand distribution function. */ + fL_e : doExpand1(fLR[1],bP), + fR_e : doExpand1(fLR[2],bP), + + /* Evaluate alpha at ordinates. + Note: alphaSurf_e is already a surface expansion. */ + alphaOrd_n : gcfac(float(evAtNodes(alphaUpSurf_e,surfNodes,surfIntVars))), + + /* Determine upwinding and cflFreq at each surface quadrature node. */ + printf(fH, " double fUpOrd~a[~a] = {0.};~%", sideStr, numNodes), + printf(fH, " double alpha~a_n = 0.;~%", sideStr), + printf(fH, "~%"), + for i : 1 thru numNodes do ( + printf(fH, " alpha~a_n = ~a;~%", sideStr, float(expand(fullratsimp(alphaOrd_n[i])))), + printf(fH, " if (alpha~a_n > 0.) {~%", sideStr), + printf(fh, " fUpOrd~a[~a] = ~a_surfx~a_eval_quad_node_~a_r(~a); ~%", sideStr, i-1, basisStr, surfDir, i-1, fLR[1]), + printf(fh, " } else { ~%"), + printf(fh, " fUpOrd~a[~a] = ~a_surfx~a_eval_quad_node_~a_l(~a); ~%", sideStr, i-1, basisStr, surfDir, i-1, fLR[2]), + printf(fh, " } ~%"), + /* The extra factor of bP[1] below remains unexplained. NRM might've + stumbled up one it by trial and error. It may also have been meant + to average all the quad node values, but that meaning is only correct + for pure p=1. */ + printf(fh, " cflFreq = fmax(cflFreq, fabs(alpha~a_n)); ~%", sideStr, sideStr) + ), + printf(fH, "~%"), + flush_output(fH), + + /* Write coefficients of modal surface expansion fupwind. */ + printf(fh, " // Project tensor nodal quadrature basis back onto modal basis. ~%"), + printf(fH, " double fUp~a[~a] = {0.};~%", sideStr, length(bSurf)), + if polyOrder=1 then ( /* Force p=1 to use hybrid basis. */ + dirStr : "x", + if surfDir = cdim+1 then (dirStr : "vpar") elseif surfDir = cdim+2 then (dirStr : "mu"), + printf(fh, " ~a_~adir_upwind_quad_to_modal(fUpOrd~a, fUp~a); ~%", basisStr, dirStr, sideStr, sideStr) + ) else ( + printf(fh, " ~a_upwind_quad_to_modal(fUpOrd~a, fUp~a); ~%", basisStr, sideStr, sideStr) + ), + printf(fh, "~%"), + flush_output(fH), + fHatSurf_e : doExpand1(eval_string(sconcat("fUp",sideStr)), bSurf), + + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + + if (sideStr="L") then (evPoint : -1) + elseif (sideStr="R") then (evPoint : 1), + + Ghat_c : calcInnerProdList(surfIntVars, alphaSurf_e, bSurf, fHatSurf_e), + Ghat_e : doExpand(Ghat_c, bSurf), + printf(fH, " double Ghat~a[~a] = {0.}; ~%", sideStr, length(bSurf)), + writeCExprs1(eval_string(sconcat("Ghat",sideStr)), Ghat_c), + printf(fH, "~%"), + flush_output(fH), + /* Zero out components of Ghat which are empty. */ + GhatNoZero : makelistNoZeros1(Ghat_c, eval_string(sconcat("Ghat",sideStr))), + Ghat_e : doExpand(GhatNoZero, bSurf), + + incr_c : fullratsimp(calcInnerProdList(surfIntVars, -evPoint, subst(surfVar=evPoint, bP), Ghat_e)), + + return(incr_c) +)$ + +calcAndWrite_quadCFLfreq_wPhaseAlpha(basisType,polyOrder,bP,surfDir,alpha_e) := block( + [i,varsP,numP,cdim,vdim,pDim,surfVar,surfIntVars,pOrderCFL,surf_cvars,surf_vvars,surfNodes, + numNodes,alphaSurfL_c,alphaSurfL_e,alphaSurfL_n,alphaSurfR_c,alphaSurfR_e,alphaSurfR_n], + /* Compute the CFL frequency from quadrature node contributions on the + surfaces in the dir dimension, given a phase-space volume expansion + of the speed (i.e. coming from doExpand(alpha,bP)). */ + + varsP : listofvars(bP), + numP : length(bP), + pDim : length(varsP), + surfVar : varsP[surfDir], /* Surface variable. */ + surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ + vdim : 0, + if isInList(vpar,varsP) then vdim : vdim+1, + if isInList(mu,varsP) then vdim : vdim+1, + cdim : pDim-vdim, + + /* Identify polyOrder in velocity space as p=2 for p=1 since we force p=1 to + mean gkhybrid basis. */ + pOrderCFL : polyOrder, + if polyOrder=1 and surfDir=cdim+1 then ( pOrderCFL : 2 ), + + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + /* Evaluate cfl by evaluating at all surface quadrature points. */ + /* Get quadrature nodes on surface. */ + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1) + ), + numNodes : length(surfNodes), + + /* Coefficients of alpha written out to the file above are phase-space volume + expansion coefficients. Need to evaluate at the surface and project onto + surface basis, before (expanding and) evaluating at surface nodes. */ + /* The extra factor of bP[1] below remains unexplained. NRM might've + stumbled up one it by trial and error. */ + alphaSurfL_n : gcfac(float(evAtNodes(subst(surfVar=-1,alpha_e)*bP[1],surfNodes,surfIntVars)*bP[1])), + printf(fh, " // Evaluate alpha at left surface quadrature points.~%"), + for i : 1 thru numNodes do ( + printf(fh, " alphaL = ~a; ~%", gcfac(float(alphaSurfL_n[i]))), + printf(fh, " cflFreq += -~a*(alphaL-fabs(alphaL)); ~%",float(0.5*(2*pOrderCFL+1))) + ), + + alphaSurfR_n : gcfac(float(evAtNodes(subst(surfVar=+1,alpha_e)*bP[1],surfNodes,surfIntVars)*bP[1])), + printf(fh, " // Evaluate alpha at right surface quadrature points.~%"), + for i : 1 thru numNodes do ( + printf(fh, " alphaR = ~a; ~%", gcfac(float(alphaSurfR_n[i]))), + printf(fh, " cflFreq += ~a*(alphaR+fabs(alphaR)); ~%",float(0.5*(2*pOrderCFL+1))) + ) +)$ + +/* + Utility functions for computing surface DG updates + for the generic case applicable to all our kinetic equations: + For a *continuous* phase space flux alpha, if sign(alpha) is a constant + we can use simple upwind fluxes. + F = alpha_surf*f^- (if sign(alpha_surf) = 1), + F = alpha_surf*f^+ (if sign(alpha_surf) = -1) + Otherwise, we project sign(alpha_surf) first evaluating sign(alpha_surf) + at quadrature points and then using a nodal-to-modal transformation do + F = alpha_surf ( 1/2*(f^+ + f^-) - 1/2*sgn_alpha_surf*(f^+ - f^-) + + In this notation alpha_surf is the expansion of the *continuous* phase space flux + on the given surface, f^+ is the distribution function evaluated just outside the surface + and f^- is the distribution function evaluated just inside the surface + +------+------+ + | | | + | f^-|f^+ | + | | | + +------+------+ + alpha_surf +*/ + +/* Determine the upwinded distribution function in gyrokinetics */ +calcAndWrite_GKfUpwind(file_handle,cdim,surfDir,surfVar,surfIntVars,bSurf,fl_e,fr_e,basisStr,sideStr,no_by) := block( + [fstrL, fstrR, fLNm, fRNm, fUpNm, sgn_alpha_surfNm, sgn_alphaUpNm, NSurf,fSurfl_c, fSurfr_c, fSurfl_e, fSurfr_e, + surfNodes,nodeVars,basisNodal,sgn_alphaNodal_e,bSurf_no_by,sgn_alphaHatModProj_e,sgn_alphaUp_e,fUp_c], + + /* Naming convention for subsequent distribution function evaluations + for a cell-based update. If performing the left surface update + we need fl(surfVar=+1) and fc(surfVar=-1) (f_lr and f_cl) and if we are performing + the right surface update we need fc(surfVar=+1) and fr(surfVar=-1) (f_cr and f_rl) */ + if (sideStr = "L") then ( + fstrL : "lr", + fstrR : "cl" + ) else ( + fstrL : "cr", + fstrR : "rl" + ), + fLNm : eval_string(sconcat("f_",fstrL)), + fRNm : eval_string(sconcat("f_",fstrR)), + fUpNm : eval_string(sconcat("fUp",sideStr)), + sgn_alpha_surfNm : eval_string(sconcat("sgn_alpha_surf",sideStr)), + sgn_alphaUpNm : eval_string(sconcat("sgn_alphaUp",sideStr)), + + NSurf : length(bSurf), + printf(file_handle, " double fUp~a[~a] = {0.};~%", sideStr, NSurf), + fSurfl_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=1, fl_e)), + fSurfr_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=-1, fr_e)), + fSurfl_e : doExpand1(fLNm, bSurf), + fSurfr_e : doExpand1(fRNm, bSurf), + + clst : [vmap_prime_l[0],vmap_prime_l[1],vmap_prime_c[0],vmap_prime_c[1], + vmap_prime_r[0],vmap_prime_r[1],vmap_prime_edge[0],vmap_prime_edge[1], + vmap_prime_skin[0],vmap_prime_skin[1]], + /* If sign(alpha_surf) is single signed + 1. f^- (if sign(alpha_surf) = 1), + 2. f^+ (if sign(alpha_surf) = -1) */ + printf(file_handle, " if (const_sgn_alpha~a[0] == 1) { ~%", sideStr), + printf(file_handle, " if (sgn_alpha_surf~a[0] == 1.0) { ~%", sideStr), + writeCExprsCollect1(fUpNm, fSurfl_c, clst), + printf(file_handle, " } else { ~%"), + writeCExprsCollect1(fUpNm, fSurfr_c, clst), + printf(file_handle, " } ~%"), + + /* Else sign(alpha_surf) is changing quadrature point to quadrature point + 1/2*(f^+ + f^-) - 1/2*sgn_alpha_surf*(f^+ - f^-) */ + printf(file_handle, " } else { ~%"), + printf(file_handle, " double f_~a[~a] = {0.};~%", fstrL, NSurf), + printf(file_handle, " double f_~a[~a] = {0.};~%", fstrR, NSurf), + if (polyOrder = 1) then ( /* Force p=1 to use hybrid basis. */ + /* if no toroidal field and p=1, use a further reduced quadrature evaluation + to exploit the larger sparsity in the x and z updates. + The x update is surfDir = 1 and the z update is surfDir = cdim */ + if (no_by and surfDir = 1) then ( + surfNodes : gaussOrd(1+1, 1), + nodeVars : [z], + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", 1, 1, nodeVars, surfNodes), + sgn_alphaNodal_e : doExpand1(sgn_alpha_surfNm,basisNodal), + bSurf_no_by : basisFromVars("gkhyb",nodeVars,polyOrder), + sgn_alphaHatModProj_e : fullratsimp(calcInnerProdList(nodeVars, 1, bSurf_no_by, sgn_alphaNodal_e)), + printf(file_handle, " double sgn_alphaUp~a[~a] = {0.};~%", sideStr, length(bSurf_no_by)), + writeCExprs1(sgn_alphaUpNm, sgn_alphaHatModProj_e), + sgn_alphaUp_e : doExpand1(sgn_alphaUpNm, bSurf_no_by) + ) + else if (no_by and surfDir = cdim) then ( + surfNodes : gaussOrdGkHyb(1+1, [x], [vpar]), + nodeVars : [x,vpar], + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", 1, 1, nodeVars, surfNodes), + sgn_alphaNodal_e : doExpand1(sgn_alpha_surfNm,basisNodal), + bSurf_no_by : basisFromVars("gkhyb",nodeVars,polyOrder), + sgn_alphaHatModProj_e : fullratsimp(calcInnerProdList(nodeVars, 1, bSurf_no_by, sgn_alphaNodal_e)), + printf(file_handle, " double sgn_alphaUp~a[~a] = {0.};~%", sideStr, length(bSurf_no_by)), + writeCExprs1(sgn_alphaUpNm, sgn_alphaHatModProj_e), + sgn_alphaUp_e : doExpand1(sgn_alphaUpNm, bSurf_no_by) + ) + else ( + dirStr : "x", + if (surfDir = cdim+1) then (dirStr : "vpar") elseif (surfDir = cdim+2) then (dirStr : "mu"), + printf(file_handle, " double sgn_alphaUp~a[~a] = {0.};~%", sideStr, NSurf), + printf(file_handle, " ~a_~adir_upwind_quad_to_modal(~a, ~a); ~%", basisStr, dirStr, sgn_alpha_surfNm, sgn_alphaUpNm), + sgn_alphaUp_e : doExpand1(sgn_alphaUpNm, bSurf) + ) + ) else ( + printf(file_handle, " double sgn_alphaUp~a[~a] = {0.};~%", sideStr, NSurf), + printf(file_handle, " ~a_upwind_quad_to_modal(~a, ~a); ~%", basisStr, sgn_alpha_surfNm, sgn_alphaUpNm), + sgn_alphaUp_e : doExpand1(sgn_alphaUpNm, bSurf) + ), + printf(file_handle, "~%"), + + writeCExprsCollect1(fLNm, fSurfl_c, clst), + printf(file_handle, "~%"), + flush_output(file_handle), + + writeCExprsCollect1(fRNm, fSurfr_c, clst), + printf(file_handle, "~%"), + flush_output(file_handle), + + fUp_c : calcInnerProdList(surfIntVars, 1, bSurf, 0.5*(fSurfl_e + fSurfr_e) - 0.5*sgn_alphaUp_e*(fSurfr_e - fSurfl_e)), + writeCExprsNoExpand1(fUpNm, gcfac(float(expand(fUp_c)))), + printf(file_handle, "~%"), + flush_output(file_handle), + + printf(file_handle, " } ~%") +)$ + +/* Determine the upwinded distribution function in gyrokinetics */ +calcAndWrite_sgn_alpha(file_handle,surfIntVars,surfNodes,numNodes,alphaSurf_e,sideStr) := block( + [alphaOrd_n], + /* Determine sign(alpha_surf) for upwinding at each surface quadrature node. */ + + /* Evaluate alpha at ordinates. + Note: alphaSurf_e is already a surface expansion. */ + alphaOrd_n : gcfac(float(evAtNodes(alphaSurf_e,surfNodes,surfIntVars))), + + printf(file_handle, " int const_sgn_alpha_surf = 1; ~%"), + printf(file_handle, " ~%"), + /* Write out first quadrature point + We are going to compare the signs of the quadrature points to see if the sign is constant */ + printf(file_handle, " if (~a > 0.) ~%", gcfac(float(expand(fullratsimp(alphaOrd_n[1]))))), + printf(file_handle, " sgn_alpha_surf~a[0] = 1.0; ~%", sideStr), + printf(file_handle, " else ~%"), + printf(file_handle, " sgn_alpha_surf~a[0] = -1.0; ~%", sideStr), + printf(file_handle, " ~%"), + /* Write out the other quadrature point evaluations and compare the signs point by point */ + for i : 2 thru numNodes do ( + printf(file_handle, " if (~a > 0.) ~%", gcfac(float(expand(fullratsimp(alphaOrd_n[i]))))), + printf(file_handle, " sgn_alpha_surf~a[~a] = 1.0; ~%", sideStr, i-1), + printf(file_handle, " else ~%"), + printf(file_handle, " sgn_alpha_surf~a[~a] = -1.0; ~%", sideStr, i-1), + printf(file_handle, " ~%"), + printf(file_handle, " if (sgn_alpha_surf~a[~a] == sgn_alpha_surf~a[~a]) ~%", sideStr, i-1, sideStr, i-2), + printf(file_handle, " const_sgn_alpha_surf = const_sgn_alpha_surf ? 1 : 0; ~%"), + printf(file_handle, " else ~%"), + printf(file_handle, " const_sgn_alpha_surf = 0; ~%"), + printf(file_handle, " ~%") + ) +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac b/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac new file mode 100644 index 00000000..d1208032 --- /dev/null +++ b/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac @@ -0,0 +1,244 @@ +load("modal-basis")$ +load("out-scripts")$ +load(stringproc)$ +load("scifac")$ +load("utilities_gyrokinetic")$ +fpprec : 24$ + +buildGKFluxVparAddEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge) := block( + [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, + surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, + numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, + bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, + hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr + ], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + surfIntVarsC : delete(surfVar,varsC), + bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + nodeVars : surfIntVars, + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + nodeVars : surfIntVars, + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) + ), + configNodes : gaussOrd(polyOrder+1, cdim), + numSurfNodes : length(surfNodes), + numConfigNodes : length(configNodes), + numVelNodes : numSurfNodes/numConfigNodes, + + /* if polyOrder = 1, we need to be careful about + indexing input arrays since the surface hybrid basis has a different size in the + vparallel surfaces and/or we are more directly exploiting the sparsity of + alpha (e.g., in the x and z direction when no toroidal field, by=0) + and thus utilize fewer coefficients to reduce the number of operations */ + if (polyOrder = 1) then ( + tempVars : delete(x,varsP), + tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), + NSurfIndexing : length(tempBasis), + numNodesIndexing : length(tempBasis) + ) else ( + NSurfIndexing : NSurf, + numNodesIndexing : numNodes + ), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // dgv: volume DG geometry.~%"), + printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), + printf(fh, " // bmag: magnetic field amplitude.~%"), + printf(fh, " // phi: electrostatic potential.~%"), + printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), + printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), + printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), + printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), + printf(fh, "~%"), + + /* Declare cell-center variables and variables multiplying gradients. */ + for d : 1 thru cdim+1 do ( + printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) + ), + printf(fh, "~%"), + rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + /* Axisymmetric basis (independent of y). */ + bmagBasis : getAxisymmetricConfBasis(bC), + + /* Expand input fields for Hamiltonian calculation */ + phi_e : doExpand1(phi,bC), + bmag_e : doExpand1(bmag, bmagBasis), + + /* Velocity mapping fields. */ + [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + + /* Redefine vmap_prime to exploit the relationship between it and vmap. */ + /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ + vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), + + if edge = true then ( + evPoint : 1 + ) else ( + evPoint : -1 + ), + + /* Finally write out the hamiltonian*/ + hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), + hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), + printf(fh, " double hamil[~a] = {0.}; ~%", numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + hamilCvar : eval_string(sconcat("hamil")), + writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), + printf(fh, "~%"), + flush_output(fh), + hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), + /* Expand projected Hamiltonian on basis. */ + hamil_e : hamilNoZero_c . bP, + /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ + + /*fl and fr */ + JfL_e : doExpand1(JfL, bP), + JfR_e : doExpand1(JfR, bP), + JfL_c : calcInnerProdList(varsP, 1, bP, JfL_e), + JfR_c : calcInnerProdList(varsP, 1, bP, JfR_e), + + JfL_e : subst(surfVar=1,JfL_e), + JfR_e : subst(surfVar=-1,JfR_e), + + JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), + JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), + + vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), + + vpardim : pDim-1, + if vdim = 1 then ( vpardim : pDim ), + dH_dz_nodes : makelist(0, i, 1, pDim), + for i : 1 thru vpardim do ( + if i = vpardim then ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars)), + dH_dz_nodes[i] : subst(surfVar=evPoint, dH_dz_nodes[i]) + ) + else ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ) + ), + + /* Now calculate apha at all quadrature nodes */ + /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ + printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), + printf(fh, " double cfl = 0.0; ~%"), + printf(fh, " double bmag_quad = 0.0; ~%"), + printf(fh, " double B3_quad = 0.0; ~%"), + printf(fh, " double Jc_quad = 0.0; ~%"), + printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), + + printf(fh, " double alpha_quad = 0.0; ~%"), + printf(fh, " double JfL_quad = 0.0; ~%"), + printf(fh, " double JfR_quad = 0.0; ~%"), + printf(fh, " double Jfavg_quad = 0.0; ~%"), + printf(fh, " double Jfjump_quad = 0.0; ~%"), + printf(fh, "~%"), + + for i : 1 thru numConfigNodes do ( + printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i-1), + printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i-1), + printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i-1), + printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i-1), + printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i-1), + printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i-1), + printf(fh, "~%"), + for j : 1 thru numVelNodes do ( + j0index : j-1+(i-1)*numVelNodes, + j1index : j+(i-1)*numVelNodes, + printf(fh, "~%"), + if no_by = true then ( + printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ;~%", dH_dz_nodes[cdim][j1index]) + ), + if no_by = false then ( + printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ", dH_dz_nodes[cdim][j1index]), + if cdim = 3 then ( + for k : 1 thru cdim do ( + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[k][j1index], k-1, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) + ) + ), + if cdim = 2 then ( + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 0, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) + ), + if cdim = 1 then ( + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) + ), + printf(fh, ";~%") + ), + + printf(fh, "~%"), + printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), + printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), + printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), + printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), + printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) + ), + printf(fh, "~%") + ), + + /* Do the quad nodal to modal ops directly here*/ + /*printf(fh, "~%"), + printf(fh, " double *fmodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), + flux_surf_nodal_e : doExpand1(flux_surf_nodal,basisNodal), + fmodproj_e : fullratsimp(calcInnerProdList(surfIntVars, 1, bSurf, flux_surf_nodal_e)), + + for i : 1 thru length(fmodproj_e) do ( + printf(fh, " fmodal[~a] = ~a; ~%", i-1, float(expand(fmodproj_e[i]))) + ), + + printf(fh, "~%"),*/ + /*Calculate the cfl*/ + pOrderCFL : polyOrder, + if polyOrder=1 then ( pOrderCFL : 2 ), + printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), + vprimeStr : "/vmap_prime_min", + printf(fh, "~%"), + printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), + + printf(fh, "~%") + + printf(fh, " return 0.; ~%") + flush_output(fh), + printf(fh, "} ~%") + +)$ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf_add_em.mac b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac similarity index 100% rename from maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf_add_em.mac rename to maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_add_em.mac b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac similarity index 100% rename from maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_add_em.mac rename to maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac diff --git a/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac b/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac new file mode 100644 index 00000000..1a8bdcef --- /dev/null +++ b/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac @@ -0,0 +1,126 @@ +/* Compute the header file for gyrokinetic collisionless flux kernels. */ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +maxPolyOrder_Ser : 2$ +minCdim_Ser : 1$ +minVdim_Ser : 1$ +maxCdim_Ser : 3$ +maxVdim_Ser : 2$ + +/* Tensor order basis. */ +maxPolyOrder_Tensor : 2$ +minCdim_Tensor : 1$ +minVdim_Tensor : 1$ +maxCdim_Tensor : 0$ +maxVdim_Tensor : 0$ + +/* Number of velocity dimensions allowed for each + configuration-space dimension. */ +gkVdims : [[1,2], [2], [2]]$ + +/* ...... END OF USER INPUTS........ */ + +varsC : [x, y, z]$ +varsV : [vpar, mu]$ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +minVdim : [minVdim_Ser, minVdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ +maxVdim : [maxVdim_Ser, maxVdim_Tensor]$ + +/* Options for writing kernels with and without toroidal field (b_y=0), one per + dimension, or make the kernel only add electromagnetic terms. */ +byOpt : [[false, false], [false, false, false], [false, false, true]]$ +emOpt : [[false, true], [false, true, false], [false, true, false]]$ +optStr : ["", "add_em_", "no_by_"]$ + +/* Options for writing kernels used at multiblock boundaries. One for each + dimension. */ +mb_bcOpt : [[false,true],[false,true],[false,true]]$ +mb_bcStr : ["", "multib_boundary_"]$ + +printPrototypes() := block([], + for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ + for polyOrder : 1 thru maxPolyOrderB do ( + + for byI : 1 thru length(byOpt[c]) do ( + no_by : byOpt[c][byI], + add_em : emOpt[c][byI], + opt_str : optStr[byI], + if not(add_em) then ( + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], + + for surfDir : 1 thru c do ( + dirlabel : varsC[surfDir], + extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", + vprimeargs : "", + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~asurf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", opt_str, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", opt_str, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + ) + ) + ), + + + dirlabel : varsV[1], + extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", + vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~asurf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", opt_str, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + ), + + printf(fh, "~%") + ) + ) + ) + ) +)$ + +fh : openw("~/max-out/gkyl_gk_collisionless_flux_kernels.h")$ +printf(fh, "#pragma once~%")$ +printf(fh, "~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "~%")$ +printf(fh, "EXTERN_C_BEG~%")$ +printf(fh, "~%")$ +printPrototypes()$ +printf(fh, "~%")$ +printf(fh, "EXTERN_C_END~%")$ +close(fh)$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_add_em.mac b/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac similarity index 100% rename from maxima/g0/gk_collisionless/ms-gk_collisionless_flux_add_em.mac rename to maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 34e06ea7..80e91ba2 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -296,4 +296,4 @@ buildGKFluxConfESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no flush_output(fh), printf(fh, "} ~%") -)$ +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 617facd2..1b5f0054 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -239,243 +239,4 @@ buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no flush_output(fh), printf(fh, "} ~%") -)$ - -buildGKFluxVparAddEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge) := block( - [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, - surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, - numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, - bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, - hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr - ], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - surfIntVarsC : delete(surfVar,varsC), - bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - nodeVars : surfIntVars, - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - nodeVars : surfIntVars, - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) - ), - configNodes : gaussOrd(polyOrder+1, cdim), - numSurfNodes : length(surfNodes), - numConfigNodes : length(configNodes), - numVelNodes : numSurfNodes/numConfigNodes, - - /* if polyOrder = 1, we need to be careful about - indexing input arrays since the surface hybrid basis has a different size in the - vparallel surfaces and/or we are more directly exploiting the sparsity of - alpha (e.g., in the x and z direction when no toroidal field, by=0) - and thus utilize fewer coefficients to reduce the number of operations */ - if (polyOrder = 1) then ( - tempVars : delete(x,varsP), - tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), - NSurfIndexing : length(tempBasis), - numNodesIndexing : length(tempBasis) - ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes - ), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_r, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // dgv: volume DG geometry.~%"), - printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), - printf(fh, " // bmag: magnetic field amplitude.~%"), - printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), - printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), - printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), - printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), - printf(fh, "~%"), - if false then ( - /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru cdim+1 do ( - printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) - ), - printf(fh, "~%"), - rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), - - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - /* Axisymmetric basis (independent of y). */ - bmagBasis : getAxisymmetricConfBasis(bC), - - /* Expand input fields for Hamiltonian calculation */ - phi_e : doExpand1(phi,bC), - bmag_e : doExpand1(bmag, bmagBasis), - - /* Velocity mapping fields. */ - [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), - - /* Redefine vmap_prime to exploit the relationship between it and vmap. */ - /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ - vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), - - if edge = true then ( - evPoint : 1 - ) else ( - evPoint : -1 - ), - - /* Finally write out the hamiltonian*/ - hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], - if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), - hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), - printf(fh, " double hamil[~a] = {0.}; ~%", numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - hamilCvar : eval_string(sconcat("hamil")), - writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), - printf(fh, "~%"), - flush_output(fh), - hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), - /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bP, - /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ - - /*fl and fr */ - JfL_e : doExpand1(JfL, bP), - JfR_e : doExpand1(JfR, bP), - JfL_c : calcInnerProdList(varsP, 1, bP, JfL_e), - JfR_c : calcInnerProdList(varsP, 1, bP, JfR_e), - - JfL_e : subst(surfVar=1,JfL_e), - JfR_e : subst(surfVar=-1,JfR_e), - - JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), - JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), - - vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), - - vpardim : pDim-1, - if vdim = 1 then ( vpardim : pDim ), - dH_dz_nodes : makelist(0, i, 1, pDim), - for i : 1 thru vpardim do ( - if i = vpardim then ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars)), - dH_dz_nodes[i] : subst(surfVar=evPoint, dH_dz_nodes[i]) - ) - else ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) - ) - ), - - /* Now calculate apha at all quadrature nodes */ - /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ - printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), - printf(fh, " double cfl = 0.0; ~%"), - printf(fh, " double bmag_quad = 0.0; ~%"), - printf(fh, " double B3_quad = 0.0; ~%"), - printf(fh, " double Jc_quad = 0.0; ~%"), - printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), - - printf(fh, " double alpha_quad = 0.0; ~%"), - printf(fh, " double JfL_quad = 0.0; ~%"), - printf(fh, " double JfR_quad = 0.0; ~%"), - printf(fh, " double Jfavg_quad = 0.0; ~%"), - printf(fh, " double Jfjump_quad = 0.0; ~%"), - printf(fh, "~%"), - - for i : 1 thru numConfigNodes do ( - printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i-1), - printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i-1), - printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i-1), - printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i-1), - printf(fh, "~%"), - for j : 1 thru numVelNodes do ( - j0index : j-1+(i-1)*numVelNodes, - j1index : j+(i-1)*numVelNodes, - printf(fh, "~%"), - if no_by = true then ( - printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ;~%", dH_dz_nodes[cdim][j1index]) - ), - if no_by = false then ( - printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ", dH_dz_nodes[cdim][j1index]), - if cdim = 3 then ( - for k : 1 thru cdim do ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[k][j1index], k-1, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) - ) - ), - if cdim = 2 then ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 0, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) - ), - if cdim = 1 then ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) - ), - printf(fh, ";~%") - ), - - printf(fh, "~%"), - printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), - printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), - printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), - printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), - printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), - printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) - ), - printf(fh, "~%") - ), - - /* Do the quad nodal to modal ops directly here*/ - /*printf(fh, "~%"), - printf(fh, " double *fmodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), - flux_surf_nodal_e : doExpand1(flux_surf_nodal,basisNodal), - fmodproj_e : fullratsimp(calcInnerProdList(surfIntVars, 1, bSurf, flux_surf_nodal_e)), - - for i : 1 thru length(fmodproj_e) do ( - printf(fh, " fmodal[~a] = ~a; ~%", i-1, float(expand(fmodproj_e[i]))) - ), - - printf(fh, "~%"),*/ - /*Calculate the cfl*/ - pOrderCFL : polyOrder, - if polyOrder=1 then ( pOrderCFL : 2 ), - printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), - vprimeStr : "/vmap_prime_min", - printf(fh, "~%"), - printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), - - printf(fh, "~%") - ) else ( - printf(fh, " return 0.; ~%") - ), - flush_output(fh), - printf(fh, "} ~%") - -)$ +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac index 7282821a..88182f28 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac @@ -53,12 +53,7 @@ printPrototypes() := block([], const double *bmag, const double *phi, const double *dualcurlbhatoverB, const double *rtg33inv, const double* bioverJB, const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), - printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_vol_~ax~av_~a_p~a(const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const double *bmag, const double *phi, - const double *dualcurlbhatoverB, const double *rtg33inv, const double* bioverJB, - const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), - + for surfDir : 1 thru c+1 do ( if surfDir<=c then ( dirlabel : varsC[surfDir] @@ -83,19 +78,9 @@ printPrototypes() := block([], const double *flux_surf_l, const double *flux_surf_r, double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder), printf(fh, "GKYL_CU_DH double dg_gyrokinetic_boundary_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, - const double *vmap_prime_edge, const double *vmap_prime_skin, - const double *flux_surf_edge, const double *flux_surf_skin, - const int edge, double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder), - if dirlabel=vpar then ( - printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_c, const double *vmap_prime_r, - const double *flux_surf_l, const double *flux_surf_r, - double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder), - printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_boundary_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, const double *vmap_prime_edge, const double *vmap_prime_skin, const double *flux_surf_edge, const double *flux_surf_skin, const int edge, double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder) - ) ), printf(fh, "~%") ) @@ -117,4 +102,4 @@ printf(fh, "~%")$ printPrototypes()$ printf(fh, "~%")$ printf(fh, "EXTERN_C_END~%")$ -close(fh)$ +close(fh)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac index 18f5db41..f4f8e358 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac @@ -102,4 +102,4 @@ for bInd : 1 thru length(bName) do ( ) ) ) -)$ +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac index ef0b8a40..eb27bf41 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac @@ -69,4 +69,4 @@ for bInd : 1 thru length(bName) do ( ) ) ) -)$ +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index 1a8bdcef..d7efdee5 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -34,10 +34,9 @@ maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ maxVdim : [maxVdim_Ser, maxVdim_Tensor]$ /* Options for writing kernels with and without toroidal field (b_y=0), one per - dimension, or make the kernel only add electromagnetic terms. */ -byOpt : [[false, false], [false, false, false], [false, false, true]]$ -emOpt : [[false, true], [false, true, false], [false, true, false]]$ -optStr : ["", "add_em_", "no_by_"]$ + dimension. */ +byOpt : [[false], [false, true], [false, true]]$ +byStr : ["", "no_by_"]$ /* Options for writing kernels used at multiblock boundaries. One for each dimension. */ @@ -56,51 +55,48 @@ printPrototypes() := block([], for byI : 1 thru length(byOpt[c]) do ( no_by : byOpt[c][byI], - add_em : emOpt[c][byI], - opt_str : optStr[byI], - if not(add_em) then ( - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], - - for surfDir : 1 thru c do ( - dirlabel : varsC[surfDir], - extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", - vprimeargs : "", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~asurf~a_~ax~av_~a_p~a( + no_byStr : byStr[byI], + + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], + + for surfDir : 1 thru c do ( + dirlabel : varsC[surfDir], + extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", + vprimeargs : "", + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~asurf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", opt_str, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", opt_str, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) - ) + double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) ) ), + dirlabel : varsV[1], + extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", + vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - dirlabel : varsV[1], - extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", - vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~asurf~a_~ax~av_~a_p~a( + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~asurf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", opt_str, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + double* GKYL_RESTRICT flux_surf); ~%", no_byStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) ), printf(fh, "~%") @@ -123,4 +119,4 @@ printf(fh, "~%")$ printPrototypes()$ printf(fh, "~%")$ printf(fh, "EXTERN_C_END~%")$ -close(fh)$ +close(fh)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 25581b85..62aed087 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -102,4 +102,4 @@ for bInd : 1 thru length(bName) do ( ) ) ) -)$ +)$ \ No newline at end of file From a789c8f46c5a08f0247fe241d711de8dd624ea87 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 23 Oct 2025 15:03:19 -0400 Subject: [PATCH 04/66] restore electrostatic files --- maxima/g0/gk_collisionless/dg_gk-surf.mac | 1 + maxima/g0/gk_collisionless/dg_gk-vol.mac | 2 +- maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac | 2 +- maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac | 2 +- maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac | 2 +- maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac | 2 +- maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac | 2 +- maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac | 2 +- maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac | 2 +- 9 files changed, 9 insertions(+), 8 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-surf.mac b/maxima/g0/gk_collisionless/dg_gk-surf.mac index b657bab1..77901135 100644 --- a/maxima/g0/gk_collisionless/dg_gk-surf.mac +++ b/maxima/g0/gk_collisionless/dg_gk-surf.mac @@ -271,3 +271,4 @@ calcGKBoundarySurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrd flush_output(fh) )$ + diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index fccd4ab1..01905ad3 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -256,4 +256,4 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := printf(fh, " return 0.; ~%"), printf(fh, "} ~%") -)$ \ No newline at end of file +)$ diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 80e91ba2..34e06ea7 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -296,4 +296,4 @@ buildGKFluxConfESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no flush_output(fh), printf(fh, "} ~%") -)$ \ No newline at end of file +)$ diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 1b5f0054..a172abb2 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -239,4 +239,4 @@ buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no flush_output(fh), printf(fh, "} ~%") -)$ \ No newline at end of file +)$ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac index 88182f28..08e41563 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac @@ -102,4 +102,4 @@ printf(fh, "~%")$ printPrototypes()$ printf(fh, "~%")$ printf(fh, "EXTERN_C_END~%")$ -close(fh)$ \ No newline at end of file +close(fh)$ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac index f4f8e358..18f5db41 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac @@ -102,4 +102,4 @@ for bInd : 1 thru length(bName) do ( ) ) ) -)$ \ No newline at end of file +)$ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac index eb27bf41..ef0b8a40 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac @@ -69,4 +69,4 @@ for bInd : 1 thru length(bName) do ( ) ) ) -)$ \ No newline at end of file +)$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index d7efdee5..ebef045a 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -119,4 +119,4 @@ printf(fh, "~%")$ printPrototypes()$ printf(fh, "~%")$ printf(fh, "EXTERN_C_END~%")$ -close(fh)$ \ No newline at end of file +close(fh)$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 62aed087..25581b85 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -102,4 +102,4 @@ for bInd : 1 thru length(bName) do ( ) ) ) -)$ \ No newline at end of file +)$ From 90d8dd8b8dfe2b9ce168f23e06455b56d7237e75 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 23 Oct 2025 16:55:15 -0400 Subject: [PATCH 05/66] this commit is able to create all the add em kernels (empty) and the associated headers. --- .../g0/gk_collisionless/em/dg_gk-vol_em.mac | 282 ------------------ .../em/gk_collisionless_flux-surf-conf_em.mac | 85 ++++++ .../em/gk_collisionless_flux-surf-vpar_em.mac | 156 +--------- .../em/ms-dg_gyrokinetic-header_em.mac | 105 +++++++ .../em/ms-dg_gyrokinetic-surf_em.mac | 2 +- .../em/ms-dg_gyrokinetic-vol_em.mac | 2 +- .../em/ms-gk_collisionless_flux-header_em.mac | 52 ++-- .../em/ms-gk_collisionless_flux_em.mac | 71 +++-- 8 files changed, 263 insertions(+), 492 deletions(-) create mode 100644 maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-conf_em.mac create mode 100644 maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-header_em.mac diff --git a/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac b/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac index 678f4a6a..7536cfd2 100644 --- a/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac +++ b/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac @@ -40,288 +40,6 @@ buildGKAddEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_b printf(fh, " // fin: Distribution function.~%"), printf(fh, " // out: output increment.~%"), printf(fh, "~%"), - - - /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru pDim do ( - printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) - ), - printf(fh, "~%"), - rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), - - /* Declare variables with squared of cell centers and rdx2 variables (only need vpar^2). */ - printf(fh, " double rdvpar2Sq = rdvpar2*rdvpar2;~%"), - printf(fh, " double dvparSq = dxv[~a]*dxv[~a];~%", cdim, cdim), - printf(fh, "~%"), - replaceList : [rdvpar2^2=rdvpar2Sq,dxv[cdim]^2=dvparSq,rdvpar2Sq=4/dvparSq], - dvparSimp : append(makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pDim), - [dvparSq=4/rdvpar2Sq]), - - /* Create pointers to the components of b_i. */ - allVarLabelsC : ["x","y","z"], - for d : 1 thru 3 do ( - printf(fh, " const double *bioverJB_~a = &bioverJB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) - ), - printf(fh, "~%"), - - /* Create pointers to the components of dualcurlbhatoverB. */ - allVarLabelsC : ["x","y","z"], - for d : 1 thru 3 do ( - printf(fh, " const double *dualcurlbhatoverB_~a = &dualcurlbhatoverB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) - ), - printf(fh, "~%"), - - /* Axisymmetric basis (independent of y). */ - bmagBasis : getAxisymmetricConfBasis(bC), - /* Expand input fields for Hamiltonian calculation */ - phi_e : doExpand1(phi,bC), - apar_e : doExpand1(apar,bC), - bmag_e : doExpand1(bmag, bmagBasis), - - - /* dualcurlbhatoverB_x_e : doExpand1(dualcurlbhatoverB_x, bmagBasis), - dualcurlbhatoverB_y_e : doExpand1(dualcurlbhatoverB_y, bmagBasis), - dualcurlbhatoverB_z_e : doExpand1(dualcurlbhatoverB_z, bmagBasis), */ - /* Zero out some terms below to avoid the discontinuity of alpha in the - parallel direction (due to the discontinuity of Apar). Otherwise some - other treatment of some Apar terms or alpha may be needed. Initially we - had a step averaging alpha across the surface (just for the parallel - direction), but NRM suspects this might've caused instability in some - cases. Hence the zeros below. */ - discontFac : 0, - if cdim > 1 then (rdy2 : rdx2vec[2]) else (rdy2 : 0), - if cdim > 2 then (rdz2 : rdx2vec[3]) else (rdz2 : 0), - /* Expand e^x . \nabla \times A_\parallel / Bmag on basis. */ - dualcurlbAparoverB_x_e : (rdy2*diff(apar_e*b_z_e,y) - discontFac*rdz2*diff(apar_e*b_y_e,z))*jacobTotInv_e, - /* Expand e^y . \nabla \times A_\parallel / Bmag on basis. */ - dualcurlbAparoverB_y_e : (discontFac*rdz2*diff(apar_e*b_x_e,z) - rdx2vec[1]*diff(apar_e*b_z_e,x))*jacobTotInv_e, - /* Expand e^z . \nabla \times A_\parallel / Bmag on basis. */ - dualcurlbAparoverB_z_e : (discontFac*(rdx2vec[1]*diff(apar_e*b_y_e,x) - rdy2*diff(apar_e*b_x_e,y)))*jacobTotInv_e, - - varsP : listofvars(bP), - numP : length(bP), - - /* Project Bstar's onto basis, and print to arrays. */ - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - if cdim > 1 then ( - dualcurlbAparoverB_c : calcInnerProdList(varsP, 1, bP, dualcurlbAparoverB_x_e), - if (surfDir = 0 or surfDir = 1 or surfDir = cdim+1) then ( - printf(fh, " double dualcurlbAparoverB~a[~a] = {0.}; ~%", sideStr,numP), - writeCExprsNoExpand1(eval_string(sconcat("dualcurlbAparoverB",sideStr)), gcfac(subst(replaceList, dualcurlbAparoverB_c))), - printf(fh, "~%"), - flush_output(fh) - ), - dualcurlbAparoverB_noZero_c : makelistNoZeros1(dualcurlbAparoverB_c, eval_string(sconcat("dualcurlbAparoverB",sideStr))), - dualcurlbAparoverB_e : dualcurlbAparoverB_noZero_c . bP, - - dualcurlbAparoverB_y_c : calcInnerProdList(varsP, 1, bP, dualcurlbAparoverB_y_e), - if (surfDir = 0 or surfDir = 2 or surfDir = cdim+1) then ( - printf(fh, " double dualcurlbAparoverB_y~a[~a] = {0.}; ~%", sideStr, numP), - writeCExprsNoExpand1(eval_string(sconcat("dualcurlbAparoverB_y",sideStr)), gcfac(subst(replaceList, dualcurlbAparoverB_y_c))), - printf(fh, "~%"), - flush_output(fh) - ), - dualcurlbAparoverB_y_noZero_c : makelistNoZeros1(dualcurlbAparoverB_y_c, eval_string(sconcat("dualcurlbAparoverB_y",sideStr))), - dualcurlbAparoverB_y_e : dualcurlbAparoverB_y_noZero_c . bP - ), - if cdim # 2 then ( - dualcurlbAparoverB_z_c : calcInnerProdList(varsP, 1, bP, dualcurlbAparoverB_z_e), - if (surfDir=0 or surfDir>=cdim) then ( - printf(fh, " double dualcurlbAparoverB_z~a[~a] = {0.}; ~%", sideStr, numP), - writeCExprsNoExpand1(eval_string(sconcat("dualcurlbAparoverB_z",sideStr)), gcfac(subst(replaceList, dualcurlbAparoverB_z_c))), - printf(fh, "~%"), - flush_output(fh) - ), - dualcurlbAparoverB_z_noZero_c : makelistNoZeros1(dualcurlbAparoverB_z_c, eval_string(sconcat("dualcurlbAparoverB_z",sideStr))), - dualcurlbAparoverB_z_e : dualcurlbAparoverB_z_noZero_c . bP - ), - - /* Make Bstar/Bmag vector. */ - /* if cdim = 1 then ( - dualcurlbAparoverB_list : [dualcurlbAparoverB_z_e] - ) elseif cdim = 2 then ( - dualcurlbAparoverB_list : [dualcurlbAparoverB_x_e, dualcurlbAparoverB_y_e] - ) elseif cdim = 3 then ( - dualcurlbAparoverB_list : [dualcurlbAparoverB_x_e, dualcurlbAparoverB_y_e, dualcurlbAparoverB_z_e] - ), */ - - rtg33inv_e : doExpand1(rtg33inv, bmagBasis), - bioverJB_x_e : doExpand1(bioverJB_x, bmagBasis), - bioverJB_y_e : doExpand1(bioverJB_y, bmagBasis), - bioverJB_z_e : doExpand1(bioverJB_z, bmagBasis), - - dualcurlbAparoverB_list : [dualcurlbAparoverB_x_e, dualcurlbAparoverB_y_e, dualcurlbAparoverB_z_e], - bioverJB_list : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e], - - /* Velocity mapping fields. */ - [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), - - /* Redefine vmap_prime to exploit the relationship between it and vmap. */ - vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), - - /* Finally write out the hamiltonian*/ - hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], - if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), - hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), - printf(fh, " double hamil[~a] = {0.}; ~%", numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - hamilCvar : eval_string(sconcat("hamil")), - writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), - printf(fh, "~%"), - flush_output(fh), - hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), - /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bP, - - /*Expand Jf*/ - Jf_e : doExpand1(fin,bP), - - /* Calculate expressions for dericatives of the hamiltonian*/ - vpardim : pDim-1, - if vdim = 1 then ( vpardim : pDim ), - dH_dz_e : makelist(0, i, 1, pDim), - for i : 1 thru vpardim do ( - if i = vpardim then ( - dH_dz_e[i] : diff(hamil_e,varsP[i]) - ) - else ( - dH_dz_e[i] : diff(hamil_e*rdx2vec[i],varsP[i]) - ) - ), - - /*Make sure to avoid having hamil[i]^2 or vmap[i]^2 in expressions*/ - replaceListVpar : [vmap[1]^2=vmap2], - printf(fh, " double vmap2 = vmap[1]*vmap[1]; ~%"), - printf(fh, "~%"), - - mvpar_e : dH_dz_e[vpardim]/vmap_prime_e[1], - mvparsq_e : mvpar_e*mvpar_e/m_, - isqlist : [], - for i : 1 thru numP do ( - if freeof(hamil[i]^2, expand(mvparsq_e)) = false then ( - isqlist : append(isqlist,[i]) - ) - ), - - replaceListHamil : [], - printf(fh, " double hamil2[~a] = {0.}; ~%", length(isqlist)), - for i : 1 thru length(isqlist) do ( - printf(fh, " hamil2[~a] = hamil[~a]*hamil[~a]; ~%", i-1, isqlist[i], isqlist[i]), - replaceListHamil : append(replaceListHamil, [hamil[isqlist[i]]^2=hamil2[i-1]]) - ), - printf(fh, "~%"), - - /* Note: no contribution from mu. */ - for dir : 1 thru cdim+1 do ( - - dirLabel : varLabel[dir], - - wDir : eval_string(sconcat("w",dirLabel)), - rdDirVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - dirVar : varsP[dir], /* Variable in current direction. */ - - if dir = cdim then ( - alpha_e : rtg33inv_e*dH_dz_e[vpardim]/vmap_prime_e[1]/m_ - ) - else if dir = vpardim then ( - alpha_e : -rtg33inv_e * dH_dz_e[cdim]/m_ - ) - else ( - alpha_e : 0 - ), - - - if no_by = false then ( - if cdim = 3 then ( - curvdriftdir : dir - ), - if cdim = 2 then ( - if dir = 1 then ( - curvdriftdir : dir - ), - if dir = 2 then ( - curvdriftdir : 3 - ) - ), - if cdim = 1 then ( - curvdriftdir : 3 - ), - - if dir < vpardim then ( - alpha_e : alpha_e + dualcurlbAparoverB_list[curvdriftdir]*dH_dz_e[vpardim]/vmap_prime_e[1]*dH_dz_e[vpardim]/vmap_prime_e[1]/m_/q_ - ), - if cdim = 3 then ( - if dir = 1 then ( - alpha_e : alpha_e + 1/q_ * (bioverJB_list[2]*dH_dz_e[3] - bioverJB_list[3]*dH_dz_e[2]) - ), - if dir = 2 then ( - alpha_e : alpha_e + 1/q_ * (bioverJB_list[3]*dH_dz_e[1] - bioverJB_list[1]*dH_dz_e[3]) - ), - if dir = 3 then ( - alpha_e : alpha_e + 1/q_ * (bioverJB_list[1]*dH_dz_e[2] - bioverJB_list[2]*dH_dz_e[1]) - ) - ), - if cdim = 2 then ( - if dir = 1 then ( - alpha_e : alpha_e + 1/q_ * (bioverJB_list[2]*dH_dz_e[2]) - ), - if dir = 2 then ( - alpha_e : alpha_e - 1/q_ * (bioverJB_list[2]*dH_dz_e[1]) - ) - ), - if dir = vpardim then ( - if cdim = 3 then ( - for k : 1 thru cdim do ( - alpha_e : alpha_e - dualcurlbAparoverB_list[k]*dH_dz_e[k]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ - ) - ), - if cdim = 2 then ( - alpha_e : alpha_e - dualcurlbAparoverB_list[1]*dH_dz_e[1]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ - dualcurlbAparoverB_list[3]*dH_dz_e[2]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ - ), - if cdim = 1 then ( - alpha_e : alpha_e - dualcurlbAparoverB_list[3]*dH_dz_e[1]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ - ) - ) - - ), - - if dir < vpardim then ( - alpha_e : alpha_e*rdx2vec[dir] - ) - else if dir = vpardim then ( - alpha_e : alpha_e/vmap_prime_e[1] - ), - - /* Project alpha on basis and write to array. */ - printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), - alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), - alpha_c : subst(replaceList, alpha_c), - alpha_c : subst(replaceListHamil, alpha_c), - alpha_c : subst(replaceListVpar, alpha_c), - alpha_c : subst(dvparSimp, alpha_c), - alphaLabel : eval_string(sconcat(alpha, dirLabel)), - clst : [rdx2vec, rdv2vec, m_, q_, wvpar, rdvpar2Sq, - makelist(dxv[i-1],i,1,pDim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], - writeCExprsCollect1(alphaLabel, alpha_c, clst), - printf(fh, "~%"), - flush_output(fh), - alphaNoZero_c : makelistNoZeros1(alpha_c, alphaLabel), - alpha_e : doExpand(alphaNoZero_c, bP), - - alphaJf_e : alpha_e*Jf_e, - - printf(fh, "~%"), - volTerm_c : fullratsimp(calcInnerProdList(varsP, 1, diff(bP,varsP[dir]), alphaJf_e)), - volTerm_c : subst(replaceList, volTerm_c), - writeCIncrExprsNoExpand(gcfac(float(expand(volTerm_c)))), - flush_output(fh), - printf(fh, "~%") - - ), - - printf(fh, " return 0.; ~%"), printf(fh, "} ~%") )$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-conf_em.mac b/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-conf_em.mac new file mode 100644 index 00000000..50c5cfcc --- /dev/null +++ b/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-conf_em.mac @@ -0,0 +1,85 @@ +load("modal-basis")$ +load("out-scripts")$ +load(stringproc)$ +load("scifac")$ +load("utilities_gyrokinetic")$ +load("nodal_operations/nodal_functions")$ +fpprec : 24$ + +buildGKFluxConfAddEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge, mb_bound) := block( + [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, + surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, + numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,bmagSurf_e,vmap_e,vmapSq_e, + vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, + jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, + dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL + ], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + surfIntVarsC : delete(surfVar,varsC), + bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + nodeVars : surfIntVars, + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + nodeVars : surfIntVars, + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) + ), + if cdim = 1 then ( + surfConfigNodes : [1] + ) + else ( + surfConfigNodes : gaussOrd(polyOrder+1, cdim-1) + ), + numSurfNodes : length(surfNodes), + numSurfConfigNodes : length(surfConfigNodes), + numVelNodes : numSurfNodes/numSurfConfigNodes, + numMuNodes : 1, + if vdim > 1 then ( numMuNodes : 2), + numVparNodes : numVelNodes/numMuNodes, + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, + const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // dgs: surface DG geometry.~%"), + printf(fh, " // gkdgs: gyrokinetic surface DG geometry.~%"), + printf(fh, " // bmag: bmag represented on the surface.~%"), + printf(fh, " // jacobgeo_rat_surfL: Ratio of surface conf-space Jacobians in left cell.~%"), + printf(fh, " // jacobgeo_rat_surfR: Ratio of surface conf-space Jacobians in right cell.~%"), + printf(fh, " // phi: electrostatic potential.~%"), + printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), + printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), + printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), + printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), + printf(fh, "~%"), + + + printf(fh, " return 0.; ~%"), + printf(fh, "} ~%") +)$ diff --git a/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac b/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac index d1208032..f856ffb8 100644 --- a/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac +++ b/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac @@ -85,160 +85,6 @@ buildGKFluxVparAddEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), printf(fh, "~%"), - /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru cdim+1 do ( - printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) - ), - printf(fh, "~%"), - rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), - - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - /* Axisymmetric basis (independent of y). */ - bmagBasis : getAxisymmetricConfBasis(bC), - - /* Expand input fields for Hamiltonian calculation */ - phi_e : doExpand1(phi,bC), - bmag_e : doExpand1(bmag, bmagBasis), - - /* Velocity mapping fields. */ - [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), - - /* Redefine vmap_prime to exploit the relationship between it and vmap. */ - /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ - vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), - - if edge = true then ( - evPoint : 1 - ) else ( - evPoint : -1 - ), - - /* Finally write out the hamiltonian*/ - hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], - if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), - hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), - printf(fh, " double hamil[~a] = {0.}; ~%", numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - hamilCvar : eval_string(sconcat("hamil")), - writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), - printf(fh, "~%"), - flush_output(fh), - hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), - /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bP, - /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ - - /*fl and fr */ - JfL_e : doExpand1(JfL, bP), - JfR_e : doExpand1(JfR, bP), - JfL_c : calcInnerProdList(varsP, 1, bP, JfL_e), - JfR_c : calcInnerProdList(varsP, 1, bP, JfR_e), - - JfL_e : subst(surfVar=1,JfL_e), - JfR_e : subst(surfVar=-1,JfR_e), - - JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), - JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), - - vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), - - vpardim : pDim-1, - if vdim = 1 then ( vpardim : pDim ), - dH_dz_nodes : makelist(0, i, 1, pDim), - for i : 1 thru vpardim do ( - if i = vpardim then ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars)), - dH_dz_nodes[i] : subst(surfVar=evPoint, dH_dz_nodes[i]) - ) - else ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) - ) - ), - - /* Now calculate apha at all quadrature nodes */ - /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ - printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), - printf(fh, " double cfl = 0.0; ~%"), - printf(fh, " double bmag_quad = 0.0; ~%"), - printf(fh, " double B3_quad = 0.0; ~%"), - printf(fh, " double Jc_quad = 0.0; ~%"), - printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), - - printf(fh, " double alpha_quad = 0.0; ~%"), - printf(fh, " double JfL_quad = 0.0; ~%"), - printf(fh, " double JfR_quad = 0.0; ~%"), - printf(fh, " double Jfavg_quad = 0.0; ~%"), - printf(fh, " double Jfjump_quad = 0.0; ~%"), - printf(fh, "~%"), - - for i : 1 thru numConfigNodes do ( - printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i-1), - printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i-1), - printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i-1), - printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i-1), - printf(fh, "~%"), - for j : 1 thru numVelNodes do ( - j0index : j-1+(i-1)*numVelNodes, - j1index : j+(i-1)*numVelNodes, - printf(fh, "~%"), - if no_by = true then ( - printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ;~%", dH_dz_nodes[cdim][j1index]) - ), - if no_by = false then ( - printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ", dH_dz_nodes[cdim][j1index]), - if cdim = 3 then ( - for k : 1 thru cdim do ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[k][j1index], k-1, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) - ) - ), - if cdim = 2 then ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 0, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) - ), - if cdim = 1 then ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) - ), - printf(fh, ";~%") - ), - - printf(fh, "~%"), - printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), - printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), - printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), - printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), - printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), - printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) - ), - printf(fh, "~%") - ), - - /* Do the quad nodal to modal ops directly here*/ - /*printf(fh, "~%"), - printf(fh, " double *fmodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), - flux_surf_nodal_e : doExpand1(flux_surf_nodal,basisNodal), - fmodproj_e : fullratsimp(calcInnerProdList(surfIntVars, 1, bSurf, flux_surf_nodal_e)), - - for i : 1 thru length(fmodproj_e) do ( - printf(fh, " fmodal[~a] = ~a; ~%", i-1, float(expand(fmodproj_e[i]))) - ), - - printf(fh, "~%"),*/ - /*Calculate the cfl*/ - pOrderCFL : polyOrder, - if polyOrder=1 then ( pOrderCFL : 2 ), - printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), - vprimeStr : "/vmap_prime_min", - printf(fh, "~%"), - printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), - - printf(fh, "~%") - - printf(fh, " return 0.; ~%") - flush_output(fh), + printf(fh, " return 0.; ~%"), printf(fh, "} ~%") - )$ diff --git a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-header_em.mac b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-header_em.mac new file mode 100644 index 00000000..3ecb7cfd --- /dev/null +++ b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-header_em.mac @@ -0,0 +1,105 @@ +/* Compute the header file for gyrokinetic collisionless equation object kernels. */ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +maxPolyOrder_Ser : 2$ +minCdim_Ser : 1$ +minVdim_Ser : 1$ +maxCdim_Ser : 3$ +maxVdim_Ser : 2$ + +/* Tensor order basis. */ +maxPolyOrder_Tensor : 2$ +minCdim_Tensor : 1$ +minVdim_Tensor : 1$ +maxCdim_Tensor : 0$ +maxVdim_Tensor : 0$ + +/* Number of velocity dimensions allowed for each + configuration-space dimension. */ +gkVdims : [[1,2], [2], [2]]$ + +/* ...... END OF USER INPUTS........ */ + +varsC : [x, y, z]$ +varsV : [vpar, mu]$ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +minVdim : [minVdim_Ser, minVdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ +maxVdim : [maxVdim_Ser, maxVdim_Tensor]$ + +printPrototypes() := block([], + for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ + for polyOrder : 1 thru maxPolyOrderB do ( + + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_vol_~ax~av_~a_p~a(const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const double *bmag, const double *phi, + const double *dualcurlbhatoverB, const double *rtg33inv, const double* bioverJB, + const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_no_by_vol_~ax~av_~a_p~a(const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const double *bmag, const double *phi, + const double *dualcurlbhatoverB, const double *rtg33inv, const double* bioverJB, + const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), + + for surfDir : 1 thru c+1 do ( + if surfDir<=c then ( + dirlabel : varsC[surfDir] + ) else ( + dirlabel : varsV[surfDir-c] + ), + + if surfDir<=c then ( + extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, " + ) else ( + extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, " + ), + + if surfDir<=c then ( + vprimeargs : "" + ) else ( + vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, " + ), + + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_c, const double *vmap_prime_r, + const double *flux_surf_l, const double *flux_surf_r, + double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder), + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_boundary_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, + const double *vmap_prime_edge, const double *vmap_prime_skin, + const double *flux_surf_edge, const double *flux_surf_skin, + const int edge, double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder) + ), + printf(fh, "~%") + ) + ) + ) + ) +)$ + +fh : openw("~/max-out/gkyl_dg_gyrokinetic_kernels.h")$ +printf(fh, "#pragma once~%")$ +printf(fh, "~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "~%")$ +printf(fh, "EXTERN_C_BEG~%")$ +printf(fh, "~%")$ +printPrototypes()$ +printf(fh, "~%")$ +printf(fh, "EXTERN_C_END~%")$ +close(fh)$ diff --git a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac index b4519e55..85a5baf4 100644 --- a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac +++ b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac @@ -5,7 +5,7 @@ The functions called in this file are in gkFuncs-surf.mac. */ -load("gk_collisionless/dg_gk-surf")$ +load("gk_collisionless/em/dg_gk-surf_em")$ /* ...... USER INPUTS........ */ diff --git a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac index 06d70168..e2766cb2 100644 --- a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac +++ b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac @@ -3,7 +3,7 @@ The functions called in this file are in gkFuncs-vol.mac. */ -load("gk_collisionless/dg_gk-vol")$ +load("gk_collisionless/em/dg_gk-vol_em")$ /* ...... USER INPUTS........ */ diff --git a/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac b/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac index 1a8bdcef..f51e3991 100644 --- a/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac +++ b/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac @@ -34,10 +34,9 @@ maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ maxVdim : [maxVdim_Ser, maxVdim_Tensor]$ /* Options for writing kernels with and without toroidal field (b_y=0), one per - dimension, or make the kernel only add electromagnetic terms. */ -byOpt : [[false, false], [false, false, false], [false, false, true]]$ -emOpt : [[false, true], [false, true, false], [false, true, false]]$ -optStr : ["", "add_em_", "no_by_"]$ + dimension. */ +byOpt : [[false], [false, true], [false, true]]$ +byStr : ["", "no_by_"]$ /* Options for writing kernels used at multiblock boundaries. One for each dimension. */ @@ -56,51 +55,48 @@ printPrototypes() := block([], for byI : 1 thru length(byOpt[c]) do ( no_by : byOpt[c][byI], - add_em : emOpt[c][byI], - opt_str : optStr[byI], - if not(add_em) then ( - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], - - for surfDir : 1 thru c do ( - dirlabel : varsC[surfDir], - extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", - vprimeargs : "", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~asurf~a_~ax~av_~a_p~a( + no_byStr : byStr[byI], + + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], + + for surfDir : 1 thru c do ( + dirlabel : varsC[surfDir], + extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", + vprimeargs : "", + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_em_~a~asurf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", opt_str, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_em_~a~aedge_surf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", opt_str, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) - ) + double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) ) ), + dirlabel : varsV[1], + extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", + vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - dirlabel : varsV[1], - extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", - vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~asurf~a_~ax~av_~a_p~a( + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_em_~asurf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", opt_str, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + double* GKYL_RESTRICT flux_surf); ~%", no_byStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) ), printf(fh, "~%") @@ -110,7 +106,7 @@ printPrototypes() := block([], ) )$ -fh : openw("~/max-out/gkyl_gk_collisionless_flux_kernels.h")$ +fh : openw("~/max-out/gkyl_gk_collisionless_flux_kernels_add_em.h")$ printf(fh, "#pragma once~%")$ printf(fh, "~%")$ printf(fh, "#include ~%")$ diff --git a/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac b/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac index 5f4b9bfc..4844eeb9 100644 --- a/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac +++ b/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac @@ -3,8 +3,8 @@ The functions called in this file are in gkFuncs-alpha-surf.mac. */ -load("gk_collisionless/gk_collisionless_flux-surf-conf")$ -load("gk_collisionless/gk_collisionless_flux-surf-vpar")$ +load("gk_collisionless/em/gk_collisionless_flux-surf-conf_em")$ +load("gk_collisionless/em/gk_collisionless_flux-surf-vpar_em")$ /* ...... USER INPUTS........ */ @@ -36,10 +36,9 @@ clabels : ["x","y","z"]$ vlabels : ["vpar","mu"]$ /* Options for writing kernels with and without toroidal field (b_y=0), one per - dimension, or make the kernel only add electromagnetic terms. */ -byOpt : [[false, false], [false, false, false], [false, false, true]]$ -emOpt : [[false, true], [false, true, false], [false, true, false]]$ -optStr : ["", "add_em_", "no_by_"]$ + dimension. */ +byOpt : [[false], [false, true], [false, true]]$ +byStr : ["", "no_by_"]$ /* Options for writing kernels used at multiblock boundaries. One for each dimension. */ @@ -58,25 +57,47 @@ for bInd : 1 thru length(bName) do ( for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( for byI : 1 thru length(byOpt[c]) do ( no_by : byOpt[c][byI], - add_em : emOpt[c][byI], - opt_str : optStr[byI], - - if add_em then ( - /* Surface flux in vparallel direction.*/ - fname : sconcat("~/max-out/gk_collisionless_flux_",opt_str,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar ~a file: ~a",opt_str,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_collisionless_flux_",opt_str,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - if add_em then ( - buildGKFluxVparAddEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false) - ) else ( - buildGKFluxVparESKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false) - ), - close(fh) - ) + no_byStr : byStr[byI], + + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], + + /* Surface flux in direction dir in configuration space.*/ + for dir : 1 thru c do ( + + fname : sconcat("~/max-out/gk_collisionless_flux_add_em_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_collisionless_flux_add_em_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + buildGKFluxConfAddEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false, mb_bound), + close(fh), + + fname : sconcat("~/max-out/gk_collisionless_flux_add_em_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_collisionless_flux_add_em_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + buildGKFluxConfAddEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, true, mb_bound), + close(fh) + ) + ), + + /* Surface flux in vparallel direction.*/ + fname : sconcat("~/max-out/gk_collisionless_flux_add_em_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_collisionless_flux_add_em_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + buildGKFluxVparAddEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false), + close(fh) ) ) ) From fc855f84f356546f373f7b2c537d5bf6398dbb03 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 4 Nov 2025 11:55:52 -0500 Subject: [PATCH 06/66] New way of handling the EM kernels. We now generate two types of EM kernels, add_apar and add_apardot kernels. We conserve the electrostatic part of the scripts. --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 286 ++++++ .../g0/gk_collisionless/em/dg_gk-surf_em.mac | 158 --- .../g0/gk_collisionless/em/dg_gk-vol_em.mac | 45 - maxima/g0/gk_collisionless/em/gkUtil.mac | 954 ------------------ .../em/gk_collisionless_flux-surf-conf_em.mac | 85 -- .../em/gk_collisionless_flux-surf-vpar_em.mac | 90 -- .../em/ms-dg_gyrokinetic-header_em.mac | 105 -- .../em/ms-dg_gyrokinetic-surf_em.mac | 83 -- .../em/ms-dg_gyrokinetic-vol_em.mac | 72 -- .../em/ms-gk_collisionless_flux-header_em.mac | 122 --- .../em/ms-gk_collisionless_flux_em.mac | 105 -- .../gk_collisionless_flux-surf-conf.mac | 302 ++++++ .../gk_collisionless_flux-surf-vpar.mac | 417 ++++++++ .../ms-dg_gyrokinetic-header.mac | 21 + .../ms-dg_gyrokinetic-vol.mac | 17 + .../ms-gk_collisionless_flux-header.mac | 83 ++ .../ms-gk_collisionless_flux.mac | 50 +- 17 files changed, 1174 insertions(+), 1821 deletions(-) delete mode 100644 maxima/g0/gk_collisionless/em/dg_gk-surf_em.mac delete mode 100644 maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac delete mode 100644 maxima/g0/gk_collisionless/em/gkUtil.mac delete mode 100644 maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-conf_em.mac delete mode 100644 maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac delete mode 100644 maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-header_em.mac delete mode 100644 maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac delete mode 100644 maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac delete mode 100644 maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac delete mode 100644 maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 01905ad3..62df8500 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -257,3 +257,289 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := printf(fh, "} ~%") )$ + +addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( + [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, + bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, + hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, + dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + varLabel : makelist(string(varsP[d]),d,1,pDim), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, const double *vmap, const double *vmapSq, + const double q_, const double m_, const double *bmag, const double *jacobtot_inv, + const double *b_i, const double *phi, const double *apar, const double *fin, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // bmag: magnetic field amplitude.~%"), + printf(fh, " // jacobtot_inv: reciprocal of the conf-space jacobian time the guiding center coordinate Jacobian.~%"), + printf(fh, " // b_i: covariant components of the field aligned unit vector.~%"), + printf(fh, " // apar: parallel component of magnetic vector potential.~%"), + printf(fh, " // phi: electrostatic potential .~%"), + printf(fh, " // fin: Distribution function.~%"), + printf(fh, " // out: output increment.~%"), + printf(fh, "~%"), + + /* Declare cell-center variables and variables multiplying gradients. */ + for d : 1 thru pDim do ( + printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) + ), + printf(fh, "~%"), + rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + + /* Declare variables with squared of cell centers and rdx2 variables (only need vpar^2). */ + printf(fh, " double rdvpar2Sq = rdvpar2*rdvpar2;~%"), + printf(fh, " double dvparSq = dxv[~a]*dxv[~a];~%", cdim, cdim), + printf(fh, "~%"), + replaceList : [rdvpar2^2=rdvpar2Sq,dxv[cdim]^2=dvparSq,rdvpar2Sq=4/dvparSq], + dvparSimp : append(makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pDim), + [dvparSq=4/rdvpar2Sq]), + + allVarLabelsC : ["x","y","z"], + for d : 1 thru 3 do ( + printf(fh, " const double *b_~a = &b_i[~a];~%", allVarLabelsC[d], numC*(d-1)) + ), + printf(fh, "~%"), + + /* Axisymmetric basis (independent of y). */ + bmagBasis : getAxisymmetricConfBasis(bC), + /* Expand input fields for Hamiltonian calculation */ + phi_e : doExpand1(phi,bC), + bmag_e : doExpand1(bmag, bmagBasis), + rtg33inv_e : doExpand1(rtg33inv, bmagBasis), + bioverJB_x_e : doExpand1(bioverJB_x, bmagBasis), + bioverJB_y_e : doExpand1(bioverJB_y, bmagBasis), + bioverJB_z_e : doExpand1(bioverJB_z, bmagBasis), + b_x_e : doExpand1(b_x, bmagBasis), + b_y_e : doExpand1(b_y, bmagBasis), + if (no_by or cdim = 1) then (b_y_e : 0), + b_z_e : doExpand1(b_z, bmagBasis), + jacobTotInv_e : doExpand1(jacobtot_inv, bmagBasis), + + bioverJB_list : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e], + + /* Velocity mapping fields. */ + [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + + /* Redefine vmap_prime to exploit the relationship between it and vmap. */ + vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), + + /* Finally write out the hamiltonian*/ + hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), + hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), + printf(fh, " double hamil[~a] = {0.}; ~%", numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + hamilCvar : eval_string(sconcat("hamil")), + writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), + printf(fh, "~%"), + flush_output(fh), + hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), + /* Expand projected Hamiltonian on basis. */ + hamil_e : hamilNoZero_c . bP, + + /*Expand Jf*/ + Jf_e : doExpand1(fin,bP), + + /* Calculate expressions for dericatives of the hamiltonian*/ + vpardim : pDim-1, + if vdim = 1 then ( vpardim : pDim ), + dH_dz_e : makelist(0, i, 1, pDim), + for i : 1 thru vpardim do ( + if i = vpardim then ( + dH_dz_e[i] : diff(hamil_e,varsP[i]) + ) + else ( + dH_dz_e[i] : diff(hamil_e*rdx2vec[i],varsP[i]) + ) + ), + + /*Make sure to avoid having hamil[i]^2 or vmap[i]^2 in expressions*/ + replaceListVpar : [vmap[1]^2=vmap2], + printf(fh, " double vmap2 = vmap[1]*vmap[1]; ~%"), + printf(fh, "~%"), + + mvpar_e : dH_dz_e[vpardim]/vmap_prime_e[1], + mvparsq_e : mvpar_e*mvpar_e/m_, + isqlist : [], + for i : 1 thru numP do ( + if freeof(hamil[i]^2, expand(mvparsq_e)) = false then ( + isqlist : append(isqlist,[i]) + ) + ), + + replaceListHamil : [], + printf(fh, " double hamil2[~a] = {0.}; ~%", length(isqlist)), + for i : 1 thru length(isqlist) do ( + printf(fh, " hamil2[~a] = hamil[~a]*hamil[~a]; ~%", i-1, isqlist[i], isqlist[i]), + replaceListHamil : append(replaceListHamil, [hamil[isqlist[i]]^2=hamil2[i-1]]) + ), + printf(fh, "~%"), + + /* Expand Apar.*/ + Apar_e : doExpand1(apar,bC), + + /* Expand dBperp/Bmag. */ + dBperpoverB_x : (rdy2*diff(Apar_e*b_z_e,y) - rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e, + dBperpoverB_y : (rdz2*diff(Apar_e*b_x_e,z) - rdx2*diff(Apar_e*b_z_e,x))*jacobTotInv_e, + dBperpoverB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e, + dBperpoverB_list : [dBperpoverB_x, dBperpoverB_y, dBperpoverB_z], + + /* Note: no contribution from mu. */ + for dir : 1 thru cdim+1 do ( + + dirLabel : varLabel[dir], + + wDir : eval_string(sconcat("w",dirLabel)), + rdDirVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + dirVar : varsP[dir], /* Variable in current direction. */ + + alpha_e : 0, + + if no_by = false then ( + if cdim = 3 then ( + curvdriftdir : dir + ), + if cdim = 2 then ( + if dir = 1 then ( + curvdriftdir : dir + ), + if dir = 2 then ( + curvdriftdir : 3 + ) + ), + if cdim = 1 then ( + curvdriftdir : 3 + ), + + if dir < vpardim then ( + alpha_e : alpha_e + dBperpoverB_list[curvdriftdir]/m_ * mvpar_e + ), + if dir = vpardim then ( + if cdim = 3 then ( + for k : 1 thru cdim do ( + alpha_e : alpha_e - dBperpoverB_list[k]/m_ * dH_dz_e[k] + ) + ), + if cdim = 2 then ( + alpha_e : alpha_e - dBperpoverB_list[1]/m_ * dH_dz_e[1] - dBperpoverB_list[3]/m_ * dH_dz_e[2] + ), + if cdim = 1 then ( + alpha_e : alpha_e - dBperpoverB_list[3]/m_ * dH_dz_e[1] + ) + ) + ), + + if dir < vpardim then ( + alpha_e : alpha_e*rdx2vec[dir] + ) + else if dir = vpardim then ( + alpha_e : alpha_e/vmap_prime_e[1] + ), + + /* Project alpha on basis and write to array. */ + printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), + alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), + alpha_c : subst(replaceList, alpha_c), + alpha_c : subst(replaceListHamil, alpha_c), + alpha_c : subst(replaceListVpar, alpha_c), + alpha_c : subst(dvparSimp, alpha_c), + alphaLabel : eval_string(sconcat(alpha, dirLabel)), + clst : [rdx2vec, rdv2vec, m_, q_, wvpar, rdvpar2Sq, + makelist(dxv[i-1],i,1,pDim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], + writeCExprsCollect1(alphaLabel, alpha_c, clst), + printf(fh, "~%"), + flush_output(fh), + alphaNoZero_c : makelistNoZeros1(alpha_c, alphaLabel), + alpha_e : doExpand(alphaNoZero_c, bP), + + alphaJf_e : alpha_e*Jf_e, + + printf(fh, "~%"), + volTerm_c : fullratsimp(calcInnerProdList(varsP, 1, diff(bP,varsP[dir]), alphaJf_e)), + volTerm_c : subst(replaceList, volTerm_c), + writeCIncrExprsNoExpand(gcfac(float(expand(volTerm_c)))), + flush_output(fh), + printf(fh, "~%") + + ), + + printf(fh, " return 0.; ~%"), + printf(fh, "} ~%") + +)$ + +addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( + [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, + bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, + hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, + dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + varLabel : makelist(string(varsP[d]),d,1,pDim), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a(const double q_, const double m_, const double *apardot, + const double *fin, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // apardot: time derivative of parallel component of magnetic vector potential.~%"), + printf(fh, " // fin: Distribution function.~%"), + printf(fh, " // out: output increment.~%"), + printf(fh, "~%"), + + /* Velocity mapping fields. */ + [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + + /*Expand Jf*/ + Jf_e : doExpand1(fin,bP), + + /* Expand Apardot */ + apardot_e : doExpand1(apardot,bP), + + /* Note: only a vpar contribution. */ + dir : cdim+1, + dirLabel : varLabel[dir], + + alpha_e : -q_/m_ * apardot_e, + + /* Project alpha on basis and write to array. */ + printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), + alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), + alphaLabel : eval_string(sconcat(alpha, dirLabel)), + clst : [rdx2vec, rdv2vec, m_, q_, wvpar, rdvpar2Sq, + makelist(dxv[i-1],i,1,pDim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], + writeCExprsCollect1(alphaLabel, alpha_c, clst), + printf(fh, "~%"), + flush_output(fh), + alphaNoZero_c : makelistNoZeros1(alpha_c, alphaLabel), + alpha_e : doExpand(alphaNoZero_c, bP), + + alphaJf_e : alpha_e*Jf_e, + + printf(fh, "~%"), + volTerm_c : fullratsimp(calcInnerProdList(varsP, 1, diff(bP,varsP[dir]), alphaJf_e)), + writeCIncrExprsNoExpand(gcfac(float(expand(volTerm_c)))), + flush_output(fh), + printf(fh, "~%"), + + printf(fh, " return 0.; ~%"), + printf(fh, "} ~%") + +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/em/dg_gk-surf_em.mac b/maxima/g0/gk_collisionless/em/dg_gk-surf_em.mac deleted file mode 100644 index f2facaa3..00000000 --- a/maxima/g0/gk_collisionless/em/dg_gk-surf_em.mac +++ /dev/null @@ -1,158 +0,0 @@ -/* - Create kernels for the surface term of the gyrokinetic collisionless terms. -*/ -load("modal-basis")$ -load("out-scripts")$ -load(stringproc)$ -load("scifac")$ -load("utilities_gyrokinetic")$ -load("nodal_operations/nodal_functions")$ -fpprec : 24$ - -/* Types of boundary stencils: - - domain_bound: Domain boundary. - - interblock_bound: Interblock boundary. -*/ -bound_surf_bc_type : ["domain_bound","interblock_bound"]$ - -/* Boundary sidex. */ -bound_side : ["lower","upper"]$ - -calcGKAddEMSurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB) := block( - [pDim,varsC,bC,varsP,bP,vSub,surfVar,varLabel,dirLabel, - surfIntVars,surf_cvars,surf_vvars,surfNodes,bSurf,basisStr,NSurf,numNodes, - tempVars,tempBasis,NSurfIndexing,numNodesIndexing, - rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e, - BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, - hamil_e,alphaSurfL_e,alphaSurfR_e, - fl_e,fc_e,fr_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL, - fnodal_l_e, fnodal_r_e, fmodproj_e], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), - basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) - ), - NSurf : length(bSurf), - numNodes : length(surfNodes), - /* if polyOrder = 1 and we're doing the vpar update, we need to be careful about - indexing input arrays since the surface hybrid basis has a different size at the - vparallel surfaces */ - if (surfDir = cdim+1 and polyOrder = 1) then ( - tempVars : delete(x,varsP), - tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), - NSurfIndexing : length(tempBasis), - numNodesIndexing : length(tempBasis), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) - ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes, - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) - ), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_c, const double *vmap_prime_r, - const double *flux_surf_l, const double *flux_surf_r, - double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap_prime_l,vmap_prime_c,vmap_prime_r: velocity space mapping derivative in left, center and right cells.~%"), - printf(fh, " // flux_surf_l: Surface expansion of phase space flux on the left.~%"), - printf(fh, " // flux_surf_r: Surface expansion of phase space flux on the right.~%"), - printf(fh, " // out: output increment in center cell.~%"), - printf(fh, "~%"), - printf(fh, " return 0.0; ~%"), - printf(fh, "~%"), - - printf(fh, "} ~%"), - flush_output(fh) - -)$ - -calcGKAddEMBoundarySurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB) := block( - [pDim,varsC,bC,varsP,bP,vSub,surfVar,varLabel,dirLabel, - surfIntVars,surf_cvars,surf_vvars,surfNodes,bSurf,basisStr,NSurf,numNodes, - tempVars,tempBasis,NSurfIndexing,numNodesIndexing, - rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e, - BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, - hamil_e,alphaUpL_e,alphaSurfL_e,alphaUpSurfL_e,alphaUpR_e,alphaSurfR_e,alphaUpSurfR_e, - fEdge_e,fSkin_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), - basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) - ), - NSurf : length(bSurf), - numNodes : length(surfNodes), - - /* if polyOrder = 1 and we're doing the vpar update, we need to be careful about - indexing input arrays since the surface hybrid basis has a different size at the - vparallel surfaces */ - if (surfDir = cdim+1 and polyOrder = 1) then ( - tempVars : delete(x,varsP), - tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), - NSurfIndexing : length(tempBasis), - numNodesIndexing : length(tempBasis), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) - ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes, - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) - ), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, - const double *vmap_prime_edge, const double *vmap_prime_skin, - const double *flux_surf_edge, const double *flux_surf_skin, - const int edge, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap_prime_edge,vmap_prime_skin: velocity space mapping derivative in edge and skin cells.~%"), - printf(fh, " // flux_surf_edge: Surface expansion of phase space flux on the lower edges of the edge cell.~%"), - printf(fh, " // flux_surf_skin: Surface expansion of phase space flux on the lower edges of the skin cell.~%"), - printf(fh, " // edge: determines if the update is for the left edge (-1) or right edge (+1).~%"), - printf(fh, " // out: output increment in center cell.~%"), - printf(fh, "~%"), - printf(fh, " return 0.0; ~%"), - printf(fh, "~%"), - - printf(fh, "} ~%"), - flush_output(fh) - -)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac b/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac deleted file mode 100644 index 7536cfd2..00000000 --- a/maxima/g0/gk_collisionless/em/dg_gk-vol_em.mac +++ /dev/null @@ -1,45 +0,0 @@ -/* - Create kernels for the volume term of the gyrokinetic collisionless terms. -*/ - -load("modal-basis")$ -load("out-scripts")$ -load(stringproc)$ -load("scifac")$ -load("utilities_gyrokinetic")$ -load("utilities")$ -fpprec : 24$ - -buildGKAddEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( - [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, - bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, - hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - varLabel : makelist(string(varsP[d]),d,1,pDim), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, const double *vmap, const double *vmapSq, - const double q_, const double m_, const double *bmag, const double *phi, - const double *apar, const double *rtg33inv, const double *bioverJB, - const double *fin, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // bmag: magnetic field amplitude.~%"), - printf(fh, " // phi: electrostatic potential .~%"), - printf(fh, " // apar: parallel component of vector potential.~%"), - printf(fh, " // fin: Distribution function.~%"), - printf(fh, " // out: output increment.~%"), - printf(fh, "~%"), - printf(fh, " return 0.; ~%"), - printf(fh, "} ~%") -)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/em/gkUtil.mac b/maxima/g0/gk_collisionless/em/gkUtil.mac deleted file mode 100644 index b5914a42..00000000 --- a/maxima/g0/gk_collisionless/em/gkUtil.mac +++ /dev/null @@ -1,954 +0,0 @@ -/* - Utility functions for GK Maxima scripts. -*/ -load("vect")$ -load("nodal_operations/nodal_functions")$ -load("nodal_operations/quadrature_functions")$ -load("utilities_gyrokinetic")$ - -expandInputFields(bC,bP,dxv,bmagBasis) := block( - [varsP,pdim,cdim,vdim,bmag_e,bmagInv_e,phi_e,Apar_e,dApardt_e,dApardtPrev_e, - AparL_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,BdriftX_e,BdriftY_e,jnk, - vmapBasis,vmapSqBasis,vmap_c,vmapSq_c,vmapBnum,vmapSqBnum,d], - - varsP : listofvars(bP), - pdim : length(varsP), - cdim : length(listofvars(bC)), - vdim : pdim-cdim, - - /* Expand background magnetic field and potentials. */ - bmag_e : doExpand1(bmag,bmagBasis), - phi_e : doExpand1(phi,bC), - Apar_e : doExpand1(apar,bC), - dApardt_e : doExpand1(apardot,bC), - dApardtPrev_e : doExpand1(apardot_prev,bC), - /* NOTE: even though Apar and dApar/dt are allowed to be discontinuous - in the parallel (z) direction, the surface term in the z direction - does not involve Apar. Since Apar is continuous in the other directions, - it does not matter if we use the right or left value. */ - - cmag_e : doExpand1(cmag,bmagBasis), - - b_x_e : doExpand1(b_x, bmagBasis), - b_y_e : doExpand1(b_y, bmagBasis), - b_z_e : doExpand1(b_z, bmagBasis), - jacobTotInv_e : doExpand1(jacobtot_inv, bmagBasis), - - /* Basis for the velocity space mapping. */ - [jnk,vmapBasis] : loadBasis("Ser", 1, 1), [jnk,vmapSqBasis] : loadBasis("Ser", 1, 2), - vmapBnum : length(vmapBasis), vmapSqBnum : length(vmapSqBasis), - - vmap_e : [], vmapSq_e : [], vmap_prime_e : [], - for d : 1 thru vdim do ( - vmap_c : makelist(vmap[(d-1)*vmapBnum+i-1],i,1,vmapBnum), - vmap_e : endcons(doExpand(vmap_c,subst(x=varsP[cdim+d],vmapBasis)), vmap_e), - - vmapSq_c : makelist(vmapSq[(d-1)*vmapSqBnum+i-1],i,1,vmapSqBnum), - vmapSq_e : endcons(doExpand(vmapSq_c,subst(x=varsP[cdim+d],vmapSqBasis)), vmapSq_e), - - vmap_prime_e : endcons(vmap_prime[d-1], vmap_prime_e) - ), - - expOut : [bmag_e,cmag_e,phi_e,Apar_e,dApardt_e,dApardtPrev_e, - b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,vmapSq_e, - vmap_prime_e], - - return(expOut) -)$ - -calcAndWrite_HamilES(fH,charge,mass,wv,rdv2,bP,inFlds,sideStr) := block( - [varsP,numP,pDim,vdim,bmag_e,phi_e,hamil_e,hamil_c,replaceList,hamilCvar,hamilNoZero_c], - /* Expand the Hamiltonian, and write them out. */ - - varsP : listofvars(bP), - numP : length(bP), - pDim : length(varsP), - vdim : 1, - if isInList(mu,varsP) then vdim : 2, - - /* Extract magnetic field and electrostatic potential. */ - bmag_e : inFlds[1], - phi_e : inFlds[3], - vmap_e : inFlds[11], - vmapSq_e : inFlds[12], - - hamil_e : charge*phi_e + (1/2)*mass*vmapSq_e[1], - if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), - - /* Project Hamiltonian onto basis functions */ - hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), - - /* Write Hamiltonian. */ - printf(fh, " double hamil~a[~a] = {0.}; ~%", sideStr, numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - hamilCvar : eval_string(sconcat("hamil",sideStr)), - writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), - printf(fH, "~%"), - flush_output(fH), - - hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), - /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bP, - - return(hamil_e) -)$ - -calc_HamilES_no_write(charge,mass,wv,rdv2,bP,inFlds) := block( - [varsP,numP,pDim,vdim,bmag_e,phi_e,hamil_e,hamil_c,hamilNoZero_c], - /* Expand the Hamiltonian, and write them out. */ - - varsP : listofvars(bP), - numP : length(bP), - pDim : length(varsP), - vdim : 0, - if isInList(vpar,varsP) then vdim : vdim+1, - if isInList(mu,varsP) then vdim : vdim+1, - - /* Extract magnetic field and electrostatic potential. */ - bmag_e : inFlds[1], - phi_e : inFlds[3], - vmap_e : inFlds[11], - vmapSq_e : inFlds[12], - - hamil_e : charge*phi_e + (1/2)*mass*vmapSq_e[1], - if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), - - /* Project Hamiltonian onto basis functions */ - hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), - - hamilNoZero_c : makelistNoZeros1(hamil_c, hamil), - /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bP, - - return(hamil_e) -)$ - -calcAndWrite_BstardBmag(fH,cdim,bP,bmagBasis,surfDir,mass,charge,wvpar,rdx2,rdv2,inFlds,sideStr) := block ( - [cmag_e,Apar_e,BmagInv_e,BdriftX_e,BdriftY_e,BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,b_x_e,b_y_e,b_z_e, - jacobTotInv_e,rdy2,rdz2,AparL_e,BstarZdBmagL_e,varsP,numP,replaceList,BstarXdBmag_c,BstarYdBmag_c,BstarZdBmag_c, - BstarXdBmag_noZero_c,BstarYdBmag_noZero_c,BstarZdBmag_noZero_c,BstarZdBmagL_c,BstarZdBmagL_noZero_c,BstardBmagL_e], - /* Compute the Bstar divided by B and write it out. */ - - cmag_e : inFlds[2], - Apar_e : inFlds[4], - b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], - jacobTotInv_e : inFlds[10], - - if cdim > 1 then (rdy2 : rdx2[2]) else (rdy2 : 0), - if cdim > 2 then (rdz2 : rdx2[3]) else (rdz2 : 0), - - /* Zero out some terms below to avoid the discontinuity of alpha in the - parallel direction (due to the discontinuity of Apar). Otherwise some - other treatment of some Apar terms or alpha may be needed. Initially we - had a step averaging alpha across the surface (just for the parallel - direction), but NRM suspects this might've caused instability in some - cases. Hence the zeros below. */ - discontFac : 0, - - /* Expand BstarX/Bmag on basis. */ - BstarXdBmag_e : (-((mass/charge)*(wvpar+vpar/rdv2[1]))*rdz2*diff(b_y_e,z) - + rdy2*diff(Apar_e*b_z_e,y) - discontFac*rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e, - /* Expand BstarY/Bmag on basis. */ - BstarYdBmag_e : (-((mass/charge)*(wvpar+vpar/rdv2[1]))*(rdx2[1]*diff(b_z_e,x) - rdz2*diff(b_x_e,z)) - + discontFac*rdz2*diff(Apar_e*b_x_e,z) - rdx2[1]*diff(Apar_e*b_z_e,x))*jacobTotInv_e, - /* Expand BstarZ/Bmag on basis. */ - BstarZdBmag_e : (cmag_e + ((mass/charge)*(wvpar+vpar/rdv2[1]))*rdx2[1]*diff(b_y_e,x) - + discontFac*(rdx2[1]*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y)))*jacobTotInv_e, - - varsP : listofvars(bP), - numP : length(bP), - - /* Project Bstar's onto basis, and print to arrays. */ - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - if cdim > 1 then ( - BstarXdBmag_c : calcInnerProdList(varsP, 1, bP, BstarXdBmag_e), - if (surfDir = 0 or surfDir = 1 or surfDir = cdim+1) then ( - printf(fh, " double BstarXdBmag~a[~a] = {0.}; ~%", sideStr,numP), - writeCExprsNoExpand1(eval_string(sconcat("BstarXdBmag",sideStr)), gcfac(subst(replaceList, BstarXdBmag_c))), - printf(fh, "~%"), - flush_output(fh) - ), - BstarXdBmag_noZero_c : makelistNoZeros1(BstarXdBmag_c, eval_string(sconcat("BstarXdBmag",sideStr))), - BstarXdBmag_e : BstarXdBmag_noZero_c . bP, - - BstarYdBmag_c : calcInnerProdList(varsP, 1, bP, BstarYdBmag_e), - if (surfDir = 0 or surfDir = 2 or surfDir = cdim+1) then ( - printf(fh, " double BstarYdBmag~a[~a] = {0.}; ~%", sideStr, numP), - writeCExprsNoExpand1(eval_string(sconcat("BstarYdBmag",sideStr)), gcfac(subst(replaceList, BstarYdBmag_c))), - printf(fh, "~%"), - flush_output(fh) - ), - BstarYdBmag_noZero_c : makelistNoZeros1(BstarYdBmag_c, eval_string(sconcat("BstarYdBmag",sideStr))), - BstarYdBmag_e : BstarYdBmag_noZero_c . bP - ), - if cdim # 2 then ( - BstarZdBmag_c : calcInnerProdList(varsP, 1, bP, BstarZdBmag_e), - if (surfDir=0 or surfDir>=cdim) then ( - printf(fh, " double BstarZdBmag~a[~a] = {0.}; ~%", sideStr, numP), - writeCExprsNoExpand1(eval_string(sconcat("BstarZdBmag",sideStr)), gcfac(subst(replaceList, BstarZdBmag_c))), - printf(fh, "~%"), - flush_output(fh) - ), - BstarZdBmag_noZero_c : makelistNoZeros1(BstarZdBmag_c, eval_string(sconcat("BstarZdBmag",sideStr))), - BstarZdBmag_e : BstarZdBmag_noZero_c . bP - ), - - /* Make Bstar/Bmag vector. */ - if cdim = 1 then ( - BstardBmag_e : [BstarZdBmag_e] - ) elseif cdim = 2 then ( - BstardBmag_e : [BstarXdBmag_e, BstarYdBmag_e] - ) elseif cdim = 3 then ( - BstardBmag_e : [BstarXdBmag_e, BstarYdBmag_e, BstarZdBmag_e] - ), - - return(BstardBmag_e) -)$ - -calcAndWrite_BstarZdBmag(fH,cdim,bP,bmagBasis,surfDir,mass,charge,wvpar,rdx2,rdv2,inFlds,sideStr) := block ( - [cmag_e,Apar_e,BmagInv_e,BdriftX_e,BdriftY_e,BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,b_x_e,b_y_e,b_z_e, - jacobTotInv_e,rdy2,rdz2,AparL_e,BstarZdBmagL_e,varsP,numP,replaceList,BstarXdBmag_c,BstarYdBmag_c,BstarZdBmag_c, - BstarXdBmag_noZero_c,BstarYdBmag_noZero_c,BstarZdBmag_noZero_c,BstarZdBmagL_c,BstarZdBmagL_noZero_c,BstardBmagL_e], - /* Compute the Bstar divided by B and write it out. */ - - cmag_e : inFlds[2], - b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], - jacobTotInv_e : inFlds[10], - - if cdim > 1 then (rdy2 : rdx2[2]) else (rdy2 : 0), - if cdim > 2 then (rdz2 : rdx2[3]) else (rdz2 : 0), - - if (sideStr="L") then (Apar_e : inFlds[11]) - elseif (sideStr="R") then (Apar_e : inFlds[12]) - else (Apar_e : inFlds[4]), - - /* Expand BstarZ/Bmag on basis. */ - BstarZdBmag_e : (cmag_e + ((mass/charge)*(wvpar+vpar/rdv2[1]))*rdx2[1]*diff(b_y_e,x) - + (rdx2[1]*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y)))*jacobTotInv_e, - - varsP : listofvars(bP), - numP : length(bP), - - /* Project Bstar's onto basis, and print to arrays. */ - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - BstarZdBmag_c : calcInnerProdList(varsP, 1, bP, BstarZdBmag_e), - printf(fh, " double BstarZdBmag~a[~a]; ~%", sideStr, numP), - writeCExprsNoExpand1(eval_string(sconcat("BstarZdBmag",sideStr)), gcfac(subst(replaceList, BstarZdBmag_c))), - printf(fh, "~%"), - flush_output(fh), - BstarZdBmag_noZero_c : makelistNoZeros1(BstarZdBmag_c, eval_string(sconcat("BstarZdBmag",sideStr))), - BstarZdBmag_e : BstarZdBmag_noZero_c . bP, - - return(BstarZdBmag_e) -)$ - -poissonBracket(f,g,mass,charge,rdx2V,rdv2V,pbFacs,no_by) := block( - [varsCall,cdim,varsC,rdy2,rdz2,BstardBmag_e,bmagInv_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e], - /* Compute the Poisson bracket in general geometry. */ - - /* Function that computes the gradient. */ - /* - For some reason the following use of "vect" functions was giving extra - brackets when generating volume kernels. Opt for our own function instead. - scalefactors(varsC), - fgrad(fIn) := ev(express(grad(fIn)),diff)*rdx2V, - */ - fgrad(fIn,vars,diffFacs) := makelist(diff(fIn,vars[d]),d,1,length(vars))*diffFacs, - - cdim : length(rdx2V), - if (cdim = 1) then ( - varsCall : [x], - rdy2 : 0, - rdz2 : 0 - ) else if (cdim = 2) then ( - varsCall : [x,z], - rdy2 : 0, - rdz2 : rdx2V[2] - ) else if (cdim = 3) then ( - varsCall : [x,y,z], - rdy2 : rdx2V[2], - rdz2 : rdx2V[3] - ), - - varsC : makelist(varsCall[d],d,1,cdim), - BstardBmag_e : pbFacs[1], - b_x_e : pbFacs[2], b_y_e : pbFacs[3], b_z_e : pbFacs[4], - jacobTotInv_e : pbFacs[5], vmap_prime_e : pbFacs[6], - - if (no_by) then ( b_y_e : 0 ), - - pb_e : (1/mass)*BstardBmag_e . - ((rdv2V[1]/vmap_prime_e[1])*(fgrad(f,varsC,rdx2V)*diff(g,vpar)-fgrad(g,varsC,rdx2V)*diff(f,vpar))) - +(-(1/charge)*b_z_e*rdx2V[1]*rdy2*(diff(f,x)*diff(g,y)-diff(f,y)*diff(g,x)) - +(1/charge)*b_y_e*rdx2V[1]*rdz2*(diff(f,x)*diff(g,z)-diff(f,z)*diff(g,x)) - -(1/charge)*b_x_e*rdy2*rdz2*(diff(f,y)*diff(g,z)-diff(f,z)*diff(g,y)))*jacobTotInv_e, - - return(pb_e) -)$ - -calcAndWrite_alphaEM(fH,surfDir,bP,polyOrder,basisType,mass,charge,rdx2V,rdv2V, - inFlds,hamil_e,BstardBmag_e,sideStr,isStep2) := block( - [varsP,varLabel,dirLabel,wSurf,rdSurfVar2,surfVar,surfIntVars,pbAuxFlds,bmagInv_e,b_x_e, - b_y_e,b_z_e,jacobTotInv_e,alpha_e,Apar_e,dApardt_e,dApardtPrev_e,alphaL_e, - bSurf,numSurf,evPoint,alpha_c,alphaCvar,alphaNoZero_c,alphaUpCvar,alphaUpNoZero_c], - /* Calculate phase space velocity alpha in direction of surfVar. */ - /* We assume alpha.n is continuous across boundary, although H may not be. */ - /* Distinguish between alpha and alphaUp, where alphaUp is the one used to - determine upwind direction. */ - - varsP : listofvars(bP), - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - wSurf : eval_string(sconcat("w",dirLabel)), - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - surfVar : varsP[surfDir], /* Surface variable. */ - surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ - - b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], - jacobTotInv_e : inFlds[10], - - pbAuxFlds : [BstardBmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,vmapSq_e], - alpha_e : poissonBracket(wSurf+surfVar/rdSurfVar2,hamil_e,mass,charge,rdx2V,rdv2V,pbAuxFlds), - - Apar_e : inFlds[4], dApardt_e : inFlds[5], - - alphaUp_e : alpha_e, - if surfVar = vpar then ( - alpha_e : alpha_e - (charge/mass)*dApardt_e, - alphaUp_e : alpha_e - ), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder) - ) else ( - bSurf : basisFromVars(basisType,surfIntVars,polyOrder) - ), - numSurf : length(bSurf), - - if sideStr="L" then (evPoint : -1) - elseif sideStr="R" then (evPoint : 1), - - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - /* Project full alpha expression evaluated at interior surface - onto surface basis and print to C variable alpha. */ - alpha_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,alpha_e)), - printf(fh, " double alpha~a[~a] = {0.}; ~%", sideStr, numSurf), - alphaCvar : eval_string(sconcat("alpha",sideStr)), - writeCExprsNoExpand1(alphaCvar, subst(replaceList,alpha_c)), - printf(fh, "~%"), - flush_output(fh), - alphaNoZero_c : makelistNoZeros1(alpha_c, alphaCvar), - alphaSurf_e : doExpand(alphaNoZero_c, bSurf), - - alphaUpSurf_e : alphaSurf_e, - - return([alphaUp_e,alphaSurf_e,alphaUpSurf_e]) -)$ - -calcAndWrite_alpha(fH,surfDir,bP,polyOrder,basisType,mass,charge,rdx2V,rdv2V, - inFlds,hamil_e,BstardBmag_e,sideStr,no_by,isStep2) := block( - [varsP,varLabel,dirLabel,wSurf,rdSurfVar2,surfVar,surfIntVars,b_x_e,b_y_e,b_z_e, - jacobTotInv_e,vmap_e,vmap_prime_e,pbAuxFlds,cdim,surfVar_phys,alpha_e,bSurf, - numSurf,evPoint,alpha_c,alphaCvar,clst,alphaNoZero_c], - /* Calculate phase space velocity alpha in direction of surfVar. */ - /* We assume alpha.n is continuous across boundary, although H may not be. */ - /* Distinguish between alpha and alphaUp, where alphaUp is the one used to - determine upwind direction. */ - - varsP : listofvars(bP), - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - wSurf : eval_string(sconcat("w",dirLabel)), - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - surfVar : varsP[surfDir], /* Surface variable. */ - surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ - - b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], - jacobTotInv_e : inFlds[10], vmap_e : inFlds[11], vmap_prime_e : inFlds[13], - - pbAuxFlds : [BstardBmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_prime_e], - - cdim : length(rdx2V), - surfVar_phys : wSurf+surfVar/rdSurfVar2, - if (surfDir > cdim) then ( surfVar_phys : vmap_e[surfDir-cdim] ), - - alpha_e : poissonBracket(surfVar_phys,hamil_e,mass,charge,rdx2V,rdv2V,pbAuxFlds,no_by), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder) - ) else ( - bSurf : basisFromVars(basisType,surfIntVars,polyOrder) - ), - numSurf : length(bSurf), - - if sideStr="L" then (evPoint : -1) - elseif sideStr="R" then (evPoint : 1), - - dvparSimp : makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pDim), - - /* Project full alpha expression evaluated at interior surface - onto surface basis and print to C variable alpha. */ - alpha_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,alpha_e)), - alpha_c : subst(dvparSimp, alpha_c), - clst : [rdx2vec, rdv2vec, m_, q_, wvpar, rdvpar2Sq, - makelist(dxv[i-1],i,1,pDim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], - alphaCvar : eval_string(sconcat("alpha",sideStr)), - writeCExprsCollect1(alphaCvar, alpha_c, clst), - printf(fh, "~%"), - flush_output(fh), - alphaNoZero_c : makelistNoZeros1(alpha_c, alphaCvar), - alphaSurf_e : doExpand(alphaNoZero_c, bSurf), - - return(alphaSurf_e) -)$ - -calc_alpha_no_write(fH,surfDir,bP,polyOrder,basisType,mass,charge,rdx2V,rdv2V, - inFlds,hamil_e,BstardBmag_e,sideStr,no_by,isStep2) := block( - [varsP,varLabel,dirLabel,wSurf,rdSurfVar2,surfVar,surfIntVars,b_x_e,b_y_e,b_z_e, - jacobTotInv_e,vmap_e,vmap_prime_e,pbAuxFlds,cdim,surfVar_phys,alpha_e,bSurf, - numSurf,evPoint,alpha_c,alphaCvar,clst,alphaNoZero_c], - /* Calculate phase space velocity alpha in direction of surfVar. */ - /* We assume alpha.n is continuous across boundary, although H may not be. */ - /* Distinguish between alpha and alphaUp, where alphaUp is the one used to - determine upwind direction. */ - - varsP : listofvars(bP), - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - wSurf : eval_string(sconcat("w",dirLabel)), - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - surfVar : varsP[surfDir], /* Surface variable. */ - surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ - - b_x_e : inFlds[7], b_y_e : inFlds[8], b_z_e : inFlds[9], - jacobTotInv_e : inFlds[10], vmap_e : inFlds[11], vmap_prime_e : inFlds[13], - - pbAuxFlds : [BstardBmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_prime_e], - - cdim : length(rdx2V), - surfVar_phys : wSurf+surfVar/rdSurfVar2, - if (surfDir > cdim) then ( surfVar_phys : vmap_e[surfDir-cdim] ), - - alpha_e : poissonBracket(surfVar_phys,hamil_e,mass,charge,rdx2V,rdv2V,pbAuxFlds,no_by), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder) - ) else ( - bSurf : basisFromVars(basisType,surfIntVars,polyOrder) - ), - numSurf : length(bSurf), - - if sideStr="L" then (evPoint : -1) - elseif sideStr="R" then (evPoint : 1), - - /* Project full alpha expression evaluated at interior surface - onto surface basis and print to C variable alpha. */ - alpha_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,alpha_e)), - alphaCvar : eval_string(sconcat("alpha",sideStr)), - alphaNoZero_c : makelistNoZeros1(alpha_c, alphaCvar), - alphaSurf_e : doExpand(alphaNoZero_c, bSurf), - - return(alphaSurf_e) -)$ - -calc_surfAvgAlpha(bP,surfVar,alpha_e,evAtLower) := block( - [i,v,varsP,numP,surfIntVars,surfBasis,ignoreVars,alphaSurfAvg_c,alphaSurfAvg_e,evPoint], - /* Calculate the surface-averaged alpha. */ - - varsP : listofvars(bP), - numP : length(bP), - surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ - - if evAtLower then (evPoint:-1) else (evPoint:1), - - /* alpha coefficients are for an expansion in the full-dim phase basis. We - need to project onto the a basis on the surface with the right normalization - and dimensionality. */ - surfBasis : copylist(bP), - ignoreVars : listify(setdifference(setify(varsP),setify(surfIntVars))), - for i : 1 thru numP do ( - for v : 1 thru length(ignoreVars) do ( - if not freeof(ignoreVars[v],bP[i]) then ( surfBasis[i] : 0 ) - )), - alphaSurfAvg_c : calcInnerProdList(surfIntVars,1,surfBasis,subst(surfVar=evPoint,alpha_e)), - alphaSurfAvg_e : doExpand(alphaSurfAvg_c,surfBasis), - alphaSurfAvg_s : fullratsimp(innerProd(surfIntVars,1,alphaSurfAvg_e,1)/innerProd(surfIntVars,1,1,1)), - - return(alphaSurfAvg_s) -)$ - -calcAndWrite_surfAvgAlpha(fH,bP,surfDir,alpha_e,sideStr) := block([replaceList,evAtLower], - /* Given the phase-space velocity alpha, compute the average over the surface - perpendicular to the surfVar dimension, and at the lower/upper boundary if - sideStr=R/L. Write it out too.*/ - - surfVar : varsP[surfDir], /* Surface variable. */ - - if sideStr="R" then (evAtLower:true) else (evAtLower:false), - - alphaSurfAvg_s : calc_surfAvgAlpha(bP,surfVar,alpha_e,evAtLower), - - printf(fH, " // Surface-averaged phase velocity in this direction.~%"), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, - wvparL^2=wvparSqL, rdvpar2L^2=rdvpar2SqL, rdx2L^2=rdx2SqL, - wvparR^2=wvparSqR, rdvpar2R^2=rdvpar2SqR, rdx2R^2=rdx2SqR, m_^2=mSq, q_^2=qSq], - printf(fH, " double alphaSurfAvg~a = ~a; ~%~%", sideStr, float(subst(replaceList, alphaSurfAvg_s))), - flush_output(fH), - - return(alphaSurfAvg_s) -)$ - -calcAndWrite_upwindIncr_wSurfAvgAlpha(fH,bP,polyOrder,surfDir,sideStr,alphaSurf_e,isStep2) := block( - [varsP,numP,surfIntVars,fL_e,fR_e,fhatSurf_e,replaceList,fhatAlpha_c,incr_r,tMod,incrMod_r], - /* Given a surface expansion of the phase-space velocity, alpha, determine the upwinding - based on the surface average of alpha. Write the common increment to left/right cells - (the actual output from the C kernel should be this increment times some scaling factor). */ - - varsP : listofvars(bP), - numP : length(bP), - surfVar : varsP[surfDir], /* Surface variable. */ - surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ - - /* Expand distribution function. */ - fL_e : doExpand1(fL,bP), fR_e : doExpand1(fR,bP), - - printf(fH, " if (alphaSurfAvg~a>0) { ~%", sideStr), - - fhatSurf_e : subst(surfVar=1, fL_e), - - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, - wvparL^2=wvparSqL, rdvpar2L^2=rdvpar2SqL, rdx2L^2=rdx2SqL, - wvparR^2=wvparSqR, rdvpar2R^2=rdvpar2SqR, rdx2R^2=rdx2SqR, m_^2=mSq, q_^2=qSq], - /* Write out the increment to the right cell. Omit a dxv factor we incorporate later. */ - fhatAlpha_c : calcInnerProdList(surfIntVars, alphaSurf_e, subst(surfVar=-1, bP), fhatSurf_e), - incrR_c : fullratsimp(fhatAlpha_c), - writeCExprsNoExpand1(incr, subst(replaceList, incrR_c)), - flush_output(fH), - - if surfVar=vpar and polyOrder=1 and (not isStep2) then ( - tMod : calcInnerProdList(surfIntVars, 1, subst(surfVar=-1, bP), fhatSurf_e), - incrModR_c : fullratsimp(tMod), - writeCExprsNoExpand1(incrEmMod, subst(replaceList, incrModR_c)) - ), - - printf(fH, " } else { ~%"), - - fhatSurf_e : subst(surfVar=-1, fR_e), - - if surfVar=vpar and polyOrder=1 and (not isStep2) then ( - tMod : calcInnerProdList(surfIntVars, 1, subst(surfVar=-1, bP), fhatSurf_e), - incrModR_c : fullratsimp(tMod), - writeCExprsNoExpand1(incrEmMod, subst(replaceList, incrModR_c)) - ), - - fhatAlpha_c : calcInnerProdList(surfIntVars, alphaSurf_e, subst(surfVar=-1, bP), fhatSurf_e), - incrR_c : fullratsimp(fhatAlpha_c), - - fhatAlpha_c : calcInnerProdList(surfIntVars, alphaSurf_e, subst(surfVar=1, bP), fhatSurf_e), - incrL_c : -fullratsimp(fhatAlpha_c), - - writeCExprsNoExpand1(incr, subst(replaceList, incrR_c)), - printf(fH, " }~%"), - flush_output(fH), - - return([incrL_c,incrR_c]) -)$ - -calcAndWrite_upwindIncr_wQuadNodeAlpha(fH,basisType,polyOrder,bP,surfDir,sideStr, - alphaSurf_e,alphaUpSurf_e,fLR,isStep2) := block( - [varsP,numP,pDim,surfIntVars,vdim,cdim,surf_cvars,surf_vvars,surfNodes, - numNodes,fL_e,fR_e,fOrdL_n,fOrdR_n,alphaOrd_n, - fHatSurf_e,replaceList,Ghat_c,evPoint], - /* Compute the common increment to left/right cells with upwinding based on - the quadrature-node values of the phase-space velocity alpha. Write them - out. The actual output should be these increments scaled by some - cell-length factor. */ - - varsP : listofvars(bP), - numP : length(bP), - surfVar : varsP[surfDir], /* Surface variable. */ - surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ - pDim : length(varsP), - - vdim : 0, - if isInList(vpar,varsP) then vdim : vdim+1, - if isInList(mu,varsP) then vdim : vdim+1, - cdim : pDim-vdim, - - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), - basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) - ), - numNodes : length(surfNodes), - - /* Expand distribution function. */ - fL_e : doExpand1(fLR[1],bP), - fR_e : doExpand1(fLR[2],bP), - - /* Evaluate alpha at ordinates. - Note: alphaSurf_e is already a surface expansion. */ - alphaOrd_n : gcfac(float(evAtNodes(alphaUpSurf_e,surfNodes,surfIntVars))), - /* Determine upwinding at each surface quadrature node. */ - printf(fH, " double fUpOrd~a[~a] = {0.};~%", sideStr, numNodes), - for i : 1 thru numNodes do ( - printf(fH, " if (~a > 0.) {~%", float(expand(fullratsimp(alphaOrd_n[i]/abs(content(args(alphaOrd_n[i])[1])[1]))))), - printf(fh, " fUpOrd~a[~a] = ~a_surfx~a_eval_quad_node_~a_r(~a); ~%", sideStr, i-1, basisStr, surfDir, i-1, fLR[1]), - printf(fh, " } else { ~%"), - printf(fh, " fUpOrd~a[~a] = ~a_surfx~a_eval_quad_node_~a_l(~a); ~%", sideStr, i-1, basisStr, surfDir, i-1, fLR[2]), - printf(fh, " } ~%") - ), - printf(fH, "~%"), - flush_output(fH), - - /* Write coefficients of modal surface expansion fupwind. */ - printf(fh, " // Project tensor nodal quadrature basis back onto modal basis. ~%"), - printf(fH, " double fUp~a[~a] = {0.};~%", sideStr, length(bSurf)), - if polyOrder=1 then ( /* Force p=1 to use hybrid basis. */ - dirStr : "x", - if surfDir = cdim+1 then (dirStr : "vpar") elseif surfDir = cdim+2 then (dirStr : "mu"), - printf(fh, " ~a_~adir_upwind_quad_to_modal(fUpOrd~a, fUp~a); ~%", basisStr, dirStr, sideStr, sideStr) - ) else ( - printf(fh, " ~a_upwind_quad_to_modal(fUpOrd~a, fUp~a); ~%", basisStr, sideStr, sideStr) - ), - printf(fh, "~%"), - flush_output(fH), - fHatSurf_e : doExpand1(eval_string(sconcat("fUp",sideStr)), bSurf), - - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - - if (sideStr="L") then (evPoint : -1) - elseif (sideStr="R") then (evPoint : 1), - - Ghat_c : calcInnerProdList(surfIntVars, alphaSurf_e, bSurf, fHatSurf_e), - Ghat_e : doExpand(Ghat_c, bSurf), - printf(fH, " double Ghat~a[~a] = {0.}; ~%", sideStr, length(bSurf)), - writeCExprs1(eval_string(sconcat("Ghat",sideStr)), Ghat_c), - printf(fH, "~%"), - flush_output(fH), - /* Zero out components of Ghat which are empty. */ - GhatNoZero : makelistNoZeros1(Ghat_c, eval_string(sconcat("Ghat",sideStr))), - Ghat_e : doExpand(GhatNoZero, bSurf), - - incr_c : fullratsimp(calcInnerProdList(surfIntVars, -evPoint, subst(surfVar=evPoint, bP), Ghat_e)), - - return(incr_c) -)$ - -calcAndWrite_upwindIncr_cflFreq_wQuadNodeAlpha(fH,basisType,polyOrder,bP,surfDir,sideStr, - alphaSurf_e,alphaUpSurf_e,fLR,isStep2) := block( - [varsP,numP,surfVar,surfIntVars,pDim,vdim,cdim,surf_cvars,surf_vvars,surfNodes, - bSurf,basisStr,numNodes,fL_e,fR_e,alphaOrd_n,i, - dirStr,fHatSurf_e,evPoint,Ghat_c,Ghat_e,GhatNoZero,incr_c], - - varsP : listofvars(bP), - numP : length(bP), - surfVar : varsP[surfDir], /* Surface variable. */ - surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ - pDim : length(varsP), - - vdim : 0, - if isInList(vpar,varsP) then vdim : vdim+1, - if isInList(mu,varsP) then vdim : vdim+1, - cdim : pDim-vdim, - - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisStr : sconcat("gkhyb_", cdim, "x", vdim, "v", "_p", polyOrder) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder), - basisStr : sconcat(basisFun, "_", cdim+vdim, "x", "_p", polyOrder) - ), - numNodes : length(surfNodes), - - /* Expand distribution function. */ - fL_e : doExpand1(fLR[1],bP), - fR_e : doExpand1(fLR[2],bP), - - /* Evaluate alpha at ordinates. - Note: alphaSurf_e is already a surface expansion. */ - alphaOrd_n : gcfac(float(evAtNodes(alphaUpSurf_e,surfNodes,surfIntVars))), - - /* Determine upwinding and cflFreq at each surface quadrature node. */ - printf(fH, " double fUpOrd~a[~a] = {0.};~%", sideStr, numNodes), - printf(fH, " double alpha~a_n = 0.;~%", sideStr), - printf(fH, "~%"), - for i : 1 thru numNodes do ( - printf(fH, " alpha~a_n = ~a;~%", sideStr, float(expand(fullratsimp(alphaOrd_n[i])))), - printf(fH, " if (alpha~a_n > 0.) {~%", sideStr), - printf(fh, " fUpOrd~a[~a] = ~a_surfx~a_eval_quad_node_~a_r(~a); ~%", sideStr, i-1, basisStr, surfDir, i-1, fLR[1]), - printf(fh, " } else { ~%"), - printf(fh, " fUpOrd~a[~a] = ~a_surfx~a_eval_quad_node_~a_l(~a); ~%", sideStr, i-1, basisStr, surfDir, i-1, fLR[2]), - printf(fh, " } ~%"), - /* The extra factor of bP[1] below remains unexplained. NRM might've - stumbled up one it by trial and error. It may also have been meant - to average all the quad node values, but that meaning is only correct - for pure p=1. */ - printf(fh, " cflFreq = fmax(cflFreq, fabs(alpha~a_n)); ~%", sideStr, sideStr) - ), - printf(fH, "~%"), - flush_output(fH), - - /* Write coefficients of modal surface expansion fupwind. */ - printf(fh, " // Project tensor nodal quadrature basis back onto modal basis. ~%"), - printf(fH, " double fUp~a[~a] = {0.};~%", sideStr, length(bSurf)), - if polyOrder=1 then ( /* Force p=1 to use hybrid basis. */ - dirStr : "x", - if surfDir = cdim+1 then (dirStr : "vpar") elseif surfDir = cdim+2 then (dirStr : "mu"), - printf(fh, " ~a_~adir_upwind_quad_to_modal(fUpOrd~a, fUp~a); ~%", basisStr, dirStr, sideStr, sideStr) - ) else ( - printf(fh, " ~a_upwind_quad_to_modal(fUpOrd~a, fUp~a); ~%", basisStr, sideStr, sideStr) - ), - printf(fh, "~%"), - flush_output(fH), - fHatSurf_e : doExpand1(eval_string(sconcat("fUp",sideStr)), bSurf), - - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - - if (sideStr="L") then (evPoint : -1) - elseif (sideStr="R") then (evPoint : 1), - - Ghat_c : calcInnerProdList(surfIntVars, alphaSurf_e, bSurf, fHatSurf_e), - Ghat_e : doExpand(Ghat_c, bSurf), - printf(fH, " double Ghat~a[~a] = {0.}; ~%", sideStr, length(bSurf)), - writeCExprs1(eval_string(sconcat("Ghat",sideStr)), Ghat_c), - printf(fH, "~%"), - flush_output(fH), - /* Zero out components of Ghat which are empty. */ - GhatNoZero : makelistNoZeros1(Ghat_c, eval_string(sconcat("Ghat",sideStr))), - Ghat_e : doExpand(GhatNoZero, bSurf), - - incr_c : fullratsimp(calcInnerProdList(surfIntVars, -evPoint, subst(surfVar=evPoint, bP), Ghat_e)), - - return(incr_c) -)$ - -calcAndWrite_quadCFLfreq_wPhaseAlpha(basisType,polyOrder,bP,surfDir,alpha_e) := block( - [i,varsP,numP,cdim,vdim,pDim,surfVar,surfIntVars,pOrderCFL,surf_cvars,surf_vvars,surfNodes, - numNodes,alphaSurfL_c,alphaSurfL_e,alphaSurfL_n,alphaSurfR_c,alphaSurfR_e,alphaSurfR_n], - /* Compute the CFL frequency from quadrature node contributions on the - surfaces in the dir dimension, given a phase-space volume expansion - of the speed (i.e. coming from doExpand(alpha,bP)). */ - - varsP : listofvars(bP), - numP : length(bP), - pDim : length(varsP), - surfVar : varsP[surfDir], /* Surface variable. */ - surfIntVars : delete(surfVar,varsP), /* Surface integral variables. */ - vdim : 0, - if isInList(vpar,varsP) then vdim : vdim+1, - if isInList(mu,varsP) then vdim : vdim+1, - cdim : pDim-vdim, - - /* Identify polyOrder in velocity space as p=2 for p=1 since we force p=1 to - mean gkhybrid basis. */ - pOrderCFL : polyOrder, - if polyOrder=1 and surfDir=cdim+1 then ( pOrderCFL : 2 ), - - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - /* Evaluate cfl by evaluating at all surface quadrature points. */ - /* Get quadrature nodes on surface. */ - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1) - ), - numNodes : length(surfNodes), - - /* Coefficients of alpha written out to the file above are phase-space volume - expansion coefficients. Need to evaluate at the surface and project onto - surface basis, before (expanding and) evaluating at surface nodes. */ - /* The extra factor of bP[1] below remains unexplained. NRM might've - stumbled up one it by trial and error. */ - alphaSurfL_n : gcfac(float(evAtNodes(subst(surfVar=-1,alpha_e)*bP[1],surfNodes,surfIntVars)*bP[1])), - printf(fh, " // Evaluate alpha at left surface quadrature points.~%"), - for i : 1 thru numNodes do ( - printf(fh, " alphaL = ~a; ~%", gcfac(float(alphaSurfL_n[i]))), - printf(fh, " cflFreq += -~a*(alphaL-fabs(alphaL)); ~%",float(0.5*(2*pOrderCFL+1))) - ), - - alphaSurfR_n : gcfac(float(evAtNodes(subst(surfVar=+1,alpha_e)*bP[1],surfNodes,surfIntVars)*bP[1])), - printf(fh, " // Evaluate alpha at right surface quadrature points.~%"), - for i : 1 thru numNodes do ( - printf(fh, " alphaR = ~a; ~%", gcfac(float(alphaSurfR_n[i]))), - printf(fh, " cflFreq += ~a*(alphaR+fabs(alphaR)); ~%",float(0.5*(2*pOrderCFL+1))) - ) -)$ - -/* - Utility functions for computing surface DG updates - for the generic case applicable to all our kinetic equations: - For a *continuous* phase space flux alpha, if sign(alpha) is a constant - we can use simple upwind fluxes. - F = alpha_surf*f^- (if sign(alpha_surf) = 1), - F = alpha_surf*f^+ (if sign(alpha_surf) = -1) - Otherwise, we project sign(alpha_surf) first evaluating sign(alpha_surf) - at quadrature points and then using a nodal-to-modal transformation do - F = alpha_surf ( 1/2*(f^+ + f^-) - 1/2*sgn_alpha_surf*(f^+ - f^-) - - In this notation alpha_surf is the expansion of the *continuous* phase space flux - on the given surface, f^+ is the distribution function evaluated just outside the surface - and f^- is the distribution function evaluated just inside the surface - +------+------+ - | | | - | f^-|f^+ | - | | | - +------+------+ - alpha_surf -*/ - -/* Determine the upwinded distribution function in gyrokinetics */ -calcAndWrite_GKfUpwind(file_handle,cdim,surfDir,surfVar,surfIntVars,bSurf,fl_e,fr_e,basisStr,sideStr,no_by) := block( - [fstrL, fstrR, fLNm, fRNm, fUpNm, sgn_alpha_surfNm, sgn_alphaUpNm, NSurf,fSurfl_c, fSurfr_c, fSurfl_e, fSurfr_e, - surfNodes,nodeVars,basisNodal,sgn_alphaNodal_e,bSurf_no_by,sgn_alphaHatModProj_e,sgn_alphaUp_e,fUp_c], - - /* Naming convention for subsequent distribution function evaluations - for a cell-based update. If performing the left surface update - we need fl(surfVar=+1) and fc(surfVar=-1) (f_lr and f_cl) and if we are performing - the right surface update we need fc(surfVar=+1) and fr(surfVar=-1) (f_cr and f_rl) */ - if (sideStr = "L") then ( - fstrL : "lr", - fstrR : "cl" - ) else ( - fstrL : "cr", - fstrR : "rl" - ), - fLNm : eval_string(sconcat("f_",fstrL)), - fRNm : eval_string(sconcat("f_",fstrR)), - fUpNm : eval_string(sconcat("fUp",sideStr)), - sgn_alpha_surfNm : eval_string(sconcat("sgn_alpha_surf",sideStr)), - sgn_alphaUpNm : eval_string(sconcat("sgn_alphaUp",sideStr)), - - NSurf : length(bSurf), - printf(file_handle, " double fUp~a[~a] = {0.};~%", sideStr, NSurf), - fSurfl_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=1, fl_e)), - fSurfr_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=-1, fr_e)), - fSurfl_e : doExpand1(fLNm, bSurf), - fSurfr_e : doExpand1(fRNm, bSurf), - - clst : [vmap_prime_l[0],vmap_prime_l[1],vmap_prime_c[0],vmap_prime_c[1], - vmap_prime_r[0],vmap_prime_r[1],vmap_prime_edge[0],vmap_prime_edge[1], - vmap_prime_skin[0],vmap_prime_skin[1]], - /* If sign(alpha_surf) is single signed - 1. f^- (if sign(alpha_surf) = 1), - 2. f^+ (if sign(alpha_surf) = -1) */ - printf(file_handle, " if (const_sgn_alpha~a[0] == 1) { ~%", sideStr), - printf(file_handle, " if (sgn_alpha_surf~a[0] == 1.0) { ~%", sideStr), - writeCExprsCollect1(fUpNm, fSurfl_c, clst), - printf(file_handle, " } else { ~%"), - writeCExprsCollect1(fUpNm, fSurfr_c, clst), - printf(file_handle, " } ~%"), - - /* Else sign(alpha_surf) is changing quadrature point to quadrature point - 1/2*(f^+ + f^-) - 1/2*sgn_alpha_surf*(f^+ - f^-) */ - printf(file_handle, " } else { ~%"), - printf(file_handle, " double f_~a[~a] = {0.};~%", fstrL, NSurf), - printf(file_handle, " double f_~a[~a] = {0.};~%", fstrR, NSurf), - if (polyOrder = 1) then ( /* Force p=1 to use hybrid basis. */ - /* if no toroidal field and p=1, use a further reduced quadrature evaluation - to exploit the larger sparsity in the x and z updates. - The x update is surfDir = 1 and the z update is surfDir = cdim */ - if (no_by and surfDir = 1) then ( - surfNodes : gaussOrd(1+1, 1), - nodeVars : [z], - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", 1, 1, nodeVars, surfNodes), - sgn_alphaNodal_e : doExpand1(sgn_alpha_surfNm,basisNodal), - bSurf_no_by : basisFromVars("gkhyb",nodeVars,polyOrder), - sgn_alphaHatModProj_e : fullratsimp(calcInnerProdList(nodeVars, 1, bSurf_no_by, sgn_alphaNodal_e)), - printf(file_handle, " double sgn_alphaUp~a[~a] = {0.};~%", sideStr, length(bSurf_no_by)), - writeCExprs1(sgn_alphaUpNm, sgn_alphaHatModProj_e), - sgn_alphaUp_e : doExpand1(sgn_alphaUpNm, bSurf_no_by) - ) - else if (no_by and surfDir = cdim) then ( - surfNodes : gaussOrdGkHyb(1+1, [x], [vpar]), - nodeVars : [x,vpar], - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", 1, 1, nodeVars, surfNodes), - sgn_alphaNodal_e : doExpand1(sgn_alpha_surfNm,basisNodal), - bSurf_no_by : basisFromVars("gkhyb",nodeVars,polyOrder), - sgn_alphaHatModProj_e : fullratsimp(calcInnerProdList(nodeVars, 1, bSurf_no_by, sgn_alphaNodal_e)), - printf(file_handle, " double sgn_alphaUp~a[~a] = {0.};~%", sideStr, length(bSurf_no_by)), - writeCExprs1(sgn_alphaUpNm, sgn_alphaHatModProj_e), - sgn_alphaUp_e : doExpand1(sgn_alphaUpNm, bSurf_no_by) - ) - else ( - dirStr : "x", - if (surfDir = cdim+1) then (dirStr : "vpar") elseif (surfDir = cdim+2) then (dirStr : "mu"), - printf(file_handle, " double sgn_alphaUp~a[~a] = {0.};~%", sideStr, NSurf), - printf(file_handle, " ~a_~adir_upwind_quad_to_modal(~a, ~a); ~%", basisStr, dirStr, sgn_alpha_surfNm, sgn_alphaUpNm), - sgn_alphaUp_e : doExpand1(sgn_alphaUpNm, bSurf) - ) - ) else ( - printf(file_handle, " double sgn_alphaUp~a[~a] = {0.};~%", sideStr, NSurf), - printf(file_handle, " ~a_upwind_quad_to_modal(~a, ~a); ~%", basisStr, sgn_alpha_surfNm, sgn_alphaUpNm), - sgn_alphaUp_e : doExpand1(sgn_alphaUpNm, bSurf) - ), - printf(file_handle, "~%"), - - writeCExprsCollect1(fLNm, fSurfl_c, clst), - printf(file_handle, "~%"), - flush_output(file_handle), - - writeCExprsCollect1(fRNm, fSurfr_c, clst), - printf(file_handle, "~%"), - flush_output(file_handle), - - fUp_c : calcInnerProdList(surfIntVars, 1, bSurf, 0.5*(fSurfl_e + fSurfr_e) - 0.5*sgn_alphaUp_e*(fSurfr_e - fSurfl_e)), - writeCExprsNoExpand1(fUpNm, gcfac(float(expand(fUp_c)))), - printf(file_handle, "~%"), - flush_output(file_handle), - - printf(file_handle, " } ~%") -)$ - -/* Determine the upwinded distribution function in gyrokinetics */ -calcAndWrite_sgn_alpha(file_handle,surfIntVars,surfNodes,numNodes,alphaSurf_e,sideStr) := block( - [alphaOrd_n], - /* Determine sign(alpha_surf) for upwinding at each surface quadrature node. */ - - /* Evaluate alpha at ordinates. - Note: alphaSurf_e is already a surface expansion. */ - alphaOrd_n : gcfac(float(evAtNodes(alphaSurf_e,surfNodes,surfIntVars))), - - printf(file_handle, " int const_sgn_alpha_surf = 1; ~%"), - printf(file_handle, " ~%"), - /* Write out first quadrature point - We are going to compare the signs of the quadrature points to see if the sign is constant */ - printf(file_handle, " if (~a > 0.) ~%", gcfac(float(expand(fullratsimp(alphaOrd_n[1]))))), - printf(file_handle, " sgn_alpha_surf~a[0] = 1.0; ~%", sideStr), - printf(file_handle, " else ~%"), - printf(file_handle, " sgn_alpha_surf~a[0] = -1.0; ~%", sideStr), - printf(file_handle, " ~%"), - /* Write out the other quadrature point evaluations and compare the signs point by point */ - for i : 2 thru numNodes do ( - printf(file_handle, " if (~a > 0.) ~%", gcfac(float(expand(fullratsimp(alphaOrd_n[i]))))), - printf(file_handle, " sgn_alpha_surf~a[~a] = 1.0; ~%", sideStr, i-1), - printf(file_handle, " else ~%"), - printf(file_handle, " sgn_alpha_surf~a[~a] = -1.0; ~%", sideStr, i-1), - printf(file_handle, " ~%"), - printf(file_handle, " if (sgn_alpha_surf~a[~a] == sgn_alpha_surf~a[~a]) ~%", sideStr, i-1, sideStr, i-2), - printf(file_handle, " const_sgn_alpha_surf = const_sgn_alpha_surf ? 1 : 0; ~%"), - printf(file_handle, " else ~%"), - printf(file_handle, " const_sgn_alpha_surf = 0; ~%"), - printf(file_handle, " ~%") - ) -)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-conf_em.mac b/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-conf_em.mac deleted file mode 100644 index 50c5cfcc..00000000 --- a/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-conf_em.mac +++ /dev/null @@ -1,85 +0,0 @@ -load("modal-basis")$ -load("out-scripts")$ -load(stringproc)$ -load("scifac")$ -load("utilities_gyrokinetic")$ -load("nodal_operations/nodal_functions")$ -fpprec : 24$ - -buildGKFluxConfAddEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge, mb_bound) := block( - [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, - surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, - numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,bmagSurf_e,vmap_e,vmapSq_e, - vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, - jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL - ], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - surfIntVarsC : delete(surfVar,varsC), - bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - nodeVars : surfIntVars, - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - nodeVars : surfIntVars, - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) - ), - if cdim = 1 then ( - surfConfigNodes : [1] - ) - else ( - surfConfigNodes : gaussOrd(polyOrder+1, cdim-1) - ), - numSurfNodes : length(surfNodes), - numSurfConfigNodes : length(surfConfigNodes), - numVelNodes : numSurfNodes/numSurfConfigNodes, - numMuNodes : 1, - if vdim > 1 then ( numMuNodes : 2), - numVparNodes : numVelNodes/numMuNodes, - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, - const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // dgs: surface DG geometry.~%"), - printf(fh, " // gkdgs: gyrokinetic surface DG geometry.~%"), - printf(fh, " // bmag: bmag represented on the surface.~%"), - printf(fh, " // jacobgeo_rat_surfL: Ratio of surface conf-space Jacobians in left cell.~%"), - printf(fh, " // jacobgeo_rat_surfR: Ratio of surface conf-space Jacobians in right cell.~%"), - printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), - printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), - printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), - printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), - printf(fh, "~%"), - - - printf(fh, " return 0.; ~%"), - printf(fh, "} ~%") -)$ diff --git a/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac b/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac deleted file mode 100644 index f856ffb8..00000000 --- a/maxima/g0/gk_collisionless/em/gk_collisionless_flux-surf-vpar_em.mac +++ /dev/null @@ -1,90 +0,0 @@ -load("modal-basis")$ -load("out-scripts")$ -load(stringproc)$ -load("scifac")$ -load("utilities_gyrokinetic")$ -fpprec : 24$ - -buildGKFluxVparAddEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge) := block( - [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, - surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, - numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, - bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, - hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr - ], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - surfIntVarsC : delete(surfVar,varsC), - bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - nodeVars : surfIntVars, - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - nodeVars : surfIntVars, - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) - ), - configNodes : gaussOrd(polyOrder+1, cdim), - numSurfNodes : length(surfNodes), - numConfigNodes : length(configNodes), - numVelNodes : numSurfNodes/numConfigNodes, - - /* if polyOrder = 1, we need to be careful about - indexing input arrays since the surface hybrid basis has a different size in the - vparallel surfaces and/or we are more directly exploiting the sparsity of - alpha (e.g., in the x and z direction when no toroidal field, by=0) - and thus utilize fewer coefficients to reduce the number of operations */ - if (polyOrder = 1) then ( - tempVars : delete(x,varsP), - tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), - NSurfIndexing : length(tempBasis), - numNodesIndexing : length(tempBasis) - ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes - ), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_r, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // dgv: volume DG geometry.~%"), - printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), - printf(fh, " // bmag: magnetic field amplitude.~%"), - printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), - printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), - printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), - printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), - printf(fh, "~%"), - - printf(fh, " return 0.; ~%"), - printf(fh, "} ~%") -)$ diff --git a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-header_em.mac b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-header_em.mac deleted file mode 100644 index 3ecb7cfd..00000000 --- a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-header_em.mac +++ /dev/null @@ -1,105 +0,0 @@ -/* Compute the header file for gyrokinetic collisionless equation object kernels. */ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -maxPolyOrder_Ser : 2$ -minCdim_Ser : 1$ -minVdim_Ser : 1$ -maxCdim_Ser : 3$ -maxVdim_Ser : 2$ - -/* Tensor order basis. */ -maxPolyOrder_Tensor : 2$ -minCdim_Tensor : 1$ -minVdim_Tensor : 1$ -maxCdim_Tensor : 0$ -maxVdim_Tensor : 0$ - -/* Number of velocity dimensions allowed for each - configuration-space dimension. */ -gkVdims : [[1,2], [2], [2]]$ - -/* ...... END OF USER INPUTS........ */ - -varsC : [x, y, z]$ -varsV : [vpar, mu]$ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -minVdim : [minVdim_Ser, minVdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ -maxVdim : [maxVdim_Ser, maxVdim_Tensor]$ - -printPrototypes() := block([], - for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ - for polyOrder : 1 thru maxPolyOrderB do ( - - printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_vol_~ax~av_~a_p~a(const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const double *bmag, const double *phi, - const double *dualcurlbhatoverB, const double *rtg33inv, const double* bioverJB, - const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), - printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_no_by_vol_~ax~av_~a_p~a(const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const double *bmag, const double *phi, - const double *dualcurlbhatoverB, const double *rtg33inv, const double* bioverJB, - const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), - - for surfDir : 1 thru c+1 do ( - if surfDir<=c then ( - dirlabel : varsC[surfDir] - ) else ( - dirlabel : varsV[surfDir-c] - ), - - if surfDir<=c then ( - extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, " - ) else ( - extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, " - ), - - if surfDir<=c then ( - vprimeargs : "" - ) else ( - vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, " - ), - - printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_c, const double *vmap_prime_r, - const double *flux_surf_l, const double *flux_surf_r, - double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder), - printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_em_boundary_surf~a_~ax~av_~a_p~a(const double *w, const double *dxv, - const double *vmap_prime_edge, const double *vmap_prime_skin, - const double *flux_surf_edge, const double *flux_surf_skin, - const int edge, double* GKYL_RESTRICT out); ~%", dirlabel, c, v, bName[bInd], polyOrder) - ), - printf(fh, "~%") - ) - ) - ) - ) -)$ - -fh : openw("~/max-out/gkyl_dg_gyrokinetic_kernels.h")$ -printf(fh, "#pragma once~%")$ -printf(fh, "~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "~%")$ -printf(fh, "EXTERN_C_BEG~%")$ -printf(fh, "~%")$ -printPrototypes()$ -printf(fh, "~%")$ -printf(fh, "EXTERN_C_END~%")$ -close(fh)$ diff --git a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac deleted file mode 100644 index 85a5baf4..00000000 --- a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-surf_em.mac +++ /dev/null @@ -1,83 +0,0 @@ -/* - Generate the surface kernels for gyrokinetics with general geometry. - Assumes surface alpha pre-computed so kernels are agnostic to different - forms of gyrokinetics (electrostatic vs. electromagnetic, etc.) - - The functions called in this file are in gkFuncs-surf.mac. -*/ -load("gk_collisionless/em/dg_gk-surf_em")$ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 1$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor order basis. No need to generate p=1. */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ - -/* Vdim possibilities for each of Cdim=[1,2,3]. */ -gkVdims : [[1,2], [2], [2]]$ - -/* ...... END OF USER INPUTS........ */ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -clabels : ["x","y","z"]$ -vlabels : ["vpar","mu"]$ - -/* Possible combinations of variable dependence of background magnetic field. - with [] = const. Note that we assume axisymmetry, which means B cannot depend on y. */ -bVarsList : [x,z]$ - -includeSurfHeaders(fhIn, bname, c, v, porder, dir) := block([], - printf(fhIn, "#include ~%"), - if porder = 1 then ( /* Force hybrid basis (p=2 in velocity space). */ - printf(fhIn, "#include ~%", c, v) - ) elseif porder > 1 then ( - printf(fhIn, "#include ~%", bname, c+v, porder) - ) -)$ - -/* Generate kernels of selected types. */ -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - /* Advection in velocity space.*/ - fname : sconcat("~/max-out/dg_gyrokinetic_add_em_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), - disp(printf(false,"Creating surface file: ~a",fname)), - - fh : openw(fname), - includeSurfHeaders(fh, bName[bInd], c, v, polyOrder, c+1), - funcName : sconcat("dg_gyrokinetic_add_em_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - calcGKAddEMSurfUpdateInDir(c+1, fh, funcName, c, v, bName[bInd], polyOrder, bVarsList), - close(fh), - - /* Advection in velocity space in the skin cell along vpar (for zero-flux BCs).*/ - fname : sconcat("~/max-out/dg_gyrokinetic_add_em_boundary_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), - disp(printf(false,"Creating surface file: ~a",fname)), - - fh : openw(fname), - includeSurfHeaders(fh, bName[bInd], c, v, polyOrder, c+1), - funcName : sconcat("dg_gyrokinetic_add_em_boundary_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - calcGKAddEMBoundarySurfUpdateInDir(c+1, fh, funcName, c, v, bName[bInd], polyOrder, bVarsList), - close(fh) - ) - ) - ) -)$ diff --git a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac b/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac deleted file mode 100644 index e2766cb2..00000000 --- a/maxima/g0/gk_collisionless/em/ms-dg_gyrokinetic-vol_em.mac +++ /dev/null @@ -1,72 +0,0 @@ -/* - Generate the volume kernels for collisionless gyrokinetic terms. - - The functions called in this file are in gkFuncs-vol.mac. -*/ -load("gk_collisionless/em/dg_gk-vol_em")$ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 1$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor order basis. No need to generate p=1. */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 2$ -minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ - -/* Vdim possibilities for each of Cdim=[1,2,3]. */ -gkVdims : [[1,2], [2], [2]]$ - -/* ...... END OF USER INPUTS........ */ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -/* Possible combinations of variable dependence of background magnetic field. - with [] = const. Note that we assume axisymmetry, which means B cannot depend on y. */ -bVarsList : [x,z]$ - -/* Generate kernels of selected types. */ -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - fname : sconcat("~/max-out/dg_gyrokinetic_add_em_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating volume file: ~a",fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("dg_gyrokinetic_add_em_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKAddEMVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, false), - close(fh) - - /* if cdim > 1, also generate a set of kernels for the case where there is no toroidal field (by = 0) */ - /* if (c > 1) then ( - fname : sconcat("~/max-out/dg_gyrokinetic_no_by_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating volume file (no by): ~a",fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("dg_gyrokinetic_no_by_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, true), - close(fh) - ) */ - ) - ) - ) -)$ diff --git a/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac b/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac deleted file mode 100644 index f51e3991..00000000 --- a/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux-header_em.mac +++ /dev/null @@ -1,122 +0,0 @@ -/* Compute the header file for gyrokinetic collisionless flux kernels. */ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -maxPolyOrder_Ser : 2$ -minCdim_Ser : 1$ -minVdim_Ser : 1$ -maxCdim_Ser : 3$ -maxVdim_Ser : 2$ - -/* Tensor order basis. */ -maxPolyOrder_Tensor : 2$ -minCdim_Tensor : 1$ -minVdim_Tensor : 1$ -maxCdim_Tensor : 0$ -maxVdim_Tensor : 0$ - -/* Number of velocity dimensions allowed for each - configuration-space dimension. */ -gkVdims : [[1,2], [2], [2]]$ - -/* ...... END OF USER INPUTS........ */ - -varsC : [x, y, z]$ -varsV : [vpar, mu]$ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -minVdim : [minVdim_Ser, minVdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ -maxVdim : [maxVdim_Ser, maxVdim_Tensor]$ - -/* Options for writing kernels with and without toroidal field (b_y=0), one per - dimension. */ -byOpt : [[false], [false, true], [false, true]]$ -byStr : ["", "no_by_"]$ - -/* Options for writing kernels used at multiblock boundaries. One for each - dimension. */ -mb_bcOpt : [[false,true],[false,true],[false,true]]$ -mb_bcStr : ["", "multib_boundary_"]$ - -printPrototypes() := block([], - for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ - for polyOrder : 1 thru maxPolyOrderB do ( - - for byI : 1 thru length(byOpt[c]) do ( - no_by : byOpt[c][byI], - no_byStr : byStr[byI], - - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], - - for surfDir : 1 thru c do ( - dirlabel : varsC[surfDir], - extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", - vprimeargs : "", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_em_~a~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_em_~a~aedge_surf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) - ) - ), - - dirlabel : varsV[1], - extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", - vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_em_~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", no_byStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) - ), - - printf(fh, "~%") - ) - ) - ) - ) -)$ - -fh : openw("~/max-out/gkyl_gk_collisionless_flux_kernels_add_em.h")$ -printf(fh, "#pragma once~%")$ -printf(fh, "~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "~%")$ -printf(fh, "EXTERN_C_BEG~%")$ -printf(fh, "~%")$ -printPrototypes()$ -printf(fh, "~%")$ -printf(fh, "EXTERN_C_END~%")$ -close(fh)$ diff --git a/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac b/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac deleted file mode 100644 index 4844eeb9..00000000 --- a/maxima/g0/gk_collisionless/em/ms-gk_collisionless_flux_em.mac +++ /dev/null @@ -1,105 +0,0 @@ -/* - Generate the kernel for surface expansions of the phase space characteristics. - - The functions called in this file are in gkFuncs-alpha-surf.mac. -*/ -load("gk_collisionless/em/gk_collisionless_flux-surf-conf_em")$ -load("gk_collisionless/em/gk_collisionless_flux-surf-vpar_em")$ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 1$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor order basis. No need to generate p=1. */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 2$ -minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ - -/* ...... END OF USER INPUTS........ */ - -/* Vdim possibilities for each of Cdim=[1,2,3]. */ -gkVdims : [[1,2], [2], [2]]$ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -clabels : ["x","y","z"]$ -vlabels : ["vpar","mu"]$ - -/* Options for writing kernels with and without toroidal field (b_y=0), one per - dimension. */ -byOpt : [[false], [false, true], [false, true]]$ -byStr : ["", "no_by_"]$ - -/* Options for writing kernels used at multiblock boundaries. One for each - dimension. */ -mb_bcOpt : [[false,true],[false,true],[false,true]]$ -mb_bcStr : ["", "multib_boundary_"]$ - -/* Generate kernels of selected types. */ -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - - for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - for byI : 1 thru length(byOpt[c]) do ( - no_by : byOpt[c][byI], - no_byStr : byStr[byI], - - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], - - /* Surface flux in direction dir in configuration space.*/ - for dir : 1 thru c do ( - - fname : sconcat("~/max-out/gk_collisionless_flux_add_em_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_collisionless_flux_add_em_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxConfAddEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false, mb_bound), - close(fh), - - fname : sconcat("~/max-out/gk_collisionless_flux_add_em_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_collisionless_flux_add_em_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxConfAddEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, true, mb_bound), - close(fh) - ) - ), - - /* Surface flux in vparallel direction.*/ - fname : sconcat("~/max-out/gk_collisionless_flux_add_em_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_collisionless_flux_add_em_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxVparAddEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false), - close(fh) - ) - ) - ) - ) -)$ diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 34e06ea7..5ad7004d 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -297,3 +297,305 @@ buildGKFluxConfESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, "} ~%") )$ + +AddAparGKEMFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge, mb_bound) := block( + [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, + surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, + numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,bmagSurf_e,vmap_e,vmapSq_e, + vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, + jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, + dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL + ], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + surfIntVarsC : delete(surfVar,varsC), + bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + nodeVars : surfIntVars, + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + nodeVars : surfIntVars, + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) + ), + if cdim = 1 then ( + surfConfigNodes : [1] + ) + else ( + surfConfigNodes : gaussOrd(polyOrder+1, cdim-1) + ), + numSurfNodes : length(surfNodes), + numSurfConfigNodes : length(surfConfigNodes), + numVelNodes : numSurfNodes/numSurfConfigNodes, + numMuNodes : 1, + if vdim > 1 then ( numMuNodes : 2), + numVparNodes : numVelNodes/numMuNodes, + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, + const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // dgs: surface DG geometry.~%"), + printf(fh, " // gkdgs: gyrokinetic surface DG geometry.~%"), + printf(fh, " // bmag: bmag represented on the surface.~%"), + printf(fh, " // jacobgeo_rat_surfL: Ratio of surface conf-space Jacobians in left cell.~%"), + printf(fh, " // jacobgeo_rat_surfR: Ratio of surface conf-space Jacobians in right cell.~%"), + printf(fh, " // phi: electrostatic potential.~%"), + printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), + printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), + printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), + printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), + printf(fh, "~%"), + + /* Declare cell-center variables and variables multiplying gradients. */ + for d : 1 thru cdim+1 do ( + printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) + ), + printf(fh, "~%"), + rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + /* Axisymmetric basis (independent of y). */ + bmagBasis : getAxisymmetricConfBasis(bC), + + /* Expand input fields for Hamiltonian calculation */ + phi_e : doExpand1(phi,bC), + bmagSurf_e : doExpand1(bmag, bmagBasis), + + /* Velocity mapping fields. */ + [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + + /* Redefine vmap_prime to exploit the relationship between it and vmap. */ + /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ + vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), + + if edge = true then ( + evPoint : 1 + ) else ( + evPoint : -1 + ), + + /* Finally write out the hamiltonian*/ + hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmagSurf_e ), + hamil_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,hamil_e)), + printf(fh, " double hamil[~a] = {0.}; ~%", numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + hamilCvar : eval_string(sconcat("hamil")), + writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), + printf(fh, "~%"), + flush_output(fh), + hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), + /* Expand projected Hamiltonian on basis. */ + hamil_e : hamilNoZero_c . bSurf, + + /* fl and fr */ + JfL_e : doExpand1(JfL, bP), + JfR_e : doExpand1(JfR, bP), + JfL_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=1,JfL_e)), + JfR_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=-1,JfR_e)), + JfL_e : JfL_c . bSurf, + JfR_e : JfR_c . bSurf, + + if (mb_bound = true) then ( + /* Rescale ghost cell by ratio of the Jacobians at multiblock boundaries. */ + + if (edge = true) then ( + /* Upper boundary. */ + jacobgeo_rat_surfR_e : doExpand1(jacobgeo_rat_surfR, bSurfC), + + JfR_c : calcInnerProdList(surfIntVars, jacobgeo_rat_surfR_e, bSurf, JfR_e), + printf(fh, " double JRatfR[~a] = {0.}; ~%", length(bSurf)), + writeCExprsNoExpand1(JRatfR, fullratsimp(JfR_c)), + printf(fh, "~%"), + JfR_c : makelistNoZeros1(JfR_c, JRatfR), + JfR_e : doExpand(JfR_c, bSurf) + ) else ( + /* Lower boundary. */ + jacobgeo_rat_surfL_e : doExpand1(jacobgeo_rat_surfL, bSurfC), + + JfL_c : calcInnerProdList(surfIntVars, jacobgeo_rat_surfL_e, bSurf, JfL_e), + printf(fh, " double JRatfL[~a] = {0.}; ~%", length(bSurf)), + writeCExprsNoExpand1(JRatfL, fullratsimp(JfL_c)), + printf(fh, "~%"), + JfL_c : makelistNoZeros1(JfL_c, JRatfL), + JfL_e : doExpand(JfL_c, bSurf) + ) + ), + + JfL_nodes : gcfac(float(expand(evAtNodes(JfL_e,surfNodes,surfIntVars)))), + JfR_nodes : gcfac(float(expand(evAtNodes(JfR_e,surfNodes,surfIntVars)))), + + vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), + + vpardim : pDim-1, + if vdim = 1 then ( vpardim : pDim ), + dH_dz_nodes : makelist(0, i, 1, pDim), + for i : 1 thru vpardim do ( + if i = vpardim then ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars))/vmap_prime_nodes + ) + else ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ) + ), + + mvpar_nodes : [], + for i : 1 thru numVparNodes do ( + mvpar_nodes : append(mvpar_nodes, [dH_dz_nodes[vpardim][i]]) + ), + + if surfDir = cdim then( + di3 : true + ) + else ( + di3 : false + ), + + /* Expand Aparallel. */ + apar_e : doExpand1(apar,bC), + /* Eval Aparallel at nodes. */ + apar_nodes : float(evAtNodes(apar_e,surfNodes,surfIntVars)), + /* Compute gradient of Aparallel */ + dA_dx_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ), + /* It will be used to compute the contribution as curl(Apar * bhat) = nabla Aparallel cross bhat + Aparallel * curl(bhat) */ + + /* Now calculate flux at all quadrature nodes */ + /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ + printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", length(bSurf)*(surfDir-1)), + printf(fh, " double cfl = 0.0; ~%"), + printf(fh, " double bmag_quad = 0.0; ~%"), + printf(fh, " double Jc_quad = 0.0; ~%"), + printf(fh, " double B3_quad = 0.0; ~%"), + printf(fh, " double normcurlbhat_quad = 0.0; ~%"), + printf(fh, " double area_elem_quad = 0.0; ~%"), + printf(fh, " double bhat_quad[3] = {0.0}; ~%"), + + printf(fh, " double alpha_quad = 0.0; ~%"), + printf(fh, " double JfL_quad = 0.0; ~%"), + printf(fh, " double JfR_quad = 0.0; ~%"), + printf(fh, " double Jfavg_quad = 0.0; ~%"), + printf(fh, " double Jfjump_quad = 0.0; ~%"), + + printf(fh, " double mvpar_quad[3] = {0.0}; ~%"), + for i : 1 thru numVparNodes do ( + printf(fh, " mvpar_quad[~a] = ~a; ~%", i-1, mvpar_nodes[i]) + ), + + printf(fh, " double mvparsq_quad[3] = {0.0}; ~%"), + for i : 1 thru numVparNodes do ( + printf(fh, " mvparsq_quad[~a] = mvpar_quad[~a]*mvpar_quad[~a]/m_; ~%", i-1, i-1,i-1) + ), + printf(fh, "~%"), + + for i : 1 thru numSurfConfigNodes do ( + printf(fh, " bmag_quad = gkdgs[~a].bmag; ~%", i-1), + printf(fh, " Jc_quad = gkdgs[~a].Jc; ~%", i-1), + printf(fh, " B3_quad = gkdgs[~a].B3; ~%", i-1), + printf(fh, " normcurlbhat_quad = gkdgs[~a].normcurlbhat; ~%", i-1), + printf(fh, " bhat_quad[0] = gkdgs[~a].bhat.x[0]; ~%", i-1), + printf(fh, " bhat_quad[1] = gkdgs[~a].bhat.x[1]; ~%", i-1), + printf(fh, " bhat_quad[2] = gkdgs[~a].bhat.x[2]; ~%", i-1), + printf(fh, " area_elem_quad = dgs[~a].area_elem; ~%", i-1), + printf(fh, "~%"), + for j : 1 thru numVelNodes do ( + j0index : j-1+(i-1)*numVelNodes, + j1index : j+(i-1)*numVelNodes, + vparindex : mod(j-1, numVparNodes) + 1, + vpar0index : mod(j-1, numVparNodes), + printf(fh, "~%"), + printf(fh, " alpha_quad = 0.0; ~%"), + + if no_by = false then ( + /*printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) ;~%", vpar0index),*/ + if cdim = 3 then ( + if surfDir = 1 then( + /* Aparallel curl b contribution */ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), + /* grad(Aparallel) x b contribution*/ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) + ), + if surfDir = 2 then( + /* Aparallel curl b contribution */ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), + /* grad(Aparallel) x b contribution*/ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) + ), + if surfDir = 3 then( + /* Aparallel curl b contribution */ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), + /* grad(Aparallel) x b contribution*/ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", vpar0index, dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + ) + ), + if cdim = 2 then ( + if surfDir = 1 then( + /* Aparallel curl b contribution */ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), + /* grad(Aparallel) x b contribution*/ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[2][j1index]) + ), + if surfDir = 2 then( + /* Aparallel curl b contribution */ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), + /* grad(Aparallel) x b contribution*/ + printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[1][j1index]) + ) + ), + if cdim = 1 then ( + /* B0 */ + printf(fh, " alpha_quad = 0.0; ~%", vpar0index) + ) + ), + + printf(fh, "~%"), + /*printf(fh, " alpha_quad = alpha_quad*area_elem_quad/Jc_quad; ~%"),*/ + printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)); ~%"), + printf(fh, " JfL_quad = ~a; ~%", JfL_nodes[j1index]), + printf(fh, " JfR_quad = ~a; ~%", JfR_nodes[j1index]), + printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0; ~%"), + printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0; ~%"), + printf(fh, " flux_surf_nodal[~a] += alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad; ~%", j0index) + ), + printf(fh, "~%") + ), + + /*Calculate the cfl*/ + pOrderCFL : polyOrder, + printf(fh, "~%"), + printf(fh, " return cfl*~a; ~%", float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), + + printf(fh, "~%"), + flush_output(fh), + printf(fh, "} ~%") + +)$ diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index a172abb2..516acb78 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -240,3 +240,420 @@ buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, "} ~%") )$ + + +AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, edge) := block( + [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, + surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, + numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, + bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, + hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr + ], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + surfIntVarsC : delete(surfVar,varsC), + bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + nodeVars : surfIntVars, + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + nodeVars : surfIntVars, + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) + ), + configNodes : gaussOrd(polyOrder+1, cdim), + numSurfNodes : length(surfNodes), + numConfigNodes : length(configNodes), + numVelNodes : numSurfNodes/numConfigNodes, + + /* if polyOrder = 1, we need to be careful about + indexing input arrays since the surface hybrid basis has a different size in the + vparallel surfaces and/or we are more directly exploiting the sparsity of + alpha (e.g., in the x and z direction when no toroidal field, by=0) + and thus utilize fewer coefficients to reduce the number of operations */ + if (polyOrder = 1) then ( + tempVars : delete(x,varsP), + tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), + NSurfIndexing : length(tempBasis), + numNodesIndexing : length(tempBasis) + ) else ( + NSurfIndexing : NSurf, + numNodesIndexing : numNodes + ), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // dgv: volume DG geometry.~%"), + printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), + printf(fh, " // bmag: magnetic field amplitude.~%"), + printf(fh, " // phi: electrostatic potential.~%"), + printf(fh, " // apar: parallel component of vector potential.~%"), + printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), + printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), + printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), + printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), + printf(fh, "~%"), + + /* Declare cell-center variables and variables multiplying gradients. */ + for d : 1 thru cdim+1 do ( + printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) + ), + printf(fh, "~%"), + rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + /* Axisymmetric basis (independent of y). */ + bmagBasis : getAxisymmetricConfBasis(bC), + + /* Expand input fields for Hamiltonian calculation */ + phi_e : doExpand1(phi,bC), + bmag_e : doExpand1(bmag, bmagBasis), + + /* Velocity mapping fields. */ + [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + + /* Redefine vmap_prime to exploit the relationship between it and vmap. */ + /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ + vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), + + if edge = true then ( + evPoint : 1 + ) else ( + evPoint : -1 + ), + + /* Finally write out the hamiltonian*/ + hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), + hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), + printf(fh, " double hamil[~a] = {0.}; ~%", numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + hamilCvar : eval_string(sconcat("hamil")), + writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), + printf(fh, "~%"), + flush_output(fh), + hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), + /* Expand projected Hamiltonian on basis. */ + hamil_e : hamilNoZero_c . bP, + /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ + + /* Expand Apar */ + apar_e : doExpand1(apar, bC), + /* I don't know if this is necessary but let's copy the Hamiltonian treatment */ + apar_c : calcInnerProdList(varsP, 1, bP, apar_e), + apar_e : apar_c . bP, + apar_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + apar_nodes[i] : float(evAtNodes(apar_e,surfNodes,surfIntVars)) + ), + /* Compute gradient of Aparallel */ + dA_dx_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ), + + /*fl and fr */ + JfL_e : doExpand1(JfL, bP), + JfR_e : doExpand1(JfR, bP), + JfL_c : calcInnerProdList(varsP, 1, bP, JfL_e), + JfR_c : calcInnerProdList(varsP, 1, bP, JfR_e), + + JfL_e : subst(surfVar=1,JfL_e), + JfR_e : subst(surfVar=-1,JfR_e), + + JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), + JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), + + vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), + + vpardim : pDim-1, + if vdim = 1 then ( vpardim : pDim ), + dH_dz_nodes : makelist(0, i, 1, pDim), + for i : 1 thru vpardim do ( + if i = vpardim then ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars)), + dH_dz_nodes[i] : subst(surfVar=evPoint, dH_dz_nodes[i]) + ) + else ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ) + ), + + /* Now calculate apha at all quadrature nodes */ + /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ + printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), + printf(fh, " double cfl = 0.0; ~%"), + printf(fh, " double bmag_quad = 0.0; ~%"), + printf(fh, " double B3_quad = 0.0; ~%"), + printf(fh, " double Jc_quad = 0.0; ~%"), + printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), + printf(fh, " double m_bmag_inv = 0.0; ~%"), + printf(fh, " double mvpar_over_q = 0.0; ~%"), + + printf(fh, " double alpha_quad = 0.0; ~%"), + printf(fh, " double JfL_quad = 0.0; ~%"), + printf(fh, " double JfR_quad = 0.0; ~%"), + printf(fh, " double Jfavg_quad = 0.0; ~%"), + printf(fh, " double Jfjump_quad = 0.0; ~%"), + printf(fh, "~%"), + + for i : 1 thru numConfigNodes do ( + printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i-1), + printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i-1), + printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i-1), + printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i-1), + printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i-1), + printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i-1), + + printf(fh, " m_bmag_inv = 1.0/(m_*bmag_quad); ~%"), + /* + We develop the component grad(Apar) x b as + e^m . grad(Apar) x b = e^m x grad(Apar) . b = e^m x e^i dApar/dx^i . e_3/|e_3| + which gives + coeff * (g_33 dApar/dx2 - g_23 dApar/dx3) for m=1 + coeff * (g_13 dApar/dx3 - g_33 dApar/dx1) for m=2 + coeff * (g_23 dApar/dx1 - g_13 dApar/dx2) for m=3 + with + coeff = Jc/sqrt(g_33) + */ + printf(fh, " g_13 = 1.0; ~%"), /* need to pass them */ + printf(fh, " g_23 = 1.0; ~%"), + printf(fh, " g_33 = 1.0; ~%"), + printf(fh, " mag_e_3 = 1.0; ~%"), /* I need |e_3|=sqrt(g_33) here */ + + printf(fh, "~%"), + for j : 1 thru numVelNodes do ( + j0index : j-1+(i-1)*numVelNodes, + j1index : j+(i-1)*numVelNodes, + printf(fh, "~%"), + printf(fh, " mvpar_over_q = (~a)/q_; ~%", dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), + + printf(fh, " alpha_quad = 0.0; ~%"), + if cdim = 3 then ( + /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + for k : 1 thru cdim do ( + /* Apar * curl(b) */ + printf(fh, "alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[k][j1index], k-1) + ), + /* grad(Apar) x b */ + printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]), + printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]), + printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + ), + if cdim = 2 then ( + /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + /* Apar * curl(b) */ + printf(fh, "alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 0), + printf(fh, "alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[2][j1index], 2), + /* grad(Apar) x b */ + printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index]), + printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][j1index]) + ), + if cdim = 1 then ( + /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + /* Apar * curl(b) */ + printf(fh, "alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 2) + /* grad(Apar) x b */ + /* none */ + ), + + printf(fh, "~%"), + printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), + printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), + printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), + printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), + printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), + printf(fh, " flux_surf_nodal[~a] += alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) + ), + printf(fh, "~%") + ), + + printf(fh, "~%"), + /*Calculate the cfl*/ + pOrderCFL : polyOrder, + if polyOrder=1 then ( pOrderCFL : 2 ), + printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), + vprimeStr : "/vmap_prime_min", + printf(fh, "~%"), + printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), + + printf(fh, "~%"), + flush_output(fh), + printf(fh, "} ~%") + +)$ + +AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, edge) := block( + [pDim,varsC,bC,varsP,bP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, + surfNodes,configNodes,numSurfNodes,numConfigNodes, + numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdSurfVar2, + JfL_e,JfR_e,JfL_nodes,JfR_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr + ], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1) + ), + configNodes : gaussOrd(polyOrder+1, cdim), + numSurfNodes : length(surfNodes), + numConfigNodes : length(configNodes), + numVelNodes : numSurfNodes/numConfigNodes, + + /* if polyOrder = 1, we need to be careful about + indexing input arrays since the surface hybrid basis has a different size in the + vparallel surfaces and/or we are more directly exploiting the sparsity of + alpha (e.g., in the x and z direction when no toroidal field, by=0) + and thus utilize fewer coefficients to reduce the number of operations */ + if (polyOrder = 1) then ( + tempVars : delete(x,varsP), + tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), + NSurfIndexing : length(tempBasis), + numNodesIndexing : length(tempBasis) + ) else ( + NSurfIndexing : NSurf, + numNodesIndexing : numNodes + ), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *apardot, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // dgv: volume DG geometry.~%"), + printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), + printf(fh, " // bmag: magnetic field amplitude.~%"), + printf(fh, " // phi: electrostatic potential.~%"), + printf(fh, " // apardot: time derivative of the parallel component of vector potential.~%"), + printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), + printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), + printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), + printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), + printf(fh, "~%"), + + /* Declare cell-center variables and variables multiplying gradients. */ + for d : 1 thru cdim+1 do ( + printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) + ), + printf(fh, "~%"), + + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + printf(fh, "~%"), + flush_output(fh), + + /* Expand Apardot */ + apardot_e : doExpand1(apardot, bC), + /* I don't know if this is necessary but let's copy the Hamiltonian treatment */ + apardot_c : calcInnerProdList(varsP, 1, bP, apardot_e), + apardot_e : apardot_c . bP, + apardot_nodes : float(evAtNodes(apardot_e,surfNodes,surfIntVars)), + + /*fl and fr */ + JfL_e : doExpand1(JfL, bP), + JfR_e : doExpand1(JfR, bP), + + JfL_e : subst(surfVar=1,JfL_e), + JfR_e : subst(surfVar=-1,JfR_e), + + JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), + JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), + + /* Now calculate alpha at all quadrature nodes */ + printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), + printf(fh, " double cfl = 0.0; ~%"), + + printf(fh, " double alpha_quad = 0.0; ~%"), + printf(fh, " double JfL_quad = 0.0; ~%"), + printf(fh, " double JfR_quad = 0.0; ~%"), + printf(fh, " double Jfavg_quad = 0.0; ~%"), + printf(fh, " double Jfjump_quad = 0.0; ~%"), + printf(fh, "~%"), + + for i : 1 thru numConfigNodes do ( + printf(fh, "~%"), + for j : 1 thru numVelNodes do ( + j0index : j-1+(i-1)*numVelNodes, + j1index : j+(i-1)*numVelNodes, + printf(fh, "~%"), + + /* Compute the contribution of Apardot */ + printf(fh, " alpha_quad = -q_/m_*(~a); ~%", apardot_nodes[j1index]), + + printf(fh, "~%"), + printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), + printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), + printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), + printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), + printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), + printf(fh, " flux_surf_nodal[~a] += alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) + ), + printf(fh, "~%") + ), + + printf(fh, "~%"), + /*Calculate the cfl*/ + pOrderCFL : polyOrder, + if polyOrder=1 then ( pOrderCFL : 2 ), + printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), + vprimeStr : "/vmap_prime_min", + printf(fh, "~%"), + printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), + + printf(fh, "~%"), + flush_output(fh), + printf(fh, "} ~%") +)$ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac index 08e41563..a624bdde 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac @@ -86,6 +86,27 @@ printPrototypes() := block([], ) ) ) + ), + /* EM terms */ + for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ + for polyOrder : 1 thru maxPolyOrderB do ( + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_apar_vol_~ax~av_~a_p~a(const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const double *bmag, const double *jacobtot_inv, + const double *b_i, const double *phi, const double *apar, + const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_apardot_vol_~ax~av_~a_p~a(const double q_, const double m_, + const double *apardot, const double *fin, double* GKYL_RESTRICT out) ; ~%", c, v, bName[bInd], polyOrder), + printf(fh, "~%") + ) + ) + ) ) )$ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac index ef0b8a40..37d36b83 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac @@ -54,6 +54,23 @@ for bInd : 1 thru length(bName) do ( buildGKVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, false), close(fh), + /* Add em kernels */ + fname : sconcat("~/max-out/dg_gyrokinetic_add_apar_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating volume file (add em): ~a",fname)), + fh : openw(fname), + printf(fh, "#include ~%"), + funcName : sconcat("dg_gyrokinetic_add_apar_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + addAparGKEMVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, false), + close(fh), + + fname : sconcat("~/max-out/dg_gyrokinetic_add_apardot_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating volume file (add em): ~a",fname)), + fh : openw(fname), + printf(fh, "#include ~%"), + funcName : sconcat("dg_gyrokinetic_add_apardot_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + addApardotGKEMVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, false), + close(fh), + /* if cdim > 1, also generate a set of kernels for the case where there is no toroidal field (by = 0) */ if (c > 1) then ( fname : sconcat("~/max-out/dg_gyrokinetic_no_by_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index ebef045a..a01ef010 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -103,6 +103,89 @@ printPrototypes() := block([], ) ) ) + ), + + /* EM terms */ + for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ + for polyOrder : 1 thru maxPolyOrderB do ( + + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], + + for surfDir : 1 thru c do ( + dirlabel : varsC[surfDir], + extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", + vprimeargs : "", + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apar_~asurf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apar_~aedge_surf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apardot_~asurf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apardot_~aedge_surf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + ) + ), + + dirlabel : varsV[1], + extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", + vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apar_surf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + + printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apardot_surf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *phi, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + ), + + printf(fh, "~%") + ) + ) ) )$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 25581b85..4adad02e 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -84,7 +84,30 @@ for bInd : 1 thru length(bName) do ( funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), buildGKFluxConfESKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, true, mb_bound), - close(fh) + close(fh), + + /* EM terms */ + if (no_by = false) then ( + fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_collisionless_flux_add_apar_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + AddAparGKEMFluxConfKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false, mb_bound), + close(fh), + + fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_collisionless_flux_add_apar_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + AddAparGKEMFluxConfKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, true, mb_bound), + close(fh) + ) ) ), @@ -97,7 +120,30 @@ for bInd : 1 thru length(bName) do ( funcName : sconcat("gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), buildGKFluxVparESKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false), - close(fh) + close(fh), + + if (no_by = false) then ( + /* EM terms */ + fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar file: ~a",fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_collisionless_flux_add_apar_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + AddAparGKEMFluxVparKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, false), + close(fh), + + fname : sconcat("~/max-out/gk_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar file: ~a",fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + AddApardotGKEMFluxVparKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, false), + close(fh) + ) ) ) ) From 78e8603c782f22137ab6fdf3b1b18b4237d6baeb Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 6 Nov 2025 09:13:42 -0500 Subject: [PATCH 07/66] The scripts are still containing commented parts to keep the possibility of generating separated EM/ES kernels. This will be cleaned once the design in Gkeyll is fully decided. --- .../gk_collisionless_flux-surf-conf.mac | 393 ++++++++++++++++-- .../gk_collisionless_flux-surf-vpar.mac | 338 ++++++++++++++- .../ms-gk_collisionless_flux-header.mac | 12 +- .../ms-gk_collisionless_flux.mac | 38 +- 4 files changed, 705 insertions(+), 76 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 5ad7004d..f336e4ae 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -298,10 +298,12 @@ buildGKFluxConfESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no )$ -AddAparGKEMFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge, mb_bound) := block( + +buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, mb_bound) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, - numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,bmagSurf_e,vmap_e,vmapSq_e, + numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,apar_e, + bmagSurf_e,vmap_e,vmapSq_e, vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL @@ -366,6 +368,7 @@ AddAparGKEMFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, printf(fh, " // jacobgeo_rat_surfL: Ratio of surface conf-space Jacobians in left cell.~%"), printf(fh, " // jacobgeo_rat_surfR: Ratio of surface conf-space Jacobians in right cell.~%"), printf(fh, " // phi: electrostatic potential.~%"), + printf(fh, " // apar: parallel component of vector potential.~%"), printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), @@ -413,7 +416,7 @@ AddAparGKEMFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, flush_output(fh), hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bSurf, + hamil_e : doExpand(hamilNoZero_c, bSurf), /* fl and fr */ JfL_e : doExpand1(JfL, bP), @@ -480,6 +483,12 @@ AddAparGKEMFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, /* Expand Aparallel. */ apar_e : doExpand1(apar,bC), + apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), + /* printf(fh, " double apar[~a] = {0.}; ~%", numP), */ + aparCvar : eval_string(sconcat("apar")), + apar_c : makelistNoZeros1(apar_c, aparCvar), + /* Expand projected Apar on basis. */ + apar_e : doExpand(apar_c, bSurf), /* Eval Aparallel at nodes. */ apar_nodes : float(evAtNodes(apar_e,surfNodes,surfIntVars)), /* Compute gradient of Aparallel */ @@ -533,47 +542,361 @@ AddAparGKEMFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, vparindex : mod(j-1, numVparNodes) + 1, vpar0index : mod(j-1, numVparNodes), printf(fh, "~%"), - printf(fh, " alpha_quad = 0.0; ~%"), - if no_by = false then ( + /* Electrostatic term */ + if no_by = true then ( + if di3 = true then ( + printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad))*area_elem_quad/Jc_quad; ~%", vpar0index) + ) + else ( + printf(fh, " alpha_quad = 0.0; ~%") + ) + ) else ( /*printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) ;~%", vpar0index),*/ if cdim = 3 then ( - if surfDir = 1 then( - /* Aparallel curl b contribution */ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), - /* grad(Aparallel) x b contribution*/ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) - ), - if surfDir = 2 then( - /* Aparallel curl b contribution */ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), - /* grad(Aparallel) x b contribution*/ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) - ), - if surfDir = 3 then( - /* Aparallel curl b contribution */ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), - /* grad(Aparallel) x b contribution*/ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", vpar0index, dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) - ) + if surfDir = 1 then( + printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[1]*(~a) - bhat_quad[2]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[3][j1index], dH_dz_nodes[2][j1index]) + ), + if surfDir = 2 then( + printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[2]*(~a) - bhat_quad[0]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[1][j1index], dH_dz_nodes[3][j1index]) + ), + if surfDir = 3 then( + printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad) + mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[0]*(~a) - bhat_quad[1]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, vpar0index, dH_dz_nodes[2][j1index], dH_dz_nodes[1][j1index]) + ) ), if cdim = 2 then ( - if surfDir = 1 then( + if surfDir = 1 then( + printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[2][j1index]) + ), + if surfDir = 2 then( + printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad) + mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * -bhat_quad[1]*(~a))*area_elem_quad/Jc_quad;~%", vpar0index, vpar0index, dH_dz_nodes[1][j1index]) + ) + ), + if cdim = 1 then ( + printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad))*area_elem_quad/Jc_quad; ~%", vpar0index) + ), + + if em = true then ( + /* Electromagnetic Apar contribution curl(Apar b) = grad(Apar) x b + Apar curl(b)*/ + /* No contribution for cdim = 1 */ + if cdim > 1 then ( /* Aparallel curl b contribution */ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), - /* grad(Aparallel) x b contribution*/ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[2][j1index]) + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]) ), - if surfDir = 2 then( - /* Aparallel curl b contribution */ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]), - /* grad(Aparallel) x b contribution*/ - printf(fh, " alpha_quad += mvpar_quad[~a]/bmag_quad * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[1][j1index]) + /* grad(Aparallel) x b contribution*/ + if cdim = 3 then ( + if surfDir = 1 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) + ), + if surfDir = 2 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) + ), + if surfDir = 3 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", vpar0index, dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + ) + ), + if cdim = 2 then ( + if surfDir = 1 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[2][j1index]) + ), + if surfDir = 2 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[1][j1index]) + ) ) + ) + ), + + printf(fh, "~%"), + /*printf(fh, " alpha_quad = alpha_quad*area_elem_quad/Jc_quad; ~%"),*/ + printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)); ~%"), + printf(fh, " JfL_quad = ~a; ~%", JfL_nodes[j1index]), + printf(fh, " JfR_quad = ~a; ~%", JfR_nodes[j1index]), + printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0; ~%"), + printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0; ~%"), + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad; ~%", j0index) + ), + printf(fh, "~%") + ), + + /*Calculate the cfl*/ + pOrderCFL : polyOrder, + printf(fh, "~%"), + printf(fh, " return cfl*~a; ~%", float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), + + printf(fh, "~%"), + flush_output(fh), + printf(fh, "} ~%") + +)$ + +AddAparGKEMFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, edge, mb_bound) := block( + [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, + surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, + numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,bmagSurf_e,vmap_e,vmapSq_e, + vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, + jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, + dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL + ], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + surfIntVarsC : delete(surfVar,varsC), + bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + nodeVars : surfIntVars, + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + nodeVars : surfIntVars, + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) + ), + if cdim = 1 then ( + surfConfigNodes : [1] + ) + else ( + surfConfigNodes : gaussOrd(polyOrder+1, cdim-1) + ), + numSurfNodes : length(surfNodes), + numSurfConfigNodes : length(surfConfigNodes), + numVelNodes : numSurfNodes/numSurfConfigNodes, + numMuNodes : 1, + if vdim > 1 then ( numMuNodes : 2), + numVparNodes : numVelNodes/numMuNodes, + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, + const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // dgs: surface DG geometry.~%"), + printf(fh, " // gkdgs: gyrokinetic surface DG geometry.~%"), + printf(fh, " // bmag: bmag represented on the surface.~%"), + printf(fh, " // jacobgeo_rat_surfL: Ratio of surface conf-space Jacobians in left cell.~%"), + printf(fh, " // jacobgeo_rat_surfR: Ratio of surface conf-space Jacobians in right cell.~%"), + printf(fh, " // phi: electrostatic potential.~%"), + printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), + printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), + printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), + printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), + printf(fh, "~%"), + + /* Declare cell-center variables and variables multiplying gradients. */ + for d : 1 thru cdim+1 do ( + printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) + ), + printf(fh, "~%"), + rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + /* Axisymmetric basis (independent of y). */ + bmagBasis : getAxisymmetricConfBasis(bC), + + /* Expand input fields for Hamiltonian calculation */ + phi_e : doExpand1(phi,bC), + bmagSurf_e : doExpand1(bmag, bmagBasis), + + /* Velocity mapping fields. */ + [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + + /* Redefine vmap_prime to exploit the relationship between it and vmap. */ + /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ + vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), + + if edge = true then ( + evPoint : 1 + ) else ( + evPoint : -1 + ), + + /* Finally write out the hamiltonian*/ + hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmagSurf_e ), + hamil_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,hamil_e)), + printf(fh, " double hamil[~a] = {0.}; ~%", numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + hamilCvar : eval_string(sconcat("hamil")), + writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), + printf(fh, "~%"), + flush_output(fh), + hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), + /* Expand projected Hamiltonian on basis. */ + hamil_e : doExpand(hamilNoZero_c, bSurf), + + /* fl and fr */ + JfL_e : doExpand1(JfL, bP), + JfR_e : doExpand1(JfR, bP), + JfL_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=1,JfL_e)), + JfR_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=-1,JfR_e)), + JfL_e : JfL_c . bSurf, + JfR_e : JfR_c . bSurf, + + if (mb_bound = true) then ( + /* Rescale ghost cell by ratio of the Jacobians at multiblock boundaries. */ + + if (edge = true) then ( + /* Upper boundary. */ + jacobgeo_rat_surfR_e : doExpand1(jacobgeo_rat_surfR, bSurfC), + + JfR_c : calcInnerProdList(surfIntVars, jacobgeo_rat_surfR_e, bSurf, JfR_e), + printf(fh, " double JRatfR[~a] = {0.}; ~%", length(bSurf)), + writeCExprsNoExpand1(JRatfR, fullratsimp(JfR_c)), + printf(fh, "~%"), + JfR_c : makelistNoZeros1(JfR_c, JRatfR), + JfR_e : doExpand(JfR_c, bSurf) + ) else ( + /* Lower boundary. */ + jacobgeo_rat_surfL_e : doExpand1(jacobgeo_rat_surfL, bSurfC), + + JfL_c : calcInnerProdList(surfIntVars, jacobgeo_rat_surfL_e, bSurf, JfL_e), + printf(fh, " double JRatfL[~a] = {0.}; ~%", length(bSurf)), + writeCExprsNoExpand1(JRatfL, fullratsimp(JfL_c)), + printf(fh, "~%"), + JfL_c : makelistNoZeros1(JfL_c, JRatfL), + JfL_e : doExpand(JfL_c, bSurf) + ) + ), + + JfL_nodes : gcfac(float(expand(evAtNodes(JfL_e,surfNodes,surfIntVars)))), + JfR_nodes : gcfac(float(expand(evAtNodes(JfR_e,surfNodes,surfIntVars)))), + + vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), + + vpardim : pDim-1, + if vdim = 1 then ( vpardim : pDim ), + dH_dz_nodes : makelist(0, i, 1, pDim), + for i : 1 thru vpardim do ( + if i = vpardim then ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars))/vmap_prime_nodes + ) + else ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ) + ), + + mvpar_nodes : [], + for i : 1 thru numVparNodes do ( + mvpar_nodes : append(mvpar_nodes, [dH_dz_nodes[vpardim][i]]) + ), + + if surfDir = cdim then( + di3 : true + ) + else ( + di3 : false + ), + + /* Expand Aparallel. */ + apar_e : doExpand1(apar,bC), + apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), + /* printf(fh, " double apar[~a] = {0.}; ~%", numP), */ + aparCvar : eval_string(sconcat("apar")), + apar_c : makelistNoZeros1(apar_c, aparCvar), + /* Expand projected Apar on basis. */ + apar_e : doExpand(apar_c, bSurf), + /* Eval Aparallel at nodes. */ + apar_nodes : float(evAtNodes(apar_e,surfNodes,surfIntVars)), + /* Compute gradient of Aparallel */ + dA_dx_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ), + /* It will be used to compute the contribution as curl(Apar * bhat) = nabla Aparallel cross bhat + Aparallel * curl(bhat) */ + + /* Now calculate flux at all quadrature nodes */ + /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ + printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", length(bSurf)*(surfDir-1)), + printf(fh, " double cfl = 0.0; ~%"), + printf(fh, " double bmag_quad = 0.0; ~%"), + printf(fh, " double Jc_quad = 0.0; ~%"), + printf(fh, " double B3_quad = 0.0; ~%"), + printf(fh, " double normcurlbhat_quad = 0.0; ~%"), + printf(fh, " double area_elem_quad = 0.0; ~%"), + printf(fh, " double bhat_quad[3] = {0.0}; ~%"), + + printf(fh, " double alpha_quad = 0.0; ~%"), + printf(fh, " double JfL_quad = 0.0; ~%"), + printf(fh, " double JfR_quad = 0.0; ~%"), + printf(fh, " double Jfavg_quad = 0.0; ~%"), + printf(fh, " double Jfjump_quad = 0.0; ~%"), + + printf(fh, " double mvpar_quad[3] = {0.0}; ~%"), + for i : 1 thru numVparNodes do ( + printf(fh, " mvpar_quad[~a] = ~a; ~%", i-1, mvpar_nodes[i]) + ), + + printf(fh, " double mvparsq_quad[3] = {0.0}; ~%"), + for i : 1 thru numVparNodes do ( + printf(fh, " mvparsq_quad[~a] = mvpar_quad[~a]*mvpar_quad[~a]/m_; ~%", i-1, i-1,i-1) + ), + printf(fh, "~%"), + + for i : 1 thru numSurfConfigNodes do ( + printf(fh, " bmag_quad = gkdgs[~a].bmag; ~%", i-1), + printf(fh, " Jc_quad = gkdgs[~a].Jc; ~%", i-1), + printf(fh, " B3_quad = gkdgs[~a].B3; ~%", i-1), + printf(fh, " normcurlbhat_quad = gkdgs[~a].normcurlbhat; ~%", i-1), + printf(fh, " bhat_quad[0] = gkdgs[~a].bhat.x[0]; ~%", i-1), + printf(fh, " bhat_quad[1] = gkdgs[~a].bhat.x[1]; ~%", i-1), + printf(fh, " bhat_quad[2] = gkdgs[~a].bhat.x[2]; ~%", i-1), + printf(fh, " area_elem_quad = dgs[~a].area_elem; ~%", i-1), + printf(fh, "~%"), + for j : 1 thru numVelNodes do ( + j0index : j-1+(i-1)*numVelNodes, + j1index : j+(i-1)*numVelNodes, + vparindex : mod(j-1, numVparNodes) + 1, + vpar0index : mod(j-1, numVparNodes), + printf(fh, "~%"), + printf(fh, " alpha_quad = 0.0; ~%"), + + if cdim = 1 then ( + /* No contribution */ + printf(fh, " alpha_quad = 0.0; ~%", vpar0index) + ) else ( + /* Aparallel curl b contribution */ + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]) + ), + /* grad(Aparallel) x b contribution*/ + if cdim = 3 then ( + if surfDir = 1 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) ), - if cdim = 1 then ( - /* B0 */ - printf(fh, " alpha_quad = 0.0; ~%", vpar0index) + if surfDir = 2 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) + ), + if surfDir = 3 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", vpar0index, dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + ) + ), + if cdim = 2 then ( + if surfDir = 1 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[2][j1index]) + ), + if surfDir = 2 then( + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[1][j1index]) ) ), diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 516acb78..01969b2f 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -242,6 +242,307 @@ buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no )$ +buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge) := block( + [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, + surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, + numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, + bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, + hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr + ], + + kill(varsC,varsP,bC,bP), + pDim : cdim+vdim, + + [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), + numC : length(bC), numP : length(bP), + + surfVar : varsP[surfDir], /* Surface variable. */ + varLabel : makelist(string(varsP[d]),d,1,pDim), + dirLabel : varLabel[surfDir], + + surfIntVars : delete(surfVar,varsP), + surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), + surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), + + surfIntVarsC : delete(surfVar,varsC), + bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), + + if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ + surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), + nodeVars : surfIntVars, + bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), + basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) + ) else ( + surfNodes : gaussOrd(polyOrder+1, pDim-1), + nodeVars : surfIntVars, + bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) + ), + configNodes : gaussOrd(polyOrder+1, cdim), + numSurfNodes : length(surfNodes), + numConfigNodes : length(configNodes), + numVelNodes : numSurfNodes/numConfigNodes, + + /* if polyOrder = 1, we need to be careful about + indexing input arrays since the surface hybrid basis has a different size in the + vparallel surfaces and/or we are more directly exploiting the sparsity of + alpha (e.g., in the x and z direction when no toroidal field, by=0) + and thus utilize fewer coefficients to reduce the number of operations */ + if (polyOrder = 1) then ( + tempVars : delete(x,varsP), + tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), + NSurfIndexing : length(tempBasis), + numNodesIndexing : length(tempBasis) + ) else ( + NSurfIndexing : NSurf, + numNodesIndexing : numNodes + ), + + print("Working on ", funcNm), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), + printf(fh, " // w[NDIM]: cell-center.~%"), + printf(fh, " // dxv[NDIM]: cell length.~%"), + printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), + printf(fh, " // vmap: velocity space mapping.~%"), + printf(fh, " // vmapSq: velocity space mapping squared.~%"), + printf(fh, " // q_,m_: species charge and mass.~%"), + printf(fh, " // dgv: volume DG geometry.~%"), + printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), + printf(fh, " // bmag: magnetic field amplitude.~%"), + printf(fh, " // phi: electrostatic potential.~%"), + printf(fh, " // apar: parallel component of vector potential.~%"), + printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), + printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), + printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), + printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), + printf(fh, "~%"), + + /* Declare cell-center variables and variables multiplying gradients. */ + for d : 1 thru cdim+1 do ( + printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) + ), + printf(fh, "~%"), + rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + + rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), + + /* Axisymmetric basis (independent of y). */ + bmagBasis : getAxisymmetricConfBasis(bC), + + /* Expand input fields for Hamiltonian calculation */ + phi_e : doExpand1(phi,bC), + bmag_e : doExpand1(bmag, bmagBasis), + + /* Velocity mapping fields. */ + [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + + /* Redefine vmap_prime to exploit the relationship between it and vmap. */ + /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ + vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), + + if edge = true then ( + evPoint : 1 + ) else ( + evPoint : -1 + ), + + /* Finally write out the hamiltonian*/ + hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], + if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), + hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), + printf(fh, " double hamil[~a] = {0.}; ~%", numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + hamilCvar : eval_string(sconcat("hamil")), + writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), + printf(fh, "~%"), + flush_output(fh), + hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), + /* Expand projected Hamiltonian on basis. */ + hamil_e : hamilNoZero_c . bP, + /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ + + /* Expand Apar */ + apar_e : doExpand1(apar, bC), + /* I don't know if this is necessary but let's copy the Hamiltonian treatment */ + apar_c : calcInnerProdList(varsP, 1, bP, apar_e), + apar_e : apar_c . bP, + apar_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + apar_nodes[i] : float(evAtNodes(apar_e,surfNodes,surfIntVars)) + ), + /* Compute gradient of Aparallel */ + dA_dx_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ), + + /*fl and fr */ + JfL_e : doExpand1(JfL, bP), + JfR_e : doExpand1(JfR, bP), + JfL_c : calcInnerProdList(varsP, 1, bP, JfL_e), + JfR_c : calcInnerProdList(varsP, 1, bP, JfR_e), + + JfL_e : subst(surfVar=1,JfL_e), + JfR_e : subst(surfVar=-1,JfR_e), + + JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), + JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), + + vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), + + vpardim : pDim-1, + if vdim = 1 then ( vpardim : pDim ), + dH_dz_nodes : makelist(0, i, 1, pDim), + for i : 1 thru vpardim do ( + if i = vpardim then ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars)), + dH_dz_nodes[i] : subst(surfVar=evPoint, dH_dz_nodes[i]) + ) + else ( + dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ) + ), + + /* Now calculate apha at all quadrature nodes */ + /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ + printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), + printf(fh, " double cfl = 0.0; ~%"), + printf(fh, " double bmag_quad = 0.0; ~%"), + printf(fh, " double B3_quad = 0.0; ~%"), + printf(fh, " double Jc_quad = 0.0; ~%"), + printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), + printf(fh, " double m_bmag_inv = 0.0; ~%"), + printf(fh, " double mvpar_over_q = 0.0; ~%"), + + printf(fh, " double alpha_quad = 0.0; ~%"), + printf(fh, " double JfL_quad = 0.0; ~%"), + printf(fh, " double JfR_quad = 0.0; ~%"), + printf(fh, " double Jfavg_quad = 0.0; ~%"), + printf(fh, " double Jfjump_quad = 0.0; ~%"), + printf(fh, " double g_13 = 0.0; ~%"), + printf(fh, " double g_23 = 0.0; ~%"), + printf(fh, " double g_33 = 0.0; ~%"), + printf(fh, " double mag_e_3 = 0.0; ~%"), + printf(fh, "~%"), + + for i : 1 thru numConfigNodes do ( + printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i-1), + printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i-1), + printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i-1), + printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i-1), + printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i-1), + printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i-1), + + printf(fh, " m_bmag_inv = 1.0/(m_*bmag_quad); ~%"), + /* + We develop the component grad(Apar) x b as + e^m . grad(Apar) x b = e^m x grad(Apar) . b = e^m x e^i dApar/dx^i . e_3/|e_3| + which gives + coeff * (g_33 dApar/dx2 - g_23 dApar/dx3) for m=1 + coeff * (g_13 dApar/dx3 - g_33 dApar/dx1) for m=2 + coeff * (g_23 dApar/dx1 - g_13 dApar/dx2) for m=3 + with + coeff = Jc/sqrt(g_33) + */ + printf(fh, " g_13 = gkdgv[~a].g_13; ~%", i-1), + printf(fh, " g_23 = gkdgv[~a].g_23; ~%", i-1), + printf(fh, " g_33 = gkdgv[~a].g_33; ~%", i-1), + printf(fh, " mag_e_3 = gkdgv[~a].mag_e_3; ~%", i-1), + + for j : 1 thru numVelNodes do ( + j0index : j-1+(i-1)*numVelNodes, + j1index : j+(i-1)*numVelNodes, + printf(fh, "~%"), + /* printf(fh, " mvpar_over_q = (~a)/q_; ~%", dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), */ + + if no_by = true then ( + /* Start ES term */ + printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ;~%", dH_dz_nodes[cdim][j1index]) + ), + if no_by = false then ( + /* Start ES term */ + printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ", dH_dz_nodes[cdim][j1index]), + if cdim = 3 then ( + /* Finish ES term */ + for k : 1 thru cdim do ( + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[k][j1index], k-1, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) + ), + printf(fh, ";~%"), + if em = true then ( + /* EM term curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + for k : 1 thru cdim do ( + /* Apar * curl(b) */ + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[k][j1index], k-1) + ), + /* grad(Apar) x b */ + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + ) + ), + if cdim = 2 then ( + /* Finish ES term */ + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 0, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), + printf(fh, ";~%"), + if em = true then ( + /* EM term curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + /* Apar * curl(b) */ + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 0), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[2][j1index], 2), + /* grad(Apar) x b */ + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][j1index]) + ) + ), + if cdim = 1 then ( + /* Finish ES term */ + printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), + printf(fh, ";~%"), + if em = true then ( + /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + /* Apar * curl(b) */ + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 2) + /* grad(Apar) x b */ + /* none */ + ) + ) + ), + + printf(fh, "~%"), + printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), + printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), + printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), + printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), + printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) + ), + printf(fh, "~%") + ), + + printf(fh, "~%"), + /*Calculate the cfl*/ + pOrderCFL : polyOrder, + if polyOrder=1 then ( pOrderCFL : 2 ), + printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), + vprimeStr : "/vmap_prime_min", + printf(fh, "~%"), + printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), + + printf(fh, "~%"), + flush_output(fh), + printf(fh, "} ~%") + +)$ + + AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, edge) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, @@ -426,6 +727,10 @@ AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, printf(fh, " double JfR_quad = 0.0; ~%"), printf(fh, " double Jfavg_quad = 0.0; ~%"), printf(fh, " double Jfjump_quad = 0.0; ~%"), + printf(fh, " double g_13 = 0.0; ~%"), + printf(fh, " double g_23 = 0.0; ~%"), + printf(fh, " double g_33 = 0.0; ~%"), + printf(fh, " double mag_e_3 = 0.0; ~%"), printf(fh, "~%"), for i : 1 thru numConfigNodes do ( @@ -447,12 +752,11 @@ AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, with coeff = Jc/sqrt(g_33) */ - printf(fh, " g_13 = 1.0; ~%"), /* need to pass them */ - printf(fh, " g_23 = 1.0; ~%"), - printf(fh, " g_33 = 1.0; ~%"), - printf(fh, " mag_e_3 = 1.0; ~%"), /* I need |e_3|=sqrt(g_33) here */ + printf(fh, " g_13 = gkdgv[~a].g_13; ~%", i-1), + printf(fh, " g_23 = gkdgv[~a].g_23; ~%", i-1), + printf(fh, " g_33 = gkdgv[~a].g_33; ~%", i-1), + printf(fh, " mag_e_3 = gkdgv[~a].mag_e_3; ~%", i-1), - printf(fh, "~%"), for j : 1 thru numVelNodes do ( j0index : j-1+(i-1)*numVelNodes, j1index : j+(i-1)*numVelNodes, @@ -464,26 +768,26 @@ AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ for k : 1 thru cdim do ( /* Apar * curl(b) */ - printf(fh, "alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[k][j1index], k-1) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[k][j1index], k-1) ), /* grad(Apar) x b */ - printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]), - printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]), - printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) ), if cdim = 2 then ( /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ /* Apar * curl(b) */ - printf(fh, "alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 0), - printf(fh, "alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[2][j1index], 2), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 0), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[2][j1index], 2), /* grad(Apar) x b */ - printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index]), - printf(fh, "alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][j1index]) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][j1index]) ), if cdim = 1 then ( /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ /* Apar * curl(b) */ - printf(fh, "alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 2) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 2) /* grad(Apar) x b */ /* none */ ), @@ -565,7 +869,7 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde const double *vmap_prime_l, const double *vmap_prime_r, const double *vmap, const double *vmapSq, const double q_, const double m_, const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *apardot, const double *JfL, const double *JfR, + const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), printf(fh, " // w[NDIM]: cell-center.~%"), printf(fh, " // dxv[NDIM]: cell length.~%"), @@ -577,7 +881,7 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), printf(fh, " // bmag: magnetic field amplitude.~%"), printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // apardot: time derivative of the parallel component of vector potential.~%"), + printf(fh, " // apar: parallel component of vector potential (here it will be apardot).~%"), printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), @@ -596,7 +900,7 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde flush_output(fh), /* Expand Apardot */ - apardot_e : doExpand1(apardot, bC), + apardot_e : doExpand1(apar, bC), /* I don't know if this is necessary but let's copy the Hamiltonian treatment */ apardot_c : calcInnerProdList(varsP, 1, bP, apardot_e), apardot_e : apardot_c . bP, diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index a01ef010..f37bc501 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -130,7 +130,7 @@ printPrototypes() := block([], const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *JfL, const double *JfR, + const double *phi, const double *apar, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apar_~aedge_surf~a_~ax~av_~a_p~a( @@ -139,7 +139,7 @@ printPrototypes() := block([], const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *JfL, const double *JfR, + const double *phi, const double *apar, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apardot_~asurf~a_~ax~av_~a_p~a( @@ -148,7 +148,7 @@ printPrototypes() := block([], const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *JfL, const double *JfR, + const double *phi, const double *apardot, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apardot_~aedge_surf~a_~ax~av_~a_p~a( @@ -157,7 +157,7 @@ printPrototypes() := block([], const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *JfL, const double *JfR, + const double *phi, const double *apardot, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) ) ), @@ -171,7 +171,7 @@ printPrototypes() := block([], ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a - const double *bmag, const double *phi, const double *JfL, const double *JfR, + const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf); ~%", dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apardot_surf~a_~ax~av_~a_p~a( @@ -179,7 +179,7 @@ printPrototypes() := block([], ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a - const double *bmag, const double *phi, const double *JfL, const double *JfR, + const double *bmag, const double *phi, const double *apardot, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf); ~%", dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) ), diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 4adad02e..63822105 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -45,6 +45,8 @@ byStr : ["", "no_by_"]$ mb_bcOpt : [[false,true],[false,true],[false,true]]$ mb_bcStr : ["", "multib_boundary_"]$ +em : false$ /* Include EM terms if true */ + /* Generate kernels of selected types. */ for bInd : 1 thru length(bName) do ( for c : minCdim[bInd] thru maxCdim[bInd] do ( @@ -71,9 +73,9 @@ for bInd : 1 thru length(bName) do ( fh : openw(fname), printf(fh, "#include ~%"), - + em : true, funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxConfESKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false, mb_bound), + buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, mb_bound), close(fh), fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), @@ -81,33 +83,33 @@ for bInd : 1 thru length(bName) do ( fh : openw(fname), printf(fh, "#include ~%"), - + em : true, funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxConfESKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, true, mb_bound), - close(fh), + buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, true, mb_bound), + close(fh) /* EM terms */ - if (no_by = false) then ( - fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + /* if (no_by = false) then ( + fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_",mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), - funcName : sconcat("gk_collisionless_flux_add_apar_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - AddAparGKEMFluxConfKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false, mb_bound), + funcName : sconcat("gk_collisionless_flux_add_apar_",mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + AddAparGKEMFluxConfKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, false, mb_bound), close(fh), - fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), + fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_",mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux edge surf~a ~a file: ~a",clabels[dir],mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), - funcName : sconcat("gk_collisionless_flux_add_apar_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - AddAparGKEMFluxConfKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, true, mb_bound), + funcName : sconcat("gk_collisionless_flux_add_apar_",mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + AddAparGKEMFluxConfKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, true, mb_bound), close(fh) - ) + ) */ ) ), @@ -117,14 +119,14 @@ for bInd : 1 thru length(bName) do ( fh : openw(fname), printf(fh, "#include ~%"), - + em : true, funcName : sconcat("gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxVparESKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, false), + buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false), close(fh), if (no_by = false) then ( /* EM terms */ - fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + /* fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar file: ~a",fname)), fh : openw(fname), @@ -132,7 +134,7 @@ for bInd : 1 thru length(bName) do ( funcName : sconcat("gk_collisionless_flux_add_apar_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), AddAparGKEMFluxVparKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, false), - close(fh), + close(fh), */ fname : sconcat("~/max-out/gk_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar file: ~a",fname)), From 6ecbf540120aea36725e1ead4895b9682559a7d5 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 6 Nov 2025 15:16:25 -0500 Subject: [PATCH 08/66] clean and make the script write es and em kernels for fluxes --- .../ms-gk_collisionless_flux-header.mac | 200 ++++++++---------- .../ms-gk_collisionless_flux.mac | 114 ++++++---- 2 files changed, 157 insertions(+), 157 deletions(-) diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index f37bc501..33389307 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -43,69 +43,76 @@ byStr : ["", "no_by_"]$ mb_bcOpt : [[false,true],[false,true],[false,true]]$ mb_bcStr : ["", "multib_boundary_"]$ +emStr : ["es", "em"]$ + printPrototypes() := block([], - for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ - for polyOrder : 1 thru maxPolyOrderB do ( + for emI : 1 thru 2 do ( + em_label : emStr[emI], + + for bInd : 1 thru length(bName) do ( + + for c : minCdim[bInd] thru maxCdim[bInd] do ( + + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ + for polyOrder : 1 thru maxPolyOrderB do ( + + for byI : 1 thru length(byOpt[c]) do ( + no_by : byOpt[c][byI], + no_byStr : byStr[byI], + + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], + + for surfDir : 1 thru c do ( + dirlabel : varsC[surfDir], + extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", + vprimeargs : "", + + printf(fh, "GKYL_CU_DH double gk_~a_collisionless_flux_~a~asurf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + + printf(fh, "GKYL_CU_DH double gk_~a_collisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + ) + ), + + dirlabel : varsV[1], + extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", + vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", + printf(fh, "GKYL_CU_DH double gk_~a_collisionless_flux_~asurf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - for byI : 1 thru length(byOpt[c]) do ( - no_by : byOpt[c][byI], - no_byStr : byStr[byI], - - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], - - for surfDir : 1 thru c do ( - dirlabel : varsC[surfDir], - extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", - vprimeargs : "", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) - ) - ), - - dirlabel : varsV[1], - extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", - vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", no_byStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) - ), - - printf(fh, "~%") - ) - ) + printf(fh, "~%") + ) + ) + ) + ) ) ), - /* EM terms */ + /* EM add apardot vpar surface term */ for bInd : 1 thru length(bName) do ( for c : minCdim[bInd] thru maxCdim[bInd] do ( for gkV : 1 thru length(gkVdims[c]) do ( @@ -115,66 +122,11 @@ printPrototypes() := block([], if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ for polyOrder : 1 thru maxPolyOrderB do ( - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], - - for surfDir : 1 thru c do ( - dirlabel : varsC[surfDir], - extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", - vprimeargs : "", - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apar_~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apar_~aedge_surf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apardot_~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apardot, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apardot_~aedge_surf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apardot, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) - ) - ), - dirlabel : varsV[1], extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apar_surf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - - printf(fh, "GKYL_CU_DH double gk_collisionless_flux_add_apardot_surf~a_~ax~av_~a_p~a( + printf(fh, "GKYL_CU_DH double gk_em_collisionless_flux_add_apardot_surf~a_~ax~av_~a_p~a( const double *w, const double *dxv, ~a const double *vmap, const double *vmapSq, const double q_, const double m_, @@ -186,7 +138,25 @@ printPrototypes() := block([], printf(fh, "~%") ) ) - ) + ), + +printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surf_return_zero( + const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, + const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf);~%"), + +printf(fh,"~%"), + +printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surfvpar_return_zero( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf);~%") )$ fh : openw("~/max-out/gkyl_gk_collisionless_flux_kernels.h")$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 63822105..99c027f3 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -68,81 +68,82 @@ for bInd : 1 thru length(bName) do ( /* Surface flux in direction dir in configuration space.*/ for dir : 1 thru c do ( - fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + /* ES kernels */ + fname : sconcat("~/max-out/gk_es_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + em : false, + funcName : sconcat("gk_es_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, mb_bound), + close(fh), + + fname : sconcat("~/max-out/gk_es_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + em : false, + funcName : sconcat("gk_es_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, true, mb_bound), + close(fh), + + /* EM kernels */ + fname : sconcat("~/max-out/gk_em_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), em : true, - funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + funcName : sconcat("gk_em_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, mb_bound), close(fh), - fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat("~/max-out/gk_em_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), em : true, - funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + funcName : sconcat("gk_em_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, true, mb_bound), close(fh) - - /* EM terms */ - /* if (no_by = false) then ( - fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_",mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_collisionless_flux_add_apar_",mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - AddAparGKEMFluxConfKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, false, mb_bound), - close(fh), - - fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_",mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux edge surf~a ~a file: ~a",clabels[dir],mb_boundStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_collisionless_flux_add_apar_",mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - AddAparGKEMFluxConfKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, true, mb_bound), - close(fh) - ) */ ) ), /* Surface flux in vparallel direction.*/ - fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + /* ES */ + fname : sconcat("~/max-out/gk_es_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + em : false, + funcName : sconcat("gk_es_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false), + close(fh), + + /* EM */ + fname : sconcat("~/max-out/gk_em_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), em : true, - funcName : sconcat("gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + funcName : sconcat("gk_em_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false), close(fh), if (no_by = false) then ( - /* EM terms */ - /* fname : sconcat("~/max-out/gk_collisionless_flux_add_apar_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar file: ~a",fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_collisionless_flux_add_apar_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - AddAparGKEMFluxVparKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, false), - close(fh), */ - - fname : sconcat("~/max-out/gk_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + /* Add apardot EM terms */ + fname : sconcat("~/max-out/gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar file: ~a",fname)), fh : openw(fname), printf(fh, "#include ~%"), - funcName : sconcat("gk_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + funcName : sconcat("gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), AddApardotGKEMFluxVparKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, false), close(fh) ) @@ -151,3 +152,32 @@ for bInd : 1 thru length(bName) do ( ) ) )$ +fname : "~/max-out/gk_collisionless_flux_surf_return_zero.h"$ +fh : openw(fname)$ +printf(fh, "#include ~%")$ */ +printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surf_return_zero( + const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, + /* const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) + { + return 0.0; + }~%")$ +close(fh)$ + +fname : "~/max-out/gk_collisionless_flux_surfvpar_return_zero.h"$ +fh : openw(fname)$ +printf(fh, "#include ~%")$ +printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surfvpar_return_zero( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf) + { + return 0.0; + }~%")$ +close(fh)$ From eff6a16d908d536738df5b6ff82a8c0b2bc2afb1 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 6 Nov 2025 19:35:29 -0500 Subject: [PATCH 09/66] =?UTF-8?q?Ensure=20that=20all=20local=20variables?= =?UTF-8?q?=20are=20put=20in=20the=20bracket=20scope=20of=20the=20block=20?= =?UTF-8?q?instance.=20This=20did=20not=20change=20a=20iota=20of=20the=20o?= =?UTF-8?q?utput=20kernels=20but=20better=20be=20safe=20than=20sorry.=20Th?= =?UTF-8?q?ere=20is=20an=20error=20in=20the=20addapardot=20volume=20kernel?= =?UTF-8?q?=20I=20think=20because=20my=20first=20tests=20explode=20when=20?= =?UTF-8?q?I=20include=20it,=20will=20work=20on=20that=20tomorrow=20?= =?UTF-8?q?=F0=9F=A4=93=20have=20a=20good=20night=20folks=20=F0=9F=98=98?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- maxima/g0/gk_collisionless/dg_gk-surf.mac | 5 +++-- maxima/g0/gk_collisionless/dg_gk-vol.mac | 15 ++++++++++++--- .../gk_collisionless_flux-surf-conf.mac | 9 ++++++--- .../gk_collisionless_flux-surf-vpar.mac | 9 +++++---- 4 files changed, 26 insertions(+), 12 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-surf.mac b/maxima/g0/gk_collisionless/dg_gk-surf.mac index 77901135..d8d97ea6 100644 --- a/maxima/g0/gk_collisionless/dg_gk-surf.mac +++ b/maxima/g0/gk_collisionless/dg_gk-surf.mac @@ -26,7 +26,7 @@ calcGKSurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, vars BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, hamil_e,alphaSurfL_e,alphaSurfR_e, fl_e,fc_e,fr_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL, - fnodal_l_e, fnodal_r_e, fmodproj_e], + fnodal_l_e,fnodal_r_e,fmodproj_e,numC,vmap_prime_fac_l,vmap_prime_fac_c,vmap_prime_fac_r,vmap_prime_e,basisNodal,i], kill(varsC,varsP,bC,bP), pDim : cdim+vdim, @@ -143,7 +143,8 @@ calcGKBoundarySurfUpdateInDir(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrd rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e, BstarXdBmag_e,BstarYdBmag_e,BstarZdBmag_e,BstardBmag_e, hamil_e,alphaUpL_e,alphaSurfL_e,alphaUpSurfL_e,alphaUpR_e,alphaSurfR_e,alphaUpSurfR_e, - fEdge_e,fSkin_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL], + fEdge_e,fSkin_e,fUpL_e,fUpR_e,GhatL_c,GhatR_c,GhatL_e,GhatR_e,incrL_c,incrR_c,pOrderCFL, + numC,vmap_prime_fac_edge,vmap_prime_fac_skin,vmap_prime_e,basisNodal,i,fnodal_l_e,fnodal_r_e,fmodproj_e], kill(varsC,varsP,bC,bP), pDim : cdim+vdim, diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 62df8500..22d1a5f5 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -14,7 +14,11 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e], + dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, + dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, + replaceList,dvparSimp,phi_e,bmag_e,dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e, + rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,dualcurlbhatoverB_list,bioverJB_list, + vmapSq_e,vmap_prime_e,hamilCvar,hamilNoZero_c,hamil_c,vpardim,i,k,curvdriftdir,clst], kill(varsC,varsP,bC,bP), pDim : cdim+vdim, @@ -262,7 +266,10 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e], + dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, + replaceList,dvparSimp,phi_e,bmag_e,rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,bioverJB_list, + vmapSq_e,vmap_prime_e,hamil_c,hamilCvar,hamilNoZero_c,vpardim,i,k,Apar_e, + dBperpoverB_x,dBperpoverB_y,dBperpoverB_z,dBperpoverB_list,curvdriftdir,clst], kill(varsC,varsP,bC,bP), pDim : cdim+vdim, @@ -485,7 +492,9 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e], + dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, + alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, + vmapSq_e,vmap_prime_e,apardot_e,clst], kill(varsC,varsP,bC,bP), pDim : cdim+vdim, diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index f336e4ae..c00be4c2 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -12,7 +12,8 @@ buildGKFluxConfESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,bmagSurf_e,vmap_e,vmapSq_e, vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL + dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL, + surfIntVarsC,bSurfC,hamilCvar ], kill(varsC,varsP,bC,bP), @@ -306,7 +307,8 @@ buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no bmagSurf_e,vmap_e,vmapSq_e, vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL + dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL, + surfIntVarsC,bSurfC,hamilCvar,aparCvar,apar_nodes,dA_dx_nodes ], kill(varsC,varsP,bC,bP), @@ -635,7 +637,8 @@ AddAparGKEMFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,bmagSurf_e,vmap_e,vmapSq_e, vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL + dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL, + surfIntVarsC,bSurfC,hamilCvar,aparCvar,apar_e,apar_nodes,dA_dx_nodes,apar_c ], kill(varsC,varsP,bC,bP), diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 01969b2f..55ee4cdb 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -11,7 +11,7 @@ buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,NSurf,numNodes,k ], kill(varsC,varsP,bC,bP), @@ -248,7 +248,7 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,NSurf,numNodes,apar_e,apar_c,apar_nodes,dA_dx_nodes,k ], kill(varsC,varsP,bC,bP), @@ -549,7 +549,7 @@ AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_c,apar_nodes,dA_dx_nodes,k ], kill(varsC,varsP,bC,bP), @@ -822,7 +822,8 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde [pDim,varsC,bC,varsP,bP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfNodes,configNodes,numSurfNodes,numConfigNodes, numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdSurfVar2, - JfL_e,JfR_e,JfL_nodes,JfR_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr + JfL_e,JfR_e,JfL_nodes,JfR_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr, + numC,numP,vSub,NSurf,numNodes,apardot_e,apardot_c,apardot_nodes ], kill(varsC,varsP,bC,bP), From ee37a0c75e6374e785e7ac9e123d5d302112681d Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 7 Nov 2025 11:23:36 -0500 Subject: [PATCH 10/66] fix an error were apardot was expanded on bP instead of bC --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 22d1a5f5..7c471e28 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -520,7 +520,7 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no Jf_e : doExpand1(fin,bP), /* Expand Apardot */ - apardot_e : doExpand1(apardot,bP), + apardot_e : doExpand1(apardot,bC), /* Note: only a vpar contribution. */ dir : cdim+1, From ef2671c120068b5d655fe00e7ad1563a179d3c90 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 7 Nov 2025 11:43:49 -0500 Subject: [PATCH 11/66] Fix the apardot volume contribution, a 1/vmap was missing. --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 7c471e28..6a4efa89 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -505,7 +505,7 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no varLabel : makelist(string(varsP[d]),d,1,pDim), print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a(const double q_, const double m_, const double *apardot, + printf(fh, "GKYL_CU_DH double ~a(const double *vmap, const double q_, const double m_, const double *apardot, const double *fin, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), printf(fh, " // q_,m_: species charge and mass.~%"), printf(fh, " // apardot: time derivative of parallel component of magnetic vector potential.~%"), @@ -513,8 +513,13 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no printf(fh, " // out: output increment.~%"), printf(fh, "~%"), + rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + + /* Velocity mapping fields. */ [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), + vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), /*Expand Jf*/ Jf_e : doExpand1(fin,bP), @@ -528,6 +533,14 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no alpha_e : -q_/m_ * apardot_e, + vpardim : pDim-1, + if dir < vpardim then ( + alpha_e : alpha_e*rdx2vec[dir] + ) + else if dir = vpardim then ( + alpha_e : alpha_e/vmap_prime_e[1] + ), + /* Project alpha on basis and write to array. */ printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), From 7faac8e366089b13e3c88ecd2e497c7ead285a5c Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 7 Nov 2025 11:44:26 -0500 Subject: [PATCH 12/66] remove dot operator with doExpand and fix a wrong expansion of Apar and Apardot on bP instead of bC. --- .../gk_collisionless_flux-surf-vpar.mac | 21 ++++++------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 55ee4cdb..75238cca 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -127,7 +127,7 @@ buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no flush_output(fh), hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bP, + hamil_e : doExpand(hamilNoZero_c,bP), /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ /*fl and fr */ @@ -248,7 +248,7 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,NSurf,numNodes,apar_e,apar_c,apar_nodes,dA_dx_nodes,k + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,NSurf,numNodes,apar_e,apar_nodes,dA_dx_nodes,k ], kill(varsC,varsP,bC,bP), @@ -365,14 +365,11 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no flush_output(fh), hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bP, + hamil_e : doExpand(hamilNoZero_c,bP), /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ /* Expand Apar */ apar_e : doExpand1(apar, bC), - /* I don't know if this is necessary but let's copy the Hamiltonian treatment */ - apar_c : calcInnerProdList(varsP, 1, bP, apar_e), - apar_e : apar_c . bP, apar_nodes : makelist(0, i, 1, cdim), for i : 1 thru cdim do ( apar_nodes[i] : float(evAtNodes(apar_e,surfNodes,surfIntVars)) @@ -549,7 +546,7 @@ AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_c,apar_nodes,dA_dx_nodes,k + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_nodes,dA_dx_nodes,k ], kill(varsC,varsP,bC,bP), @@ -670,10 +667,7 @@ AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ /* Expand Apar */ - apar_e : doExpand1(apar, bC), - /* I don't know if this is necessary but let's copy the Hamiltonian treatment */ - apar_c : calcInnerProdList(varsP, 1, bP, apar_e), - apar_e : apar_c . bP, + apar_e : doExpand1(apar, bC), apar_nodes : makelist(0, i, 1, cdim), for i : 1 thru cdim do ( apar_nodes[i] : float(evAtNodes(apar_e,surfNodes,surfIntVars)) @@ -823,7 +817,7 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde surfNodes,configNodes,numSurfNodes,numConfigNodes, numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdSurfVar2, JfL_e,JfR_e,JfL_nodes,JfR_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr, - numC,numP,vSub,NSurf,numNodes,apardot_e,apardot_c,apardot_nodes + numC,numP,vSub,NSurf,numNodes,apardot_e,apardot_nodes ], kill(varsC,varsP,bC,bP), @@ -902,9 +896,6 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde /* Expand Apardot */ apardot_e : doExpand1(apar, bC), - /* I don't know if this is necessary but let's copy the Hamiltonian treatment */ - apardot_c : calcInnerProdList(varsP, 1, bP, apardot_e), - apardot_e : apardot_c . bP, apardot_nodes : float(evAtNodes(apardot_e,surfNodes,surfIntVars)), /*fl and fr */ From 3ed347a2771e18eda5a4075d9f2800eb5d8a8798 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 7 Nov 2025 11:44:45 -0500 Subject: [PATCH 13/66] update kernel signature of add_aprdot to include vmap. --- maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac index a624bdde..f579b863 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac @@ -94,15 +94,15 @@ printPrototypes() := block([], v : gkVdims[c][gkV], maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ + maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ for polyOrder : 1 thru maxPolyOrderB do ( printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_apar_vol_~ax~av_~a_p~a(const double *w, const double *dxv, const double *vmap, const double *vmapSq, const double q_, const double m_, const double *bmag, const double *jacobtot_inv, const double *b_i, const double *phi, const double *apar, const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), - printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_apardot_vol_~ax~av_~a_p~a(const double q_, const double m_, - const double *apardot, const double *fin, double* GKYL_RESTRICT out) ; ~%", c, v, bName[bInd], polyOrder), + printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_apardot_vol_~ax~av_~a_p~a(const double *vmap, const double q_, const double m_, + const double *apardot, const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), printf(fh, "~%") ) ) @@ -110,7 +110,7 @@ printPrototypes() := block([], ) )$ -fh : openw("~/max-out/gkyl_dg_gyrokinetic_kernels.h")$ +fh : openw("/Users/ahoffman/gkeyll_dev/gkeyll/gyrokinetic/ker/dg_gyrokinetic/gkyl_dg_gyrokinetic_kernels.h")$ printf(fh, "#pragma once~%")$ printf(fh, "~%")$ printf(fh, "#include ~%")$ From 99d2daf0a99e023b5cb3a227020f837d121d6d5f Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 11 Nov 2025 15:45:21 -0500 Subject: [PATCH 14/66] correct a 1/J factor and define the apar and apardot quantities in conf space. --- .../gk_collisionless_flux-surf-vpar.mac | 87 ++++++++++--------- 1 file changed, 44 insertions(+), 43 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 75238cca..eff9836e 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -370,14 +370,11 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no /* Expand Apar */ apar_e : doExpand1(apar, bC), - apar_nodes : makelist(0, i, 1, cdim), - for i : 1 thru cdim do ( - apar_nodes[i] : float(evAtNodes(apar_e,surfNodes,surfIntVars)) - ), + apar_nodes : float(evAtNodes(apar_e,configNodes,surf_cvars)), /* Compute gradient of Aparallel */ dA_dx_nodes : makelist(0, i, 1, cdim), for i : 1 thru cdim do ( - dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsC[i]),configNodes,surf_cvars)) ), /*fl and fr */ @@ -430,12 +427,15 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, "~%"), for i : 1 thru numConfigNodes do ( - printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i-1), - printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i-1), - printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i-1), - printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i-1), + i0index : i-1, + i1index : i, + printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i0index), + printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i0index), + printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i0index), + printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i0index), + printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i0index), + printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i0index), + printf(fh, " m_bmag_inv = 1.0/(m_*bmag_quad); ~%"), /* @@ -476,12 +476,12 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no /* EM term curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ for k : 1 thru cdim do ( /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[k][j1index], k-1) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[i1index], k-1) ), /* grad(Apar) x b */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][i1index], dA_dx_nodes[3][i1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][i1index], dA_dx_nodes[1][i1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][i1index], dA_dx_nodes[2][i1index]) ) ), if cdim = 2 then ( @@ -492,11 +492,11 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no if em = true then ( /* EM term curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 0), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[2][j1index], 2), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 0), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[i1index], 2), /* grad(Apar) x b */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][j1index]) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][i1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][i1index]) ) ), if cdim = 1 then ( @@ -506,7 +506,7 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no if em = true then ( /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 2) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 2) /* grad(Apar) x b */ /* none */ ) @@ -668,14 +668,11 @@ AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, /* Expand Apar */ apar_e : doExpand1(apar, bC), - apar_nodes : makelist(0, i, 1, cdim), - for i : 1 thru cdim do ( - apar_nodes[i] : float(evAtNodes(apar_e,surfNodes,surfIntVars)) - ), + apar_nodes : float(evAtNodes(apar_e,configNodes,surf_cvars)), /* Compute gradient of Aparallel */ dA_dx_nodes : makelist(0, i, 1, cdim), for i : 1 thru cdim do ( - dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsC[i]),configNodes,surf_cvars)) ), /*fl and fr */ @@ -728,12 +725,14 @@ AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, printf(fh, "~%"), for i : 1 thru numConfigNodes do ( - printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i-1), - printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i-1), - printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i-1), - printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i-1), + i0index : i-1, + i1index : i, + printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i0index), + printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i0index), + printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i0index), + printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i0index), + printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i0index), + printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i0index), printf(fh, " m_bmag_inv = 1.0/(m_*bmag_quad); ~%"), /* @@ -759,29 +758,29 @@ AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, printf(fh, " alpha_quad = 0.0; ~%"), if cdim = 3 then ( - /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ for k : 1 thru cdim do ( /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[k][j1index], k-1) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[i1index], k-1) ), /* grad(Apar) x b */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][i1index], dA_dx_nodes[3][i1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][i1index], dA_dx_nodes[1][i1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][i1index], dA_dx_nodes[2][i1index]) ), if cdim = 2 then ( /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 0), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[2][j1index], 2), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 0), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[i1index], 2), /* grad(Apar) x b */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][j1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * Jc_quad/mag_e_3 * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][j1index]) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][i1index]), + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][i1index]) ), if cdim = 1 then ( /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[1][j1index], 2) + printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 2) /* grad(Apar) x b */ /* none */ ), @@ -896,7 +895,7 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde /* Expand Apardot */ apardot_e : doExpand1(apar, bC), - apardot_nodes : float(evAtNodes(apardot_e,surfNodes,surfIntVars)), + apardot_nodes : float(evAtNodes(apardot_e,configNodes,surf_cvars)), /*fl and fr */ JfL_e : doExpand1(JfL, bP), @@ -920,6 +919,8 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde printf(fh, "~%"), for i : 1 thru numConfigNodes do ( + i0index : i-1, + i1index : i, printf(fh, "~%"), for j : 1 thru numVelNodes do ( j0index : j-1+(i-1)*numVelNodes, @@ -927,7 +928,7 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde printf(fh, "~%"), /* Compute the contribution of Apardot */ - printf(fh, " alpha_quad = -q_/m_*(~a); ~%", apardot_nodes[j1index]), + printf(fh, " alpha_quad = -q_/m_*(~a); ~%", apardot_nodes[i1index]), printf(fh, "~%"), printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), From 5a223333197fccdf11f40fdd01d06860f5ab91b5 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Wed, 3 Dec 2025 13:51:33 -0500 Subject: [PATCH 15/66] clean unused routines --- .../gk_collisionless_flux-surf-conf.mac | 297 +----------------- .../gk_collisionless_flux-surf-vpar.mac | 272 ---------------- 2 files changed, 1 insertion(+), 568 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index c00be4c2..d1724ee7 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -629,299 +629,4 @@ buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no flush_output(fh), printf(fh, "} ~%") -)$ - -AddAparGKEMFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, edge, mb_bound) := block( - [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, - surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, - numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,bmagSurf_e,vmap_e,vmapSq_e, - vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, - jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL, - surfIntVarsC,bSurfC,hamilCvar,aparCvar,apar_e,apar_nodes,dA_dx_nodes,apar_c - ], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - surfIntVarsC : delete(surfVar,varsC), - bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - nodeVars : surfIntVars, - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - nodeVars : surfIntVars, - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) - ), - if cdim = 1 then ( - surfConfigNodes : [1] - ) - else ( - surfConfigNodes : gaussOrd(polyOrder+1, cdim-1) - ), - numSurfNodes : length(surfNodes), - numSurfConfigNodes : length(surfConfigNodes), - numVelNodes : numSurfNodes/numSurfConfigNodes, - numMuNodes : 1, - if vdim > 1 then ( numMuNodes : 2), - numVparNodes : numVelNodes/numMuNodes, - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, - const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // dgs: surface DG geometry.~%"), - printf(fh, " // gkdgs: gyrokinetic surface DG geometry.~%"), - printf(fh, " // bmag: bmag represented on the surface.~%"), - printf(fh, " // jacobgeo_rat_surfL: Ratio of surface conf-space Jacobians in left cell.~%"), - printf(fh, " // jacobgeo_rat_surfR: Ratio of surface conf-space Jacobians in right cell.~%"), - printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), - printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), - printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), - printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), - printf(fh, "~%"), - - /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru cdim+1 do ( - printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) - ), - printf(fh, "~%"), - rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - /* Axisymmetric basis (independent of y). */ - bmagBasis : getAxisymmetricConfBasis(bC), - - /* Expand input fields for Hamiltonian calculation */ - phi_e : doExpand1(phi,bC), - bmagSurf_e : doExpand1(bmag, bmagBasis), - - /* Velocity mapping fields. */ - [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), - - /* Redefine vmap_prime to exploit the relationship between it and vmap. */ - /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ - vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), - - if edge = true then ( - evPoint : 1 - ) else ( - evPoint : -1 - ), - - /* Finally write out the hamiltonian*/ - hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], - if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmagSurf_e ), - hamil_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,hamil_e)), - printf(fh, " double hamil[~a] = {0.}; ~%", numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - hamilCvar : eval_string(sconcat("hamil")), - writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), - printf(fh, "~%"), - flush_output(fh), - hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), - /* Expand projected Hamiltonian on basis. */ - hamil_e : doExpand(hamilNoZero_c, bSurf), - - /* fl and fr */ - JfL_e : doExpand1(JfL, bP), - JfR_e : doExpand1(JfR, bP), - JfL_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=1,JfL_e)), - JfR_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=-1,JfR_e)), - JfL_e : JfL_c . bSurf, - JfR_e : JfR_c . bSurf, - - if (mb_bound = true) then ( - /* Rescale ghost cell by ratio of the Jacobians at multiblock boundaries. */ - - if (edge = true) then ( - /* Upper boundary. */ - jacobgeo_rat_surfR_e : doExpand1(jacobgeo_rat_surfR, bSurfC), - - JfR_c : calcInnerProdList(surfIntVars, jacobgeo_rat_surfR_e, bSurf, JfR_e), - printf(fh, " double JRatfR[~a] = {0.}; ~%", length(bSurf)), - writeCExprsNoExpand1(JRatfR, fullratsimp(JfR_c)), - printf(fh, "~%"), - JfR_c : makelistNoZeros1(JfR_c, JRatfR), - JfR_e : doExpand(JfR_c, bSurf) - ) else ( - /* Lower boundary. */ - jacobgeo_rat_surfL_e : doExpand1(jacobgeo_rat_surfL, bSurfC), - - JfL_c : calcInnerProdList(surfIntVars, jacobgeo_rat_surfL_e, bSurf, JfL_e), - printf(fh, " double JRatfL[~a] = {0.}; ~%", length(bSurf)), - writeCExprsNoExpand1(JRatfL, fullratsimp(JfL_c)), - printf(fh, "~%"), - JfL_c : makelistNoZeros1(JfL_c, JRatfL), - JfL_e : doExpand(JfL_c, bSurf) - ) - ), - - JfL_nodes : gcfac(float(expand(evAtNodes(JfL_e,surfNodes,surfIntVars)))), - JfR_nodes : gcfac(float(expand(evAtNodes(JfR_e,surfNodes,surfIntVars)))), - - vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), - - vpardim : pDim-1, - if vdim = 1 then ( vpardim : pDim ), - dH_dz_nodes : makelist(0, i, 1, pDim), - for i : 1 thru vpardim do ( - if i = vpardim then ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars))/vmap_prime_nodes - ) - else ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) - ) - ), - - mvpar_nodes : [], - for i : 1 thru numVparNodes do ( - mvpar_nodes : append(mvpar_nodes, [dH_dz_nodes[vpardim][i]]) - ), - - if surfDir = cdim then( - di3 : true - ) - else ( - di3 : false - ), - - /* Expand Aparallel. */ - apar_e : doExpand1(apar,bC), - apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), - /* printf(fh, " double apar[~a] = {0.}; ~%", numP), */ - aparCvar : eval_string(sconcat("apar")), - apar_c : makelistNoZeros1(apar_c, aparCvar), - /* Expand projected Apar on basis. */ - apar_e : doExpand(apar_c, bSurf), - /* Eval Aparallel at nodes. */ - apar_nodes : float(evAtNodes(apar_e,surfNodes,surfIntVars)), - /* Compute gradient of Aparallel */ - dA_dx_nodes : makelist(0, i, 1, cdim), - for i : 1 thru cdim do ( - dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) - ), - /* It will be used to compute the contribution as curl(Apar * bhat) = nabla Aparallel cross bhat + Aparallel * curl(bhat) */ - - /* Now calculate flux at all quadrature nodes */ - /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ - printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", length(bSurf)*(surfDir-1)), - printf(fh, " double cfl = 0.0; ~%"), - printf(fh, " double bmag_quad = 0.0; ~%"), - printf(fh, " double Jc_quad = 0.0; ~%"), - printf(fh, " double B3_quad = 0.0; ~%"), - printf(fh, " double normcurlbhat_quad = 0.0; ~%"), - printf(fh, " double area_elem_quad = 0.0; ~%"), - printf(fh, " double bhat_quad[3] = {0.0}; ~%"), - - printf(fh, " double alpha_quad = 0.0; ~%"), - printf(fh, " double JfL_quad = 0.0; ~%"), - printf(fh, " double JfR_quad = 0.0; ~%"), - printf(fh, " double Jfavg_quad = 0.0; ~%"), - printf(fh, " double Jfjump_quad = 0.0; ~%"), - - printf(fh, " double mvpar_quad[3] = {0.0}; ~%"), - for i : 1 thru numVparNodes do ( - printf(fh, " mvpar_quad[~a] = ~a; ~%", i-1, mvpar_nodes[i]) - ), - - printf(fh, " double mvparsq_quad[3] = {0.0}; ~%"), - for i : 1 thru numVparNodes do ( - printf(fh, " mvparsq_quad[~a] = mvpar_quad[~a]*mvpar_quad[~a]/m_; ~%", i-1, i-1,i-1) - ), - printf(fh, "~%"), - - for i : 1 thru numSurfConfigNodes do ( - printf(fh, " bmag_quad = gkdgs[~a].bmag; ~%", i-1), - printf(fh, " Jc_quad = gkdgs[~a].Jc; ~%", i-1), - printf(fh, " B3_quad = gkdgs[~a].B3; ~%", i-1), - printf(fh, " normcurlbhat_quad = gkdgs[~a].normcurlbhat; ~%", i-1), - printf(fh, " bhat_quad[0] = gkdgs[~a].bhat.x[0]; ~%", i-1), - printf(fh, " bhat_quad[1] = gkdgs[~a].bhat.x[1]; ~%", i-1), - printf(fh, " bhat_quad[2] = gkdgs[~a].bhat.x[2]; ~%", i-1), - printf(fh, " area_elem_quad = dgs[~a].area_elem; ~%", i-1), - printf(fh, "~%"), - for j : 1 thru numVelNodes do ( - j0index : j-1+(i-1)*numVelNodes, - j1index : j+(i-1)*numVelNodes, - vparindex : mod(j-1, numVparNodes) + 1, - vpar0index : mod(j-1, numVparNodes), - printf(fh, "~%"), - printf(fh, " alpha_quad = 0.0; ~%"), - - if cdim = 1 then ( - /* No contribution */ - printf(fh, " alpha_quad = 0.0; ~%", vpar0index) - ) else ( - /* Aparallel curl b contribution */ - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]) - ), - /* grad(Aparallel) x b contribution*/ - if cdim = 3 then ( - if surfDir = 1 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) - ), - if surfDir = 2 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) - ), - if surfDir = 3 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", vpar0index, dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) - ) - ), - if cdim = 2 then ( - if surfDir = 1 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[2][j1index]) - ), - if surfDir = 2 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[1][j1index]) - ) - ), - - printf(fh, "~%"), - /*printf(fh, " alpha_quad = alpha_quad*area_elem_quad/Jc_quad; ~%"),*/ - printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)); ~%"), - printf(fh, " JfL_quad = ~a; ~%", JfL_nodes[j1index]), - printf(fh, " JfR_quad = ~a; ~%", JfR_nodes[j1index]), - printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0; ~%"), - printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0; ~%"), - printf(fh, " flux_surf_nodal[~a] += alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad; ~%", j0index) - ), - printf(fh, "~%") - ), - - /*Calculate the cfl*/ - pOrderCFL : polyOrder, - printf(fh, "~%"), - printf(fh, " return cfl*~a; ~%", float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), - - printf(fh, "~%"), - flush_output(fh), - printf(fh, "} ~%") - -)$ +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index eff9836e..1382e8ca 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -539,278 +539,6 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no )$ - -AddAparGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, edge) := block( - [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, - surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, - numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, - bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, - hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_nodes,dA_dx_nodes,k - ], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - surfIntVarsC : delete(surfVar,varsC), - bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - nodeVars : surfIntVars, - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - nodeVars : surfIntVars, - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) - ), - configNodes : gaussOrd(polyOrder+1, cdim), - numSurfNodes : length(surfNodes), - numConfigNodes : length(configNodes), - numVelNodes : numSurfNodes/numConfigNodes, - - /* if polyOrder = 1, we need to be careful about - indexing input arrays since the surface hybrid basis has a different size in the - vparallel surfaces and/or we are more directly exploiting the sparsity of - alpha (e.g., in the x and z direction when no toroidal field, by=0) - and thus utilize fewer coefficients to reduce the number of operations */ - if (polyOrder = 1) then ( - tempVars : delete(x,varsP), - tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), - NSurfIndexing : length(tempBasis), - numNodesIndexing : length(tempBasis) - ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes - ), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_r, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // dgv: volume DG geometry.~%"), - printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), - printf(fh, " // bmag: magnetic field amplitude.~%"), - printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // apar: parallel component of vector potential.~%"), - printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), - printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), - printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), - printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), - printf(fh, "~%"), - - /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru cdim+1 do ( - printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) - ), - printf(fh, "~%"), - rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), - - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - /* Axisymmetric basis (independent of y). */ - bmagBasis : getAxisymmetricConfBasis(bC), - - /* Expand input fields for Hamiltonian calculation */ - phi_e : doExpand1(phi,bC), - bmag_e : doExpand1(bmag, bmagBasis), - - /* Velocity mapping fields. */ - [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), - - /* Redefine vmap_prime to exploit the relationship between it and vmap. */ - /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ - vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), - - if edge = true then ( - evPoint : 1 - ) else ( - evPoint : -1 - ), - - /* Finally write out the hamiltonian*/ - hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], - if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), - hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), - printf(fh, " double hamil[~a] = {0.}; ~%", numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - hamilCvar : eval_string(sconcat("hamil")), - writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), - printf(fh, "~%"), - flush_output(fh), - hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), - /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bP, - /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ - - /* Expand Apar */ - apar_e : doExpand1(apar, bC), - apar_nodes : float(evAtNodes(apar_e,configNodes,surf_cvars)), - /* Compute gradient of Aparallel */ - dA_dx_nodes : makelist(0, i, 1, cdim), - for i : 1 thru cdim do ( - dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsC[i]),configNodes,surf_cvars)) - ), - - /*fl and fr */ - JfL_e : doExpand1(JfL, bP), - JfR_e : doExpand1(JfR, bP), - JfL_c : calcInnerProdList(varsP, 1, bP, JfL_e), - JfR_c : calcInnerProdList(varsP, 1, bP, JfR_e), - - JfL_e : subst(surfVar=1,JfL_e), - JfR_e : subst(surfVar=-1,JfR_e), - - JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), - JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), - - vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), - - vpardim : pDim-1, - if vdim = 1 then ( vpardim : pDim ), - dH_dz_nodes : makelist(0, i, 1, pDim), - for i : 1 thru vpardim do ( - if i = vpardim then ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars)), - dH_dz_nodes[i] : subst(surfVar=evPoint, dH_dz_nodes[i]) - ) - else ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) - ) - ), - - /* Now calculate apha at all quadrature nodes */ - /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ - printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), - printf(fh, " double cfl = 0.0; ~%"), - printf(fh, " double bmag_quad = 0.0; ~%"), - printf(fh, " double B3_quad = 0.0; ~%"), - printf(fh, " double Jc_quad = 0.0; ~%"), - printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), - printf(fh, " double m_bmag_inv = 0.0; ~%"), - printf(fh, " double mvpar_over_q = 0.0; ~%"), - - printf(fh, " double alpha_quad = 0.0; ~%"), - printf(fh, " double JfL_quad = 0.0; ~%"), - printf(fh, " double JfR_quad = 0.0; ~%"), - printf(fh, " double Jfavg_quad = 0.0; ~%"), - printf(fh, " double Jfjump_quad = 0.0; ~%"), - printf(fh, " double g_13 = 0.0; ~%"), - printf(fh, " double g_23 = 0.0; ~%"), - printf(fh, " double g_33 = 0.0; ~%"), - printf(fh, " double mag_e_3 = 0.0; ~%"), - printf(fh, "~%"), - - for i : 1 thru numConfigNodes do ( - i0index : i-1, - i1index : i, - printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i0index), - printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i0index), - printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i0index), - printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i0index), - printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i0index), - printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i0index), - - printf(fh, " m_bmag_inv = 1.0/(m_*bmag_quad); ~%"), - /* - We develop the component grad(Apar) x b as - e^m . grad(Apar) x b = e^m x grad(Apar) . b = e^m x e^i dApar/dx^i . e_3/|e_3| - which gives - coeff * (g_33 dApar/dx2 - g_23 dApar/dx3) for m=1 - coeff * (g_13 dApar/dx3 - g_33 dApar/dx1) for m=2 - coeff * (g_23 dApar/dx1 - g_13 dApar/dx2) for m=3 - with - coeff = Jc/sqrt(g_33) - */ - printf(fh, " g_13 = gkdgv[~a].g_13; ~%", i-1), - printf(fh, " g_23 = gkdgv[~a].g_23; ~%", i-1), - printf(fh, " g_33 = gkdgv[~a].g_33; ~%", i-1), - printf(fh, " mag_e_3 = gkdgv[~a].mag_e_3; ~%", i-1), - - for j : 1 thru numVelNodes do ( - j0index : j-1+(i-1)*numVelNodes, - j1index : j+(i-1)*numVelNodes, - printf(fh, "~%"), - printf(fh, " mvpar_over_q = (~a)/q_; ~%", dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), - - printf(fh, " alpha_quad = 0.0; ~%"), - if cdim = 3 then ( - /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ - for k : 1 thru cdim do ( - /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[i1index], k-1) - ), - /* grad(Apar) x b */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][i1index], dA_dx_nodes[3][i1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][i1index], dA_dx_nodes[1][i1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][i1index], dA_dx_nodes[2][i1index]) - ), - if cdim = 2 then ( - /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ - /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 0), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[i1index], 2), - /* grad(Apar) x b */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][i1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][i1index]) - ), - if cdim = 1 then ( - /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ - /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 2) - /* grad(Apar) x b */ - /* none */ - ), - - printf(fh, "~%"), - printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), - printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), - printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), - printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), - printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), - printf(fh, " flux_surf_nodal[~a] += alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) - ), - printf(fh, "~%") - ), - - printf(fh, "~%"), - /*Calculate the cfl*/ - pOrderCFL : polyOrder, - if polyOrder=1 then ( pOrderCFL : 2 ), - printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), - vprimeStr : "/vmap_prime_min", - printf(fh, "~%"), - printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), - - printf(fh, "~%"), - flush_output(fh), - printf(fh, "} ~%") - -)$ - AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, edge) := block( [pDim,varsC,bC,varsP,bP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfNodes,configNodes,numSurfNodes,numConfigNodes, From 9bce6d880554c65ff3ad0a24cbbe403d491b4f5f Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 10 Feb 2026 14:06:04 -0500 Subject: [PATCH 16/66] conserve former naming for electrostatic limit and add 'em_' prefix for electromagnetic routines. --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 18 ++----- .../gk_collisionless_flux-surf-vpar.mac | 50 ++++++++++--------- .../ms-gk_collisionless_flux-header.mac | 50 +++++++++---------- .../ms-gk_collisionless_flux.mac | 43 +++------------- 4 files changed, 63 insertions(+), 98 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 6a4efa89..40ad42d3 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -491,7 +491,7 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, - hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, + hamil_e,pbAuxFlds,alphaSum_e,vd,vpardir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, vmapSq_e,vmap_prime_e,apardot_e,clst], @@ -528,18 +528,10 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no apardot_e : doExpand1(apardot,bC), /* Note: only a vpar contribution. */ - dir : cdim+1, - dirLabel : varLabel[dir], - - alpha_e : -q_/m_ * apardot_e, + vpardir : cdim+1, + dirLabel : varLabel[vpardir], - vpardim : pDim-1, - if dir < vpardim then ( - alpha_e : alpha_e*rdx2vec[dir] - ) - else if dir = vpardim then ( - alpha_e : alpha_e/vmap_prime_e[1] - ), + alpha_e : -q_/m_ * apardot_e /vmap_prime_e[1], /* Project alpha on basis and write to array. */ printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), @@ -556,7 +548,7 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no alphaJf_e : alpha_e*Jf_e, printf(fh, "~%"), - volTerm_c : fullratsimp(calcInnerProdList(varsP, 1, diff(bP,varsP[dir]), alphaJf_e)), + volTerm_c : fullratsimp(calcInnerProdList(varsP, 1, diff(bP,varsP[vpardir]), alphaJf_e)), writeCIncrExprsNoExpand(gcfac(float(expand(volTerm_c)))), flush_output(fh), printf(fh, "~%"), diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 1382e8ca..4f45f71d 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -412,18 +412,19 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, " double B3_quad = 0.0; ~%"), printf(fh, " double Jc_quad = 0.0; ~%"), printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), - printf(fh, " double m_bmag_inv = 0.0; ~%"), - printf(fh, " double mvpar_over_q = 0.0; ~%"), - printf(fh, " double alpha_quad = 0.0; ~%"), printf(fh, " double JfL_quad = 0.0; ~%"), printf(fh, " double JfR_quad = 0.0; ~%"), printf(fh, " double Jfavg_quad = 0.0; ~%"), printf(fh, " double Jfjump_quad = 0.0; ~%"), - printf(fh, " double g_13 = 0.0; ~%"), - printf(fh, " double g_23 = 0.0; ~%"), - printf(fh, " double g_33 = 0.0; ~%"), - printf(fh, " double mag_e_3 = 0.0; ~%"), + if em = true then ( + printf(fh, " double m_bmag_inv = 0.0; ~%"), + printf(fh, " double mvpar_over_q = 0.0; ~%"), + printf(fh, " double g_13 = 0.0; ~%"), + printf(fh, " double g_23 = 0.0; ~%"), + printf(fh, " double g_33 = 0.0; ~%"), + printf(fh, " double mag_e_3 = 0.0; ~%") + ), printf(fh, "~%"), for i : 1 thru numConfigNodes do ( @@ -436,22 +437,23 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i0index), printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i0index), - - printf(fh, " m_bmag_inv = 1.0/(m_*bmag_quad); ~%"), - /* - We develop the component grad(Apar) x b as - e^m . grad(Apar) x b = e^m x grad(Apar) . b = e^m x e^i dApar/dx^i . e_3/|e_3| - which gives - coeff * (g_33 dApar/dx2 - g_23 dApar/dx3) for m=1 - coeff * (g_13 dApar/dx3 - g_33 dApar/dx1) for m=2 - coeff * (g_23 dApar/dx1 - g_13 dApar/dx2) for m=3 - with - coeff = Jc/sqrt(g_33) - */ - printf(fh, " g_13 = gkdgv[~a].g_13; ~%", i-1), - printf(fh, " g_23 = gkdgv[~a].g_23; ~%", i-1), - printf(fh, " g_33 = gkdgv[~a].g_33; ~%", i-1), - printf(fh, " mag_e_3 = gkdgv[~a].mag_e_3; ~%", i-1), + if em = true then ( + printf(fh, " m_bmag_inv = 1.0/(m_*bmag_quad); ~%"), + /* + We develop the component grad(Apar) x b as + e^m . grad(Apar) x b = e^m x grad(Apar) . b = e^m x e^i dApar/dx^i . e_3/|e_3| + which gives + coeff * (g_33 dApar/dx2 - g_23 dApar/dx3) for m=1 + coeff * (g_13 dApar/dx3 - g_33 dApar/dx1) for m=2 + coeff * (g_23 dApar/dx1 - g_13 dApar/dx2) for m=3 + with + coeff = Jc/sqrt(g_33) + */ + printf(fh, " g_13 = gkdgv[~a].g_13; ~%", i-1), + printf(fh, " g_23 = gkdgv[~a].g_23; ~%", i-1), + printf(fh, " g_33 = gkdgv[~a].g_33; ~%", i-1), + printf(fh, " mag_e_3 = gkdgv[~a].mag_e_3; ~%", i-1) + ), for j : 1 thru numVelNodes do ( j0index : j-1+(i-1)*numVelNodes, @@ -504,7 +506,7 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), printf(fh, ";~%"), if em = true then ( - /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ /* Apar * curl(b) */ printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 2) /* grad(Apar) x b */ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index 33389307..ddaec100 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -43,7 +43,7 @@ byStr : ["", "no_by_"]$ mb_bcOpt : [[false,true],[false,true],[false,true]]$ mb_bcStr : ["", "multib_boundary_"]$ -emStr : ["es", "em"]$ +emStr : ["", "em_"]$ printPrototypes() := block([], for emI : 1 thru 2 do ( @@ -73,36 +73,36 @@ printPrototypes() := block([], extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", vprimeargs : "", - printf(fh, "GKYL_CU_DH double gk_~a_collisionless_flux_~a~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), - - printf(fh, "GKYL_CU_DH double gk_~a_collisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + printf(fh, "GKYL_CU_DH double gk_~acollisionless_flux_~a~asurf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + + printf(fh, "GKYL_CU_DH double gk_~acollisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) ) ), dirlabel : varsV[1], extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - printf(fh, "GKYL_CU_DH double gk_~a_collisionless_flux_~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + printf(fh, "GKYL_CU_DH double gk_~acollisionless_flux_~asurf~a_~ax~av_~a_p~a( + const double *w, const double *dxv, + ~a + const double *vmap, const double *vmapSq, const double q_, const double m_, + ~a + const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), printf(fh, "~%") ) diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 99c027f3..2a3bb836 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -69,23 +69,23 @@ for bInd : 1 thru length(bName) do ( for dir : 1 thru c do ( /* ES kernels */ - fname : sconcat("~/max-out/gk_es_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), em : false, - funcName : sconcat("gk_es_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, mb_bound), close(fh), - fname : sconcat("~/max-out/gk_es_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), em : false, - funcName : sconcat("gk_es_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, true, mb_bound), close(fh), @@ -114,13 +114,13 @@ for bInd : 1 thru length(bName) do ( /* Surface flux in vparallel direction.*/ /* ES */ - fname : sconcat("~/max-out/gk_es_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), em : false, - funcName : sconcat("gk_es_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + funcName : sconcat("gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false), close(fh), @@ -151,33 +151,4 @@ for bInd : 1 thru length(bName) do ( ) ) ) -)$ -fname : "~/max-out/gk_collisionless_flux_surf_return_zero.h"$ -fh : openw(fname)$ -printf(fh, "#include ~%")$ */ -printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surf_return_zero( - const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, - /* const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) - { - return 0.0; - }~%")$ -close(fh)$ - -fname : "~/max-out/gk_collisionless_flux_surfvpar_return_zero.h"$ -fh : openw(fname)$ -printf(fh, "#include ~%")$ -printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surfvpar_return_zero( - const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_r, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf) - { - return 0.0; - }~%")$ -close(fh)$ +)$ \ No newline at end of file From b4dea0153fd2fc82e0c5821be07e4fcec265a92e Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 10 Feb 2026 14:11:06 -0500 Subject: [PATCH 17/66] add a configurable output directory variable --- .../ms-gk_collisionless_flux.mac | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 2a3bb836..8a2b5139 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -8,6 +8,9 @@ load("gk_collisionless/gk_collisionless_flux-surf-vpar")$ /* ...... USER INPUTS........ */ +/* Output directory for generated files. */ +outputDir : "~/max-out/"$ + /* Serendipity basis. */ minPolyOrder_Ser : 1$ maxPolyOrder_Ser : 1$ @@ -69,7 +72,7 @@ for bInd : 1 thru length(bName) do ( for dir : 1 thru c do ( /* ES kernels */ - fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"gk_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), fh : openw(fname), @@ -79,7 +82,7 @@ for bInd : 1 thru length(bName) do ( buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, mb_bound), close(fh), - fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), fh : openw(fname), @@ -90,7 +93,7 @@ for bInd : 1 thru length(bName) do ( close(fh), /* EM kernels */ - fname : sconcat("~/max-out/gk_em_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"gk_em_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), fh : openw(fname), @@ -100,7 +103,7 @@ for bInd : 1 thru length(bName) do ( buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, mb_bound), close(fh), - fname : sconcat("~/max-out/gk_em_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"gk_em_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), fh : openw(fname), @@ -114,7 +117,7 @@ for bInd : 1 thru length(bName) do ( /* Surface flux in vparallel direction.*/ /* ES */ - fname : sconcat("~/max-out/gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), fh : openw(fname), @@ -125,7 +128,7 @@ for bInd : 1 thru length(bName) do ( close(fh), /* EM */ - fname : sconcat("~/max-out/gk_em_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"gk_em_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), fh : openw(fname), @@ -137,7 +140,7 @@ for bInd : 1 thru length(bName) do ( if (no_by = false) then ( /* Add apardot EM terms */ - fname : sconcat("~/max-out/gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar file: ~a",fname)), fh : openw(fname), From ab0ea6dcc0753d7353e5a22a73795fad4ec3c252 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 10 Feb 2026 14:14:48 -0500 Subject: [PATCH 18/66] add configurable output directory variable --- .../g0/gk_collisionless/ms-dg_gyrokinetic-header.mac | 5 ++++- maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac | 11 +++++++---- maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac | 11 +++++++---- .../ms-gk_collisionless_flux-header.mac | 5 ++++- 4 files changed, 22 insertions(+), 10 deletions(-) diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac index f579b863..5ae1d154 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac @@ -2,6 +2,9 @@ /* ...... USER INPUTS........ */ +/* Output file path for the header file. */ +headerOutputPath : "~/max-out/gkyl_dg_gyrokinetic_kernels.h"$ + /* Serendipity basis. */ maxPolyOrder_Ser : 2$ minCdim_Ser : 1$ @@ -110,7 +113,7 @@ printPrototypes() := block([], ) )$ -fh : openw("/Users/ahoffman/gkeyll_dev/gkeyll/gyrokinetic/ker/dg_gyrokinetic/gkyl_dg_gyrokinetic_kernels.h")$ +fh : openw(headerOutputPath)$ printf(fh, "#pragma once~%")$ printf(fh, "~%")$ printf(fh, "#include ~%")$ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac index 18f5db41..f8dc8b49 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-surf.mac @@ -9,6 +9,9 @@ load("gk_collisionless/dg_gk-surf")$ /* ...... USER INPUTS........ */ +/* Output directory for generated files. */ +outputDir : "~/max-out/"$ + /* Serendipity basis. */ minPolyOrder_Ser : 1$ maxPolyOrder_Ser : 1$ @@ -60,7 +63,7 @@ for bInd : 1 thru length(bName) do ( for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( for dir : 1 thru c do ( /* Advection in configuration space.*/ - fname : sconcat("~/max-out/dg_gyrokinetic_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), + fname : sconcat(outputDir,"dg_gyrokinetic_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), disp(printf(false,"Creating surface file: ~a",fname)), fh : openw(fname), @@ -70,7 +73,7 @@ for bInd : 1 thru length(bName) do ( close(fh), /* Advection in configuration space in the skin cell (for boundary flux operations) .*/ - fname : sconcat("~/max-out/dg_gyrokinetic_boundary_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), + fname : sconcat(outputDir,"dg_gyrokinetic_boundary_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), disp(printf(false,"Creating surface file: ~a",fname)), fh : openw(fname), @@ -81,7 +84,7 @@ for bInd : 1 thru length(bName) do ( ), /* Advection in velocity space.*/ - fname : sconcat("~/max-out/dg_gyrokinetic_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), + fname : sconcat(outputDir,"dg_gyrokinetic_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), disp(printf(false,"Creating surface file: ~a",fname)), fh : openw(fname), @@ -91,7 +94,7 @@ for bInd : 1 thru length(bName) do ( close(fh), /* Advection in velocity space in the skin cell along vpar (for zero-flux BCs).*/ - fname : sconcat("~/max-out/dg_gyrokinetic_boundary_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), + fname : sconcat(outputDir,"dg_gyrokinetic_boundary_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p",polyOrder, ".c"), disp(printf(false,"Creating surface file: ~a",fname)), fh : openw(fname), diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac index 37d36b83..31c80e31 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac @@ -7,6 +7,9 @@ load("gk_collisionless/dg_gk-vol")$ /* ...... USER INPUTS........ */ +/* Output directory for generated files. */ +outputDir : "~/max-out/"$ + /* Serendipity basis. */ minPolyOrder_Ser : 1$ maxPolyOrder_Ser : 1$ @@ -44,7 +47,7 @@ for bInd : 1 thru length(bName) do ( maxPolyOrderB : maxPolyOrder[bInd], if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - fname : sconcat("~/max-out/dg_gyrokinetic_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"dg_gyrokinetic_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating volume file: ~a",fname)), fh : openw(fname), @@ -55,7 +58,7 @@ for bInd : 1 thru length(bName) do ( close(fh), /* Add em kernels */ - fname : sconcat("~/max-out/dg_gyrokinetic_add_apar_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"dg_gyrokinetic_add_apar_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating volume file (add em): ~a",fname)), fh : openw(fname), printf(fh, "#include ~%"), @@ -63,7 +66,7 @@ for bInd : 1 thru length(bName) do ( addAparGKEMVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, false), close(fh), - fname : sconcat("~/max-out/dg_gyrokinetic_add_apardot_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"dg_gyrokinetic_add_apardot_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating volume file (add em): ~a",fname)), fh : openw(fname), printf(fh, "#include ~%"), @@ -73,7 +76,7 @@ for bInd : 1 thru length(bName) do ( /* if cdim > 1, also generate a set of kernels for the case where there is no toroidal field (by = 0) */ if (c > 1) then ( - fname : sconcat("~/max-out/dg_gyrokinetic_no_by_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"dg_gyrokinetic_no_by_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), disp(printf(false,"Creating volume file (no by): ~a",fname)), fh : openw(fname), diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index ddaec100..3cf849b1 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -2,6 +2,9 @@ /* ...... USER INPUTS........ */ +/* Output directory for generated files. */ +outputDir : "~/max-out/"$ + /* Serendipity basis. */ maxPolyOrder_Ser : 2$ minCdim_Ser : 1$ @@ -159,7 +162,7 @@ printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surfvpar_return_zero( double* GKYL_RESTRICT flux_surf);~%") )$ -fh : openw("~/max-out/gkyl_gk_collisionless_flux_kernels.h")$ +fh : openw(sconcat(outputDir,"gkyl_gk_collisionless_flux_kernels.h"))$ printf(fh, "#pragma once~%")$ printf(fh, "~%")$ printf(fh, "#include ~%")$ From c4df9f7f5bc530b792534bb4d79bcfa766f65778 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 10 Feb 2026 14:30:43 -0500 Subject: [PATCH 19/66] remove unused lines --- .../gk_collisionless/ms-gk_collisionless_flux-header.mac | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index 3cf849b1..83d6f3d9 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -4,7 +4,6 @@ /* Output directory for generated files. */ outputDir : "~/max-out/"$ - /* Serendipity basis. */ maxPolyOrder_Ser : 2$ minCdim_Ser : 1$ @@ -78,21 +77,19 @@ printPrototypes() := block([], printf(fh, "GKYL_CU_DH double gk_~acollisionless_flux_~a~asurf~a_~ax~av_~a_p~a( const double *w, const double *dxv, - ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, extraargs), printf(fh, "GKYL_CU_DH double gk_~acollisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( const double *w, const double *dxv, - ~a const double *vmap, const double *vmapSq, const double q_, const double m_, ~a const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, extraargs) ) ), From a51a16ca1a9ca4bb3ff41e4d482ba8524d1fda60 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 10 Feb 2026 17:32:54 -0500 Subject: [PATCH 20/66] caught a typo but it's just in a comment -_- --- maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 4f45f71d..c5c126f3 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -157,7 +157,7 @@ buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no ) ), - /* Now calculate apha at all quadrature nodes */ + /* Now calculate alpha at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), printf(fh, " double cfl = 0.0; ~%"), From 064ca5474e17a81999979bba9216205427bf04c6 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 12 Feb 2026 15:37:24 -0500 Subject: [PATCH 21/66] Improve the em flux kernel generation scripts to be less redundant and correct a few typos in comments --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 4 +- .../gk_collisionless_flux-surf-vpar.mac | 6 +- .../ms-dg_gyrokinetic-header.mac | 6 +- .../ms-gk_collisionless_flux-header.mac | 96 +++++------ .../ms-gk_collisionless_flux.mac | 163 +++++++++--------- 5 files changed, 129 insertions(+), 146 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 40ad42d3..d3b28e2a 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -431,10 +431,10 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by curvdriftdir : 3 ), - if dir < vpardim then ( + if dir < vpardim then ( /* This is \rot(Apar b) dHdvpar \cdot \grad\psi from Rdot \cdot \grad\psi volume integrated */ alpha_e : alpha_e + dBperpoverB_list[curvdriftdir]/m_ * mvpar_e ), - if dir = vpardim then ( + if dir = vpardim then ( /* This is \rot(Apar b) \cdot \grad H from vpardot dpsi/dvpar volume integrated */ if cdim = 3 then ( for k : 1 thru cdim do ( alpha_e : alpha_e - dBperpoverB_list[k]/m_ * dH_dz_e[k] diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index c5c126f3..08d17205 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -404,7 +404,7 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no ) ), - /* Now calculate apha at all quadrature nodes */ + /* Now calculate alpha at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), printf(fh, " double cfl = 0.0; ~%"), @@ -475,7 +475,7 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no ), printf(fh, ";~%"), if em = true then ( - /* EM term curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + /* EM term curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ for k : 1 thru cdim do ( /* Apar * curl(b) */ printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[i1index], k-1) @@ -492,7 +492,7 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), printf(fh, ";~%"), if em = true then ( - /* EM term curl(Apar*b) = Apar * curl(b) grad(Apar) x b */ + /* EM term curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ /* Apar * curl(b) */ printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 0), printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[i1index], 2), diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac index 5ae1d154..de6ccedd 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac @@ -2,8 +2,8 @@ /* ...... USER INPUTS........ */ -/* Output file path for the header file. */ -headerOutputPath : "~/max-out/gkyl_dg_gyrokinetic_kernels.h"$ +/* Output directory for generated files. */ +outputDir : "~/max-out/"$ /* Serendipity basis. */ maxPolyOrder_Ser : 2$ @@ -113,7 +113,7 @@ printPrototypes() := block([], ) )$ -fh : openw(headerOutputPath)$ +fh : openw(sconcat(outputDir, "gkyl_dg_gyrokinetic_kernels.h"))$ printf(fh, "#pragma once~%")$ printf(fh, "~%")$ printf(fh, "#include ~%")$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index 83d6f3d9..d9b23ffb 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -4,6 +4,7 @@ /* Output directory for generated files. */ outputDir : "~/max-out/"$ + /* Serendipity basis. */ maxPolyOrder_Ser : 2$ minCdim_Ser : 1$ @@ -72,37 +73,36 @@ printPrototypes() := block([], for surfDir : 1 thru c do ( dirlabel : varsC[surfDir], - extraargs : "const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ", - vprimeargs : "", - - printf(fh, "GKYL_CU_DH double gk_~acollisionless_flux_~a~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, extraargs), - - printf(fh, "GKYL_CU_DH double gk_~acollisionless_flux_~a~aedge_surf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, mb_boundStr, dirlabel, c, v, bName[bInd], polyOrder, extraargs) + + funcName : sconcat("gk_",em_label,"collisionless_flux_",no_byStr,mb_boundStr,"surf",dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", funcName), + + funcName : sconcat("gk_",em_label,"collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", funcName) ) ), dirlabel : varsV[1], - extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", - vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - printf(fh, "GKYL_CU_DH double gk_~acollisionless_flux_~asurf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", em_label, no_byStr, dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs), + funcName : sconcat("gk_",em_label,"collisionless_flux_",no_byStr,"surf",dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", funcName), printf(fh, "~%") ) @@ -123,16 +123,14 @@ printPrototypes() := block([], for polyOrder : 1 thru maxPolyOrderB do ( dirlabel : varsV[1], - extraargs : "const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ", - vprimeargs : "const double *vmap_prime_l, const double *vmap_prime_r, ", - - printf(fh, "GKYL_CU_DH double gk_em_collisionless_flux_add_apardot_surf~a_~ax~av_~a_p~a( - const double *w, const double *dxv, - ~a - const double *vmap, const double *vmapSq, const double q_, const double m_, - ~a - const double *bmag, const double *phi, const double *apardot, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", dirlabel, c, v, bName[bInd], polyOrder, vprimeargs, extraargs) + funcName : sconcat("gk_em_collisionless_flux_add_apardot_surf",dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *apardot, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", funcName) ), printf(fh, "~%") @@ -140,23 +138,13 @@ printPrototypes() := block([], ) ), -printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surf_return_zero( - const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, - const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf);~%"), - -printf(fh,"~%"), - -printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surfvpar_return_zero( - const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_r, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf);~%") + printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surf_return_zero( + const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf);~%") )$ fh : openw(sconcat(outputDir,"gkyl_gk_collisionless_flux_kernels.h"))$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 8a2b5139..53e6dbc8 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -43,115 +43,110 @@ vlabels : ["vpar","mu"]$ byOpt : [[false], [false, true], [false, true]]$ byStr : ["", "no_by_"]$ +/* Options for writing electromagnetic and electrostatic kernels. */ +emBool : [false, true]$ +emOpt : ["", "em_"]$ + /* Options for writing kernels used at multiblock boundaries. One for each dimension. */ mb_bcOpt : [[false,true],[false,true],[false,true]]$ mb_bcStr : ["", "multib_boundary_"]$ -em : false$ /* Include EM terms if true */ +/* Options for writing kernels at surface and edge surfaces. */ +edgeBool : [false, true]$ +edgeOpt : ["surf", "edge_surf"]$ /* Generate kernels of selected types. */ for bInd : 1 thru length(bName) do ( + bStr : bName[bInd], + /* Loop over configuration space dimensions. */ for c : minCdim[bInd] thru maxCdim[bInd] do ( + /* Loop over velocity space dimensions. */ for gkV : 1 thru length(gkVdims[c]) do ( v : gkVdims[c][gkV], - maxPolyOrderB : maxPolyOrder[bInd], if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - + /* Loop over polynomial order. */ for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + + /* With/without toroidal field loop. */ for byI : 1 thru length(byOpt[c]) do ( no_by : byOpt[c][byI], no_byStr : byStr[byI], - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], - - /* Surface flux in direction dir in configuration space.*/ - for dir : 1 thru c do ( - - /* ES kernels */ - fname : sconcat(outputDir,"gk_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - em : false, - funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, mb_bound), - close(fh), - - fname : sconcat(outputDir,"gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), - + /* Electrostatic/electromagnetic loop. */ + for emI : 1 thru length(emOpt) do ( + em : emBool[emI], + emStr : emOpt[emI], + + /* Singleblock/multiblock loop. */ + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], + + /* Configuration space surface direction loop. */ + for dir : 1 thru c do ( + dirStr : clabels[dir], + + /* Surface/edge surface loop. */ + for edgeI : 1 thru length(edgeBool) do ( + edge : edgeBool[edgeI], + edgeStr : edgeOpt[edgeI], + + fname : sconcat(outputDir,"gk_",emStr,"collisionless_flux_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), + disp(printf(false,"Creating ~a flux surf~a ~a ~a file: ~a",edgeStr,dirStr,no_byStr,mb_boundStr,fname)), + fh : openw(fname), + printf(fh, "#include ~%"), + funcName : sconcat("gk_",emStr,"collisionless_flux_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), + buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound), + close(fh) + ) + ), + + /* Surface flux in vparallel direction (no edge).*/ + dirStr : vlabels[1], + edge : false, + edgeStr : edgeOpt[1], + + fname : sconcat(outputDir,"gk_",emStr,"collisionless_flux_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), - em : false, - funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, true, mb_bound), + funcName : sconcat("gk_",emStr,"collisionless_flux_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), + buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge), close(fh), - /* EM kernels */ - fname : sconcat(outputDir,"gk_em_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - em : true, - funcName : sconcat("gk_em_collisionless_flux_",no_byStr,mb_boundStr,"surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, mb_bound), - close(fh), - - fname : sconcat(outputDir,"gk_em_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux edge surf~a ~a ~a file: ~a",clabels[dir],no_byStr,mb_boundStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - em : true, - funcName : sconcat("gk_em_collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",clabels[dir],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, true, mb_bound), - close(fh) + if (em and no_by = false) then ( + /* Add apardot EM terms */ + fname : sconcat(outputDir,"gk_",emStr,"collisionless_flux_add_apardot_surf",dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar file: ~a",fname)), + fh : openw(fname), + printf(fh, "#include ~%"), + funcName : sconcat("gk_",emStr,"collisionless_flux_add_apardot_surf",dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), + AddApardotGKEMFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, false), + close(fh) + ) ) - ), - - /* Surface flux in vparallel direction.*/ - /* ES */ - fname : sconcat(outputDir,"gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - em : false, - funcName : sconcat("gk_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false), - close(fh), - - /* EM */ - fname : sconcat(outputDir,"gk_em_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - em : true, - funcName : sconcat("gk_em_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false), - close(fh), - - if (no_by = false) then ( - /* Add apardot EM terms */ - fname : sconcat(outputDir,"gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar file: ~a",fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - AddApardotGKEMFluxVparKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, false), - close(fh) ) ) ) ) ) -)$ \ No newline at end of file +)$ + +/* Generate the return zero kernel */ +fname : sconcat(outputDir,"gk_collisionless_flux_surf_return_zero.c")$ +disp(printf(false,"Creating return zero kernel file: ~a",fname))$ +fh : openw(fname)$ +printf(fh, "#include ~%")$ +printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surf_return_zero(~%")$ +printf(fh, " const double *w, const double *dxv,~%")$ +printf(fh, " const double *vmap, const double *vmapSq, const double q_, const double m_,~%")$ +printf(fh, " const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ~%")$ +printf(fh, " const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, ~%")$ +printf(fh, " const double *phi, const double *apar,~%")$ +printf(fh, " const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%")$ +printf(fh, "{ ~%")$ +printf(fh, " return 0.0; ~%")$ +printf(fh, "}~%")$ +close(fh)$ From 25399c6a4fb4bcfb5e0bd6d828ab16769d71b395 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 17 Feb 2026 11:56:48 -0500 Subject: [PATCH 22/66] kernels related to the get_em_back_full_upwind branch in Gkeyll --- .../gk_collisionless_flux-surf-conf.mac | 14 ++- .../gk_collisionless_flux-surf-vpar.mac | 40 +++++--- .../ms-dg_gyrokinetic-vol.mac | 1 - .../ms-dg_gyrokinetic-vol_apardot.mac | 57 +++++++++++ .../ms-gk_collisionless_flux-header.mac | 74 +++++---------- .../ms-gk_collisionless_flux.mac | 38 +++++--- .../ms-gk_collisionless_flux_apardot.mac | 94 +++++++++++++++++++ maxima/g0/gk_collisionless/verify_no_leak.mac | 21 +++++ 8 files changed, 260 insertions(+), 79 deletions(-) create mode 100644 maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_apardot.mac create mode 100644 maxima/g0/gk_collisionless/ms-gk_collisionless_flux_apardot.mac create mode 100644 maxima/g0/gk_collisionless/verify_no_leak.mac diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index d1724ee7..211c47bb 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -300,7 +300,7 @@ buildGKFluxConfESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no )$ -buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, mb_bound) := block( +buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, mb_bound, scheme) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,apar_e, @@ -357,7 +357,7 @@ buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no const double *vmap, const double *vmapSq, const double q_, const double m_, const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, + const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), printf(fh, " // w[NDIM]: cell-center.~%"), printf(fh, " // dxv[NDIM]: cell length.~%"), @@ -371,6 +371,7 @@ buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, " // jacobgeo_rat_surfR: Ratio of surface conf-space Jacobians in right cell.~%"), printf(fh, " // phi: electrostatic potential.~%"), printf(fh, " // apar: parallel component of vector potential.~%"), + printf(fh, " // apardot: time derivative of parallel component of vector potential.~%"), printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), @@ -609,13 +610,18 @@ buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no ), printf(fh, "~%"), - /*printf(fh, " alpha_quad = alpha_quad*area_elem_quad/Jc_quad; ~%"),*/ printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)); ~%"), printf(fh, " JfL_quad = ~a; ~%", JfL_nodes[j1index]), printf(fh, " JfR_quad = ~a; ~%", JfR_nodes[j1index]), printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0; ~%"), printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0; ~%"), - printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad; ~%", j0index) + if scheme = "upwind" then ( + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad; ~%", j0index) + ) else if scheme = "central" then ( + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad; ~%", j0index) + ) else if scheme = "downwind" then ( + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad + fabs(alpha_quad)*Jfjump_quad; ~%", j0index) + ) ), printf(fh, "~%") ), diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 08d17205..6b5b62c7 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -242,13 +242,14 @@ buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no )$ -buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge) := block( +buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, add_apardot, scheme) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,NSurf,numNodes,apar_e,apar_nodes,dA_dx_nodes,k + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,NSurf,numNodes,apar_e,apar_nodes,dA_dx_nodes,k, + apardot_e,apardot_nodes ], kill(varsC,varsP,bC,bP), @@ -300,12 +301,12 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no print("Working on ", funcNm), printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_r, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), printf(fh, " // w[NDIM]: cell-center.~%"), printf(fh, " // dxv[NDIM]: cell length.~%"), printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), @@ -317,6 +318,7 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no printf(fh, " // bmag: magnetic field amplitude.~%"), printf(fh, " // phi: electrostatic potential.~%"), printf(fh, " // apar: parallel component of vector potential.~%"), + printf(fh, " // apardot: time derivative of parallel component of vector potential.~%"), printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), @@ -515,13 +517,26 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no ) ), + /* Add apardot contribution if requested */ + if add_apardot = true then ( + apardot_e : doExpand1(apardot, bC), + apardot_nodes : float(evAtNodes(apardot_e,configNodes,surf_cvars)) + printf(fh, " alpha_quad += -q_/m_*(~a); ~%", apardot_nodes[i1index]) + ), + printf(fh, "~%"), printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), - printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) + if scheme = "upwind" then ( + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) + ) else if scheme = "central" then ( + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad; ~%", j0index) + ) else if scheme = "downwind" then ( + printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad + fabs(alpha_quad)*Jfjump_quad; ~%", j0index) + ) ), printf(fh, "~%") ), @@ -593,7 +608,7 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde const double *vmap_prime_l, const double *vmap_prime_r, const double *vmap, const double *vmapSq, const double q_, const double m_, const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, + const double *bmag, const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), printf(fh, " // w[NDIM]: cell-center.~%"), printf(fh, " // dxv[NDIM]: cell length.~%"), @@ -605,7 +620,8 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), printf(fh, " // bmag: magnetic field amplitude.~%"), printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // apar: parallel component of vector potential (here it will be apardot).~%"), + printf(fh, " // apar: parallel component of vector potential.~%"), + printf(fh, " // apardot: derivative of apar with respect to vpar.~%"), printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), @@ -624,7 +640,7 @@ AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrde flush_output(fh), /* Expand Apardot */ - apardot_e : doExpand1(apar, bC), + apardot_e : doExpand1(apardot, bC), apardot_nodes : float(evAtNodes(apardot_e,configNodes,surf_cvars)), /*fl and fr */ diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac index 31c80e31..965586ee 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol.mac @@ -52,7 +52,6 @@ for bInd : 1 thru length(bName) do ( fh : openw(fname), printf(fh, "#include ~%"), - funcName : sconcat("dg_gyrokinetic_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), buildGKVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, false), close(fh), diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_apardot.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_apardot.mac new file mode 100644 index 00000000..5b578b88 --- /dev/null +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_apardot.mac @@ -0,0 +1,57 @@ +/* + Generate the volume kernels for collisionless gyrokinetic terms. + + The functions called in this file are in gkFuncs-vol.mac. +*/ +load("gk_collisionless/dg_gk-vol")$ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 1$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor order basis. No need to generate p=1. */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 2$ +minCdim_Tensor : 1$ +maxCdim_Tensor : 0$ + +/* Vdim possibilities for each of Cdim=[1,2,3]. */ +gkVdims : [[1,2], [2], [2]]$ + +/* ...... END OF USER INPUTS........ */ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +/* Possible combinations of variable dependence of background magnetic field. + with [] = const. Note that we assume axisymmetry, which means B cannot depend on y. */ +bVarsList : [x,z]$ + +/* Generate kernels of selected types. */ +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ + for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + fname : sconcat("/Users/ahoffman/gkeyll_dev/gkeyll/gyrokinetic/ker/dg_gyrokinetic/dg_gyrokinetic_add_apardot_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating volume file (add em): ~a",fname)), + fh : openw(fname), + printf(fh, "#include ~%"), + funcName : sconcat("dg_gyrokinetic_add_apardot_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + addApardotGKEMVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, false), + close(fh) + ) + ) + ) +)$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index d9b23ffb..7b35759d 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -6,7 +6,7 @@ outputDir : "~/max-out/"$ /* Serendipity basis. */ -maxPolyOrder_Ser : 2$ +maxPolyOrder_Ser : 1$ minCdim_Ser : 1$ minVdim_Ser : 1$ maxCdim_Ser : 3$ @@ -46,10 +46,14 @@ byStr : ["", "no_by_"]$ mb_bcOpt : [[false,true],[false,true],[false,true]]$ mb_bcStr : ["", "multib_boundary_"]$ -emStr : ["", "em_"]$ +emStr : ["", "em_", "em_star_"]$ + +/* Options for writing kernels at surface and edge surfaces. */ +edgeBool : [false, true]$ +edgeOpt : ["surf", "edge_surf"]$ printPrototypes() := block([], - for emI : 1 thru 2 do ( + for emI : 1 thru 3 do ( em_label : emStr[emI], for bInd : 1 thru length(bName) do ( @@ -73,35 +77,33 @@ printPrototypes() := block([], for surfDir : 1 thru c do ( dirlabel : varsC[surfDir], - - funcName : sconcat("gk_",em_label,"collisionless_flux_",no_byStr,mb_boundStr,"surf",dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", funcName), - funcName : sconcat("gk_",em_label,"collisionless_flux_",no_byStr,mb_boundStr,"edge_surf",dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", funcName) + for edgeI : 1 thru 2 do ( + edge : edgeBool[edgeI], + edgeStr : edgeOpt[edgeI], + + funcName : sconcat("gk_collisionless_flux_",em_label,no_byStr,mb_boundStr,edgeStr,dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), + printf(fh, "GKYL_CU_DH double ~a( + const double *w, const double *dxv, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, + const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, + const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, + double* GKYL_RESTRICT flux_surf); ~%", funcName) + ) ) ), dirlabel : varsV[1], - funcName : sconcat("gk_",em_label,"collisionless_flux_",no_byStr,"surf",dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), + edgeStr : edgeOpt[1], + edge : false, + funcName : sconcat("gk_collisionless_flux_",em_label,no_byStr,edgeStr,dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), printf(fh, "GKYL_CU_DH double ~a( const double *w, const double *dxv, const double *vmap_prime_l, const double *vmap_prime_r, const double *vmap, const double *vmapSq, const double q_, const double m_, const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *apar, const double *JfL, const double *JfR, + const double *bmag, const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf); ~%", funcName), printf(fh, "~%") @@ -112,38 +114,12 @@ printPrototypes() := block([], ) ), - /* EM add apardot vpar surface term */ - for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ - for polyOrder : 1 thru maxPolyOrderB do ( - - dirlabel : varsV[1], - funcName : sconcat("gk_em_collisionless_flux_add_apardot_surf",dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_r, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *apardot, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf); ~%", funcName) - ), - - printf(fh, "~%") - ) - ) - ), - printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surf_return_zero( const double *w, const double *dxv, const double *vmap, const double *vmapSq, const double q_, const double m_, const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *JfL, const double *JfR, + const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf);~%") )$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 53e6dbc8..e3d86b4e 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -93,13 +93,23 @@ for bInd : 1 thru length(bName) do ( edge : edgeBool[edgeI], edgeStr : edgeOpt[edgeI], - fname : sconcat(outputDir,"gk_",emStr,"collisionless_flux_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"gk_collisionless_flux_",emStr,no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), disp(printf(false,"Creating ~a flux surf~a ~a ~a file: ~a",edgeStr,dirStr,no_byStr,mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), - funcName : sconcat("gk_",emStr,"collisionless_flux_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound), - close(fh) + funcName : sconcat("gk_collisionless_flux_",emStr,no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), + buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, "upwind"), + close(fh), + + if (em) then ( + fname : sconcat(outputDir,"gk_collisionless_flux_em_star_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), + disp(printf(false,"Creating ~a flux surf~a ~a ~a file: ~a",edgeStr,dirStr,no_byStr,mb_boundStr,fname)), + fh : openw(fname), + printf(fh, "#include ~%"), + funcName : sconcat("gk_collisionless_flux_em_star_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), + buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, "upwind"), + close(fh) + ) ) ), @@ -107,23 +117,25 @@ for bInd : 1 thru length(bName) do ( dirStr : vlabels[1], edge : false, edgeStr : edgeOpt[1], + add_apardot : em, /* Add apardot term if EM. */ - fname : sconcat(outputDir,"gk_",emStr,"collisionless_flux_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), + fname : sconcat(outputDir,"gk_collisionless_flux_",emStr,no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), - funcName : sconcat("gk_",emStr,"collisionless_flux_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge), + funcName : sconcat("gk_collisionless_flux_",emStr,no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), + buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, "upwind"), close(fh), - if (em and no_by = false) then ( - /* Add apardot EM terms */ - fname : sconcat(outputDir,"gk_",emStr,"collisionless_flux_add_apardot_surf",dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), + if (em) then ( + /* Add EM terms but not Apardot (star term) */ + add_apardot : false, + fname : sconcat(outputDir,"gk_collisionless_flux_em_star_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar file: ~a",fname)), fh : openw(fname), printf(fh, "#include ~%"), - funcName : sconcat("gk_",emStr,"collisionless_flux_add_apardot_surf",dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - AddApardotGKEMFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, false), + funcName : sconcat("gk_collisionless_flux_em_star_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), + buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, "upwind"), close(fh) ) ) @@ -144,7 +156,7 @@ printf(fh, " const double *w, const double *dxv,~%")$ printf(fh, " const double *vmap, const double *vmapSq, const double q_, const double m_,~%")$ printf(fh, " const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ~%")$ printf(fh, " const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, ~%")$ -printf(fh, " const double *phi, const double *apar,~%")$ +printf(fh, " const double *phi, const double *apar, const double *apardot, ~%")$ printf(fh, " const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%")$ printf(fh, "{ ~%")$ printf(fh, " return 0.0; ~%")$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_apardot.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_apardot.mac new file mode 100644 index 00000000..402952f7 --- /dev/null +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_apardot.mac @@ -0,0 +1,94 @@ +/* + Generate the kernel for surface expansions of the phase space characteristics. + + The functions called in this file are in gkFuncs-alpha-surf.mac. +*/ +load("gk_collisionless/gk_collisionless_flux-surf-conf")$ +load("gk_collisionless/gk_collisionless_flux-surf-vpar")$ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 1$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor order basis. No need to generate p=1. */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 2$ +minCdim_Tensor : 1$ +maxCdim_Tensor : 0$ + +/* ...... END OF USER INPUTS........ */ + +/* Vdim possibilities for each of Cdim=[1,2,3]. */ +gkVdims : [[1,2], [2], [2]]$ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +clabels : ["x","y","z"]$ +vlabels : ["vpar","mu"]$ + +/* Options for writing kernels with and without toroidal field (b_y=0), one per + dimension. */ +byOpt : [[false], [false, true], [false, true]]$ +byStr : ["", "no_by_"]$ + +/* Options for writing kernels used at multiblock boundaries. One for each + dimension. */ +mb_bcOpt : [[false,true],[false,true],[false,true]]$ +mb_bcStr : ["", "multib_boundary_"]$ + +em : false$ /* Include EM terms if true */ + +/* Generate kernels of selected types. */ +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ + + for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + for byI : 1 thru length(byOpt[c]) do ( + no_by : byOpt[c][byI], + no_byStr : byStr[byI], + + /* Surface flux in vparallel direction.*/ + /* ES */ + /* fname : sconcat("~/max-out/gk_es_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + em : false, + funcName : sconcat("gk_es_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, false), + close(fh), */ + + /* EM */ + if (no_by = false) then ( + /* Add apardot EM terms */ + fname : sconcat("/Users/ahoffman/gkeyll_dev/gkeyll/gyrokinetic/ker/gk_collisionless_flux/gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar file: ~a",fname)), + + fh : openw(fname), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + AddApardotGKEMFluxVparKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, false), + close(fh) + ) + ) + ) + ) + ) +)$ + diff --git a/maxima/g0/gk_collisionless/verify_no_leak.mac b/maxima/g0/gk_collisionless/verify_no_leak.mac new file mode 100644 index 00000000..90621efd --- /dev/null +++ b/maxima/g0/gk_collisionless/verify_no_leak.mac @@ -0,0 +1,21 @@ +kill(all)$ +/* load("dg_gk-vol.mac")$ */ +/* load("nodal_operations/node_locations")$ */ +/* load(stringproc)$ */ +/* fpprec : 24$ */ +/* load("eigen")$ */ + +/* values()$ */ +/* print(values)$ */ + +load("modal-basis")$ + +vars : [z,v,m]$ +n : 1$ +basis : makeSerendipBasis(vars, n)$ + +print("Serendipity basis:")$ +for i : 1 thru length(basis) do ( + printf(true, " basis[~a] = ~a~%", i, basis[i]) +)$ + From 2d170beb427cb77e586ef6d834945dc142ad665e Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 17 Feb 2026 14:33:49 -0500 Subject: [PATCH 23/66] remove unused scripts --- .../gk_collisionless_flux-surf-vpar.mac | 384 +----------------- .../ms-dg_gyrokinetic-vol_apardot.mac | 57 --- .../ms-gk_collisionless_flux_apardot.mac | 94 ----- 3 files changed, 1 insertion(+), 534 deletions(-) delete mode 100644 maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_apardot.mac delete mode 100644 maxima/g0/gk_collisionless/ms-gk_collisionless_flux_apardot.mac diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 6b5b62c7..e025f622 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -5,243 +5,6 @@ load("scifac")$ load("utilities_gyrokinetic")$ fpprec : 24$ -buildGKFluxVparESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge) := block( - [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, - surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, - numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, - bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, - hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,NSurf,numNodes,k - ], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - surfIntVarsC : delete(surfVar,varsC), - bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - nodeVars : surfIntVars, - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim, vdim-1, surfIntVars, surfNodes) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - nodeVars : surfIntVars, - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) - ), - configNodes : gaussOrd(polyOrder+1, cdim), - numSurfNodes : length(surfNodes), - numConfigNodes : length(configNodes), - numVelNodes : numSurfNodes/numConfigNodes, - - /* if polyOrder = 1, we need to be careful about - indexing input arrays since the surface hybrid basis has a different size in the - vparallel surfaces and/or we are more directly exploiting the sparsity of - alpha (e.g., in the x and z direction when no toroidal field, by=0) - and thus utilize fewer coefficients to reduce the number of operations */ - if (polyOrder = 1) then ( - tempVars : delete(x,varsP), - tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), - NSurfIndexing : length(tempBasis), - numNodesIndexing : length(tempBasis) - ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes - ), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_r, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // dgv: volume DG geometry.~%"), - printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), - printf(fh, " // bmag: magnetic field amplitude.~%"), - printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), - printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), - printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), - printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), - printf(fh, "~%"), - - /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru cdim+1 do ( - printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) - ), - printf(fh, "~%"), - rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), - - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - /* Axisymmetric basis (independent of y). */ - bmagBasis : getAxisymmetricConfBasis(bC), - - /* Expand input fields for Hamiltonian calculation */ - phi_e : doExpand1(phi,bC), - bmag_e : doExpand1(bmag, bmagBasis), - - /* Velocity mapping fields. */ - [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), - - /* Redefine vmap_prime to exploit the relationship between it and vmap. */ - /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ - vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), - - if edge = true then ( - evPoint : 1 - ) else ( - evPoint : -1 - ), - - /* Finally write out the hamiltonian*/ - hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], - if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), - hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), - printf(fh, " double hamil[~a] = {0.}; ~%", numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - hamilCvar : eval_string(sconcat("hamil")), - writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), - printf(fh, "~%"), - flush_output(fh), - hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), - /* Expand projected Hamiltonian on basis. */ - hamil_e : doExpand(hamilNoZero_c,bP), - /*hamil_e : subst(surfVar=evPoint,hamil_e),*/ - - /*fl and fr */ - JfL_e : doExpand1(JfL, bP), - JfR_e : doExpand1(JfR, bP), - JfL_c : calcInnerProdList(varsP, 1, bP, JfL_e), - JfR_c : calcInnerProdList(varsP, 1, bP, JfR_e), - - JfL_e : subst(surfVar=1,JfL_e), - JfR_e : subst(surfVar=-1,JfR_e), - - JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), - JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), - - vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), - - vpardim : pDim-1, - if vdim = 1 then ( vpardim : pDim ), - dH_dz_nodes : makelist(0, i, 1, pDim), - for i : 1 thru vpardim do ( - if i = vpardim then ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars)), - dH_dz_nodes[i] : subst(surfVar=evPoint, dH_dz_nodes[i]) - ) - else ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) - ) - ), - - /* Now calculate alpha at all quadrature nodes */ - /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ - printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), - printf(fh, " double cfl = 0.0; ~%"), - printf(fh, " double bmag_quad = 0.0; ~%"), - printf(fh, " double B3_quad = 0.0; ~%"), - printf(fh, " double Jc_quad = 0.0; ~%"), - printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), - - printf(fh, " double alpha_quad = 0.0; ~%"), - printf(fh, " double JfL_quad = 0.0; ~%"), - printf(fh, " double JfR_quad = 0.0; ~%"), - printf(fh, " double Jfavg_quad = 0.0; ~%"), - printf(fh, " double Jfjump_quad = 0.0; ~%"), - printf(fh, "~%"), - - for i : 1 thru numConfigNodes do ( - printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i-1), - printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i-1), - printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i-1), - printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i-1), - printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i-1), - printf(fh, "~%"), - for j : 1 thru numVelNodes do ( - j0index : j-1+(i-1)*numVelNodes, - j1index : j+(i-1)*numVelNodes, - printf(fh, "~%"), - if no_by = true then ( - printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ;~%", dH_dz_nodes[cdim][j1index]) - ), - if no_by = false then ( - printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ", dH_dz_nodes[cdim][j1index]), - if cdim = 3 then ( - for k : 1 thru cdim do ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[k][j1index], k-1, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) - ) - ), - if cdim = 2 then ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 0, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) - ), - if cdim = 1 then ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) - ), - printf(fh, ";~%") - ), - - printf(fh, "~%"), - printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), - printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), - printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), - printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), - printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), - printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) - ), - printf(fh, "~%") - ), - - /* Do the quad nodal to modal ops directly here*/ - /*printf(fh, "~%"), - printf(fh, " double *fmodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), - flux_surf_nodal_e : doExpand1(flux_surf_nodal,basisNodal), - fmodproj_e : fullratsimp(calcInnerProdList(surfIntVars, 1, bSurf, flux_surf_nodal_e)), - - for i : 1 thru length(fmodproj_e) do ( - printf(fh, " fmodal[~a] = ~a; ~%", i-1, float(expand(fmodproj_e[i]))) - ), - - printf(fh, "~%"),*/ - /*Calculate the cfl*/ - pOrderCFL : polyOrder, - if polyOrder=1 then ( pOrderCFL : 2 ), - printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), - vprimeStr : "/vmap_prime_min", - printf(fh, "~%"), - printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), - - printf(fh, "~%"), - flush_output(fh), - printf(fh, "} ~%") - -)$ - - buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, add_apardot, scheme) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, @@ -554,149 +317,4 @@ buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no flush_output(fh), printf(fh, "} ~%") -)$ - -AddApardotGKEMFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, edge) := block( - [pDim,varsC,bC,varsP,bP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, - surfNodes,configNodes,numSurfNodes,numConfigNodes, - numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdSurfVar2, - JfL_e,JfR_e,JfL_nodes,JfR_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr, - numC,numP,vSub,NSurf,numNodes,apardot_e,apardot_nodes - ], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1) - ), - configNodes : gaussOrd(polyOrder+1, cdim), - numSurfNodes : length(surfNodes), - numConfigNodes : length(configNodes), - numVelNodes : numSurfNodes/numConfigNodes, - - /* if polyOrder = 1, we need to be careful about - indexing input arrays since the surface hybrid basis has a different size in the - vparallel surfaces and/or we are more directly exploiting the sparsity of - alpha (e.g., in the x and z direction when no toroidal field, by=0) - and thus utilize fewer coefficients to reduce the number of operations */ - if (polyOrder = 1) then ( - tempVars : delete(x,varsP), - tempBasis : basisFromVars("gkhyb",tempVars,polyOrder), - NSurfIndexing : length(tempBasis), - numNodesIndexing : length(tempBasis) - ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes - ), - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap_prime_l, const double *vmap_prime_r, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, - const double *bmag, const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap_prime_l,vmap_prime_r: velocity space mapping derivative in left and right cells.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // dgv: volume DG geometry.~%"), - printf(fh, " // gkdgv: gyrokinetic volume DG geometry.~%"), - printf(fh, " // bmag: magnetic field amplitude.~%"), - printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // apar: parallel component of vector potential.~%"), - printf(fh, " // apardot: derivative of apar with respect to vpar.~%"), - printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), - printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), - printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), - printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), - printf(fh, "~%"), - - /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru cdim+1 do ( - printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) - ), - printf(fh, "~%"), - - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - printf(fh, "~%"), - flush_output(fh), - - /* Expand Apardot */ - apardot_e : doExpand1(apardot, bC), - apardot_nodes : float(evAtNodes(apardot_e,configNodes,surf_cvars)), - - /*fl and fr */ - JfL_e : doExpand1(JfL, bP), - JfR_e : doExpand1(JfR, bP), - - JfL_e : subst(surfVar=1,JfL_e), - JfR_e : subst(surfVar=-1,JfR_e), - - JfL_nodes : float(evAtNodes(JfL_e,surfNodes,surfIntVars)), - JfR_nodes : float(evAtNodes(JfR_e,surfNodes,surfIntVars)), - - /* Now calculate alpha at all quadrature nodes */ - printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), - printf(fh, " double cfl = 0.0; ~%"), - - printf(fh, " double alpha_quad = 0.0; ~%"), - printf(fh, " double JfL_quad = 0.0; ~%"), - printf(fh, " double JfR_quad = 0.0; ~%"), - printf(fh, " double Jfavg_quad = 0.0; ~%"), - printf(fh, " double Jfjump_quad = 0.0; ~%"), - printf(fh, "~%"), - - for i : 1 thru numConfigNodes do ( - i0index : i-1, - i1index : i, - printf(fh, "~%"), - for j : 1 thru numVelNodes do ( - j0index : j-1+(i-1)*numVelNodes, - j1index : j+(i-1)*numVelNodes, - printf(fh, "~%"), - - /* Compute the contribution of Apardot */ - printf(fh, " alpha_quad = -q_/m_*(~a); ~%", apardot_nodes[i1index]), - - printf(fh, "~%"), - printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), - printf(fh, " JfL_quad = (~a)/~a;~%", JfL_nodes[j1index], vmap_prime_l[surfDir-cdim-1]), - printf(fh, " JfR_quad = (~a)/~a;~%", JfR_nodes[j1index], vmap_prime_r[surfDir-cdim-1]), - printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0 ;~%"), - printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0 ;~%"), - printf(fh, " flux_surf_nodal[~a] += alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad ;~%", j0index) - ), - printf(fh, "~%") - ), - - printf(fh, "~%"), - /*Calculate the cfl*/ - pOrderCFL : polyOrder, - if polyOrder=1 then ( pOrderCFL : 2 ), - printf(fh, " double vmap_prime_min = fmin(fabs(~a),fabs(~a));~%",vmap_prime_l[surfDir-cdim-1],vmap_prime_r[surfDir-cdim-1]), - vprimeStr : "/vmap_prime_min", - printf(fh, "~%"), - printf(fh, " return cfl~a*~a; ~%", vprimeStr, float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), - - printf(fh, "~%"), - flush_output(fh), - printf(fh, "} ~%") -)$ +)$ \ No newline at end of file diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_apardot.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_apardot.mac deleted file mode 100644 index 5b578b88..00000000 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-vol_apardot.mac +++ /dev/null @@ -1,57 +0,0 @@ -/* - Generate the volume kernels for collisionless gyrokinetic terms. - - The functions called in this file are in gkFuncs-vol.mac. -*/ -load("gk_collisionless/dg_gk-vol")$ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 1$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor order basis. No need to generate p=1. */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 2$ -minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ - -/* Vdim possibilities for each of Cdim=[1,2,3]. */ -gkVdims : [[1,2], [2], [2]]$ - -/* ...... END OF USER INPUTS........ */ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -/* Possible combinations of variable dependence of background magnetic field. - with [] = const. Note that we assume axisymmetry, which means B cannot depend on y. */ -bVarsList : [x,z]$ - -/* Generate kernels of selected types. */ -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - fname : sconcat("/Users/ahoffman/gkeyll_dev/gkeyll/gyrokinetic/ker/dg_gyrokinetic/dg_gyrokinetic_add_apardot_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating volume file (add em): ~a",fname)), - fh : openw(fname), - printf(fh, "#include ~%"), - funcName : sconcat("dg_gyrokinetic_add_apardot_vol_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - addApardotGKEMVolKernel(fh, funcName, c, v, bName[bInd], polyOrder, bVarsList, false), - close(fh) - ) - ) - ) -)$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_apardot.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_apardot.mac deleted file mode 100644 index 402952f7..00000000 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux_apardot.mac +++ /dev/null @@ -1,94 +0,0 @@ -/* - Generate the kernel for surface expansions of the phase space characteristics. - - The functions called in this file are in gkFuncs-alpha-surf.mac. -*/ -load("gk_collisionless/gk_collisionless_flux-surf-conf")$ -load("gk_collisionless/gk_collisionless_flux-surf-vpar")$ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 1$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor order basis. No need to generate p=1. */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 2$ -minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ - -/* ...... END OF USER INPUTS........ */ - -/* Vdim possibilities for each of Cdim=[1,2,3]. */ -gkVdims : [[1,2], [2], [2]]$ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -clabels : ["x","y","z"]$ -vlabels : ["vpar","mu"]$ - -/* Options for writing kernels with and without toroidal field (b_y=0), one per - dimension. */ -byOpt : [[false], [false, true], [false, true]]$ -byStr : ["", "no_by_"]$ - -/* Options for writing kernels used at multiblock boundaries. One for each - dimension. */ -mb_bcOpt : [[false,true],[false,true],[false,true]]$ -mb_bcStr : ["", "multib_boundary_"]$ - -em : false$ /* Include EM terms if true */ - -/* Generate kernels of selected types. */ -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - - for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - for byI : 1 thru length(byOpt[c]) do ( - no_by : byOpt[c][byI], - no_byStr : byStr[byI], - - /* Surface flux in vparallel direction.*/ - /* ES */ - /* fname : sconcat("~/max-out/gk_es_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - em : false, - funcName : sconcat("gk_es_collisionless_flux_",no_byStr,"surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, no_by, em, false, false), - close(fh), */ - - /* EM */ - if (no_by = false) then ( - /* Add apardot EM terms */ - fname : sconcat("/Users/ahoffman/gkeyll_dev/gkeyll/gyrokinetic/ker/gk_collisionless_flux/gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar file: ~a",fname)), - - fh : openw(fname), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_em_collisionless_flux_add_apardot_surf",vlabels[1],"_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - AddApardotGKEMFluxVparKernel(c+1, fh, funcName, c, v, bName[bInd], polyOrder, false), - close(fh) - ) - ) - ) - ) - ) -)$ - From dea3b488649b4901a0c260dba17eca661cbf7f35 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 17 Feb 2026 14:34:35 -0500 Subject: [PATCH 24/66] remove unused function --- .../gk_collisionless_flux-surf-conf.mac | 294 ------------------ 1 file changed, 294 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 211c47bb..66e91d8c 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -6,300 +6,6 @@ load("utilities_gyrokinetic")$ load("nodal_operations/nodal_functions")$ fpprec : 24$ -buildGKFluxConfESKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge, mb_bound) := block( - [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, - surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, - numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,bmagSurf_e,vmap_e,vmapSq_e, - vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, - jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL, - surfIntVarsC,bSurfC,hamilCvar - ], - - kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, - - [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), - numC : length(bC), numP : length(bP), - - surfVar : varsP[surfDir], /* Surface variable. */ - varLabel : makelist(string(varsP[d]),d,1,pDim), - dirLabel : varLabel[surfDir], - - surfIntVars : delete(surfVar,varsP), - surf_cvars : delete(surfVar, makelist(varsP[i],i,1,cdim)), - surf_vvars : delete(surfVar, makelist(varsP[cdim+i],i,1,vdim)), - - surfIntVarsC : delete(surfVar,varsC), - bSurfC : basisFromVars(basisFun,surfIntVarsC,polyOrder), - - if polyOrder = 1 then ( /* Force p=1 to use hybrid basis. */ - surfNodes : gaussOrdGkHyb(1+1, surf_cvars, surf_vvars), - nodeVars : surfIntVars, - bSurf : basisFromVars("gkhyb",surfIntVars,polyOrder), - basisNodal : getVarsNodalBasisWithNodesHyb("gkhyb", cdim-1, vdim, surfIntVars, surfNodes) - ) else ( - surfNodes : gaussOrd(polyOrder+1, pDim-1), - nodeVars : surfIntVars, - bSurf : basisFromVars(basisFun,surfIntVars,polyOrder) - ), - if cdim = 1 then ( - surfConfigNodes : [1] - ) - else ( - surfConfigNodes : gaussOrd(polyOrder+1, cdim-1) - ), - numSurfNodes : length(surfNodes), - numSurfConfigNodes : length(surfConfigNodes), - numVelNodes : numSurfNodes/numSurfConfigNodes, - numMuNodes : 1, - if vdim > 1 then ( numMuNodes : 2), - numVparNodes : numVelNodes/numMuNodes, - - print("Working on ", funcNm), - printf(fh, "GKYL_CU_DH double ~a( - const double *w, const double *dxv, - const double *vmap, const double *vmapSq, const double q_, const double m_, - const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, - const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, - const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%{ ~%", funcNm), - printf(fh, " // w[NDIM]: cell-center.~%"), - printf(fh, " // dxv[NDIM]: cell length.~%"), - printf(fh, " // vmap: velocity space mapping.~%"), - printf(fh, " // vmapSq: velocity space mapping squared.~%"), - printf(fh, " // q_,m_: species charge and mass.~%"), - printf(fh, " // dgs: surface DG geometry.~%"), - printf(fh, " // gkdgs: gyrokinetic surface DG geometry.~%"), - printf(fh, " // bmag: bmag represented on the surface.~%"), - printf(fh, " // jacobgeo_rat_surfL: Ratio of surface conf-space Jacobians in left cell.~%"), - printf(fh, " // jacobgeo_rat_surfR: Ratio of surface conf-space Jacobians in right cell.~%"), - printf(fh, " // phi: electrostatic potential.~%"), - printf(fh, " // JfL: distribution times total jacobian in left cell.~%"), - printf(fh, " // JfR: distribution times total jacobian in right cell.~%"), - printf(fh, " // flux_surf: output surface phase space flux in each direction (cdim + 1 components).~%"), - printf(fh, " // Note: Each cell owns their *lower* edge surface evaluation.~%"), - printf(fh, "~%"), - - /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru cdim+1 do ( - printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) - ), - printf(fh, "~%"), - rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), - rdSurfVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - /* Axisymmetric basis (independent of y). */ - bmagBasis : getAxisymmetricConfBasis(bC), - - /* Expand input fields for Hamiltonian calculation */ - phi_e : doExpand1(phi,bC), - bmagSurf_e : doExpand1(bmag, bmagBasis), - - /* Velocity mapping fields. */ - [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), - - /* Redefine vmap_prime to exploit the relationship between it and vmap. */ - /*vmap_prime_e : makelist((2/dxv[cdim+d-1])*diff(vmap_e[d],varsP[cdim+d]),d,1,vdim),*/ - vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), - - if edge = true then ( - evPoint : 1 - ) else ( - evPoint : -1 - ), - - /* Finally write out the hamiltonian*/ - hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], - if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmagSurf_e ), - hamil_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,hamil_e)), - printf(fh, " double hamil[~a] = {0.}; ~%", numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - hamilCvar : eval_string(sconcat("hamil")), - writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), - printf(fh, "~%"), - flush_output(fh), - hamilNoZero_c : makelistNoZeros1(hamil_c, hamilCvar), - /* Expand projected Hamiltonian on basis. */ - hamil_e : hamilNoZero_c . bSurf, - - /* fl and fr */ - JfL_e : doExpand1(JfL, bP), - JfR_e : doExpand1(JfR, bP), - JfL_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=1,JfL_e)), - JfR_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=-1,JfR_e)), - JfL_e : JfL_c . bSurf, - JfR_e : JfR_c . bSurf, - - if (mb_bound = true) then ( - /* Rescale ghost cell by ratio of the Jacobians at multiblock boundaries. */ - - if (edge = true) then ( - /* Upper boundary. */ - jacobgeo_rat_surfR_e : doExpand1(jacobgeo_rat_surfR, bSurfC), - - JfR_c : calcInnerProdList(surfIntVars, jacobgeo_rat_surfR_e, bSurf, JfR_e), - printf(fh, " double JRatfR[~a] = {0.}; ~%", length(bSurf)), - writeCExprsNoExpand1(JRatfR, fullratsimp(JfR_c)), - printf(fh, "~%"), - JfR_c : makelistNoZeros1(JfR_c, JRatfR), - JfR_e : doExpand(JfR_c, bSurf) - ) else ( - /* Lower boundary. */ - jacobgeo_rat_surfL_e : doExpand1(jacobgeo_rat_surfL, bSurfC), - - JfL_c : calcInnerProdList(surfIntVars, jacobgeo_rat_surfL_e, bSurf, JfL_e), - printf(fh, " double JRatfL[~a] = {0.}; ~%", length(bSurf)), - writeCExprsNoExpand1(JRatfL, fullratsimp(JfL_c)), - printf(fh, "~%"), - JfL_c : makelistNoZeros1(JfL_c, JRatfL), - JfL_e : doExpand(JfL_c, bSurf) - ) - ), - - JfL_nodes : gcfac(float(expand(evAtNodes(JfL_e,surfNodes,surfIntVars)))), - JfR_nodes : gcfac(float(expand(evAtNodes(JfR_e,surfNodes,surfIntVars)))), - - vmap_prime_nodes : float(evAtNodes(vmap_prime_e[1],surfNodes,surfIntVars)), - - vpardim : pDim-1, - if vdim = 1 then ( vpardim : pDim ), - dH_dz_nodes : makelist(0, i, 1, pDim), - for i : 1 thru vpardim do ( - if i = vpardim then ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e,varsP[i]),surfNodes,surfIntVars))/vmap_prime_nodes - ) - else ( - dH_dz_nodes[i] : float(evAtNodes(diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) - ) - ), - - mvpar_nodes : [], - for i : 1 thru numVparNodes do ( - mvpar_nodes : append(mvpar_nodes, [dH_dz_nodes[vpardim][i]]) - ), - - if surfDir = cdim then( - di3 : true - ) - else ( - di3 : false - ), - - /* Now calculate flux at all quadrature nodes */ - /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ - printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", length(bSurf)*(surfDir-1)), - printf(fh, " double cfl = 0.0; ~%"), - printf(fh, " double bmag_quad = 0.0; ~%"), - printf(fh, " double Jc_quad = 0.0; ~%"), - printf(fh, " double B3_quad = 0.0; ~%"), - printf(fh, " double normcurlbhat_quad = 0.0; ~%"), - printf(fh, " double area_elem_quad = 0.0; ~%"), - printf(fh, " double bhat_quad[3] = {0.0}; ~%"), - - printf(fh, " double alpha_quad = 0.0; ~%"), - printf(fh, " double JfL_quad = 0.0; ~%"), - printf(fh, " double JfR_quad = 0.0; ~%"), - printf(fh, " double Jfavg_quad = 0.0; ~%"), - printf(fh, " double Jfjump_quad = 0.0; ~%"), - - printf(fh, " double mvpar_quad[3] = {0.0}; ~%"), - for i : 1 thru numVparNodes do ( - printf(fh, " mvpar_quad[~a] = ~a; ~%", i-1, mvpar_nodes[i]) - ), - - printf(fh, " double mvparsq_quad[3] = {0.0}; ~%"), - for i : 1 thru numVparNodes do ( - printf(fh, " mvparsq_quad[~a] = mvpar_quad[~a]*mvpar_quad[~a]/m_; ~%", i-1, i-1,i-1) - ), - printf(fh, "~%"), - - for i : 1 thru numSurfConfigNodes do ( - printf(fh, " bmag_quad = gkdgs[~a].bmag; ~%", i-1), - printf(fh, " Jc_quad = gkdgs[~a].Jc; ~%", i-1), - printf(fh, " B3_quad = gkdgs[~a].B3; ~%", i-1), - printf(fh, " normcurlbhat_quad = gkdgs[~a].normcurlbhat; ~%", i-1), - printf(fh, " bhat_quad[0] = gkdgs[~a].bhat.x[0]; ~%", i-1), - printf(fh, " bhat_quad[1] = gkdgs[~a].bhat.x[1]; ~%", i-1), - printf(fh, " bhat_quad[2] = gkdgs[~a].bhat.x[2]; ~%", i-1), - printf(fh, " area_elem_quad = dgs[~a].area_elem; ~%", i-1), - printf(fh, "~%"), - for j : 1 thru numVelNodes do ( - j0index : j-1+(i-1)*numVelNodes, - j1index : j+(i-1)*numVelNodes, - vparindex : mod(j-1, numVparNodes) + 1, - vpar0index : mod(j-1, numVparNodes), - printf(fh, "~%"), - if no_by = true then ( - if di3 = true then ( - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad))*area_elem_quad/Jc_quad; ~%", vpar0index) - ) - else ( - printf(fh, " alpha_quad = 0.0; ~%") - ) - ), - if no_by = false then ( - /*printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) ;~%", vpar0index),*/ - if cdim = 3 then ( - if surfDir = 1 then( - printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[1]*(~a) - bhat_quad[2]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[3][j1index], dH_dz_nodes[2][j1index]) - ), - if surfDir = 2 then( - printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[2]*(~a) - bhat_quad[0]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[1][j1index], dH_dz_nodes[3][j1index]) - ), - if surfDir = 3 then( - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad) + mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[0]*(~a) - bhat_quad[1]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, vpar0index, dH_dz_nodes[2][j1index], dH_dz_nodes[1][j1index]) - ) - ), - if cdim = 2 then ( - if surfDir = 1 then( - printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[2][j1index]) - ), - if surfDir = 2 then( - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad) + mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * -bhat_quad[1]*(~a))*area_elem_quad/Jc_quad;~%", vpar0index, vpar0index, dH_dz_nodes[1][j1index]) - ) - ), - if cdim = 1 then ( - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad))*area_elem_quad/Jc_quad; ~%", vpar0index) - ) - ), - - printf(fh, "~%"), - /*printf(fh, " alpha_quad = alpha_quad*area_elem_quad/Jc_quad; ~%"),*/ - printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)); ~%"), - printf(fh, " JfL_quad = ~a; ~%", JfL_nodes[j1index]), - printf(fh, " JfR_quad = ~a; ~%", JfR_nodes[j1index]), - printf(fh, " Jfavg_quad = (JfL_quad + JfR_quad)/2.0; ~%"), - printf(fh, " Jfjump_quad = (JfR_quad - JfL_quad)/2.0; ~%"), - printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad - fabs(alpha_quad)*Jfjump_quad; ~%", j0index) - ), - printf(fh, "~%") - ), - - /* Do the quad nodal to modal ops directly here*/ - /*printf(fh, "~%"), - printf(fh, " double *fmodal = &flux_surf[~a]; ~%", length(bSurf)*(surfDir-1)), - flux_surf_nodal_e : doExpand1(flux_surf_nodal,basisNodal), - fmodproj_e : fullratsimp(calcInnerProdList(surfIntVars, 1, bSurf, flux_surf_nodal_e)), - - for i : 1 thru length(fmodproj_e) do ( - printf(fh, " fmodal[~a] = ~a; ~%", i-1, float(expand(fmodproj_e[i]))) - ), - - printf(fh, "~%"),*/ - - /*Calculate the cfl*/ - pOrderCFL : polyOrder, - printf(fh, "~%"), - printf(fh, " return cfl*~a; ~%", float(0.5*(2*pOrderCFL+1)*rdSurfVar2)), - - printf(fh, "~%"), - flush_output(fh), - printf(fh, "} ~%") - -)$ - - buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, mb_bound, scheme) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, From 8631b9a6dce2d09e9f1892be3f936a50aca97a44 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 17 Feb 2026 14:36:31 -0500 Subject: [PATCH 25/66] remove the EM in the surface flux routines since it's the only one now. --- .../gk_collisionless/gk_collisionless_flux-surf-conf.mac | 2 +- .../gk_collisionless/gk_collisionless_flux-surf-vpar.mac | 2 +- maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac | 8 ++++---- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 66e91d8c..8556e00a 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -6,7 +6,7 @@ load("utilities_gyrokinetic")$ load("nodal_operations/nodal_functions")$ fpprec : 24$ -buildGKFluxConfEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, mb_bound, scheme) := block( +buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, mb_bound, scheme) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,apar_e, diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index e025f622..74c5a8e2 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -5,7 +5,7 @@ load("scifac")$ load("utilities_gyrokinetic")$ fpprec : 24$ -buildGKFluxVparEMKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, add_apardot, scheme) := block( +buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, add_apardot, scheme) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index e3d86b4e..70096198 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -98,7 +98,7 @@ for bInd : 1 thru length(bName) do ( fh : openw(fname), printf(fh, "#include ~%"), funcName : sconcat("gk_collisionless_flux_",emStr,no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, "upwind"), + buildGKFluxConfKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, "upwind"), close(fh), if (em) then ( @@ -107,7 +107,7 @@ for bInd : 1 thru length(bName) do ( fh : openw(fname), printf(fh, "#include ~%"), funcName : sconcat("gk_collisionless_flux_em_star_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxConfEMKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, "upwind"), + buildGKFluxConfKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, "upwind"), close(fh) ) ) @@ -124,7 +124,7 @@ for bInd : 1 thru length(bName) do ( fh : openw(fname), printf(fh, "#include ~%"), funcName : sconcat("gk_collisionless_flux_",emStr,no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, "upwind"), + buildGKFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, "upwind"), close(fh), if (em) then ( @@ -135,7 +135,7 @@ for bInd : 1 thru length(bName) do ( fh : openw(fname), printf(fh, "#include ~%"), funcName : sconcat("gk_collisionless_flux_em_star_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxVparEMKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, "upwind"), + buildGKFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, "upwind"), close(fh) ) ) From bf20d444af4726442cf044deef8a55852348f059 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 17 Feb 2026 14:42:54 -0500 Subject: [PATCH 26/66] add error detection for the advection scheme --- .../g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac | 3 +++ .../g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac | 5 ++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 8556e00a..9ace3df7 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -327,6 +327,9 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad; ~%", j0index) ) else if scheme = "downwind" then ( printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad + fabs(alpha_quad)*Jfjump_quad; ~%", j0index) + ) else ( + /* Stop the script if an invalid scheme is provided. */ + error("Invalid flux scheme provided. Options are: upwind, central, downwind.") ) ), printf(fh, "~%") diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 74c5a8e2..1e183c4d 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -283,7 +283,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* Add apardot contribution if requested */ if add_apardot = true then ( apardot_e : doExpand1(apardot, bC), - apardot_nodes : float(evAtNodes(apardot_e,configNodes,surf_cvars)) + apardot_nodes : float(evAtNodes(apardot_e,configNodes,surf_cvars)), printf(fh, " alpha_quad += -q_/m_*(~a); ~%", apardot_nodes[i1index]) ), @@ -299,6 +299,9 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad; ~%", j0index) ) else if scheme = "downwind" then ( printf(fh, " flux_surf_nodal[~a] = alpha_quad*Jfavg_quad + fabs(alpha_quad)*Jfjump_quad; ~%", j0index) + ) else ( + /* Stop the script if an invalid scheme is provided. */ + error("Invalid flux scheme provided. Options are: upwind, central, downwind.") ) ), printf(fh, "~%") From 03fdd36fddb3e4d62c85821eb24d452812a898ef Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 19 Feb 2026 08:57:03 -0500 Subject: [PATCH 27/66] remove unused variables and streamline error handling for p>1 --- .../g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 1e183c4d..8bcccdd0 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -11,7 +11,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,NSurf,numNodes,apar_e,apar_nodes,dA_dx_nodes,k, + dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_nodes,dA_dx_nodes,k, apardot_e,apardot_nodes ], @@ -58,8 +58,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b NSurfIndexing : length(tempBasis), numNodesIndexing : length(tempBasis) ) else ( - NSurfIndexing : NSurf, - numNodesIndexing : numNodes + error("Only p=1 is currently supported for the surfvpar kernels.") ), print("Working on ", funcNm), From 0d518e156c704b41b448d87ec19ea8ed16559df5 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 19 Feb 2026 10:22:33 -0500 Subject: [PATCH 28/66] add apar_c to local variable list --- maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 9ace3df7..eae64208 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -14,7 +14,7 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL, - surfIntVarsC,bSurfC,hamilCvar,aparCvar,apar_nodes,dA_dx_nodes + surfIntVarsC,bSurfC,hamilCvar,aparCvar,apar_nodes,apar_c,dA_dx_nodes ], kill(varsC,varsP,bC,bP), From 79fa5a5ffee81e61c74ef35994a8c346bc2471d6 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 23 Feb 2026 09:21:40 -0500 Subject: [PATCH 29/66] Refactor a major part of the volume and conf flux kernels. We reuse as much as possible the precomputed geometric quantities like normcurlbhat_quad for surface flux and bioverJB_list for the volume computation. A comment in each script is added to point out the terms responsible to oscillations observed in the 3x2v Alfven testcase. The volume term builds an oscillation in n_e along y at longer time whereas the surface flux term creates a discontinuity in n_e along y at the first frame of the regression test. It is still unknown if these terms are the source of the 3x2v alfven issue or if they are triggered unphysically from other part of the code like the Helmholtz solver. --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 266 +++++++++++------- .../gk_collisionless_flux-surf-conf.mac | 6 +- 2 files changed, 175 insertions(+), 97 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index d3b28e2a..93e42e7c 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -11,8 +11,8 @@ load("utilities")$ fpprec : 24$ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( - [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, - bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, + [pdim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, + bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,vmap_e,BstardBmag_e, hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, @@ -21,12 +21,12 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := vmapSq_e,vmap_prime_e,hamilCvar,hamilNoZero_c,hamil_c,vpardim,i,k,curvdriftdir,clst], kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, + pdim : cdim+vdim, [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), numC : length(bC), numP : length(bP), - varLabel : makelist(string(varsP[d]),d,1,pDim), + varLabel : makelist(string(varsP[d]),d,1,pdim), print("Working on ", funcNm), printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, const double *vmap, const double *vmapSq, @@ -45,19 +45,19 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := printf(fh, "~%"), /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru pDim do ( + for d : 1 thru pdim do ( printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) ), printf(fh, "~%"), rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pdim), /* Declare variables with squared of cell centers and rdx2 variables (only need vpar^2). */ printf(fh, " double rdvpar2Sq = rdvpar2*rdvpar2;~%"), printf(fh, " double dvparSq = dxv[~a]*dxv[~a];~%", cdim, cdim), printf(fh, "~%"), replaceList : [rdvpar2^2=rdvpar2Sq,dxv[cdim]^2=dvparSq,rdvpar2Sq=4/dvparSq], - dvparSimp : append(makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pDim), + dvparSimp : append(makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pdim), [dvparSq=4/rdvpar2Sq]), /* Create pointers to the components of b_i. */ @@ -114,9 +114,9 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := Jf_e : doExpand1(fin,bP), /* Calculate expressions for dericatives of the hamiltonian*/ - vpardim : pDim-1, - if vdim = 1 then ( vpardim : pDim ), - dH_dz_e : makelist(0, i, 1, pDim), + vpardim : pdim-1, + if vdim = 1 then ( vpardim : pdim ), + dH_dz_e : makelist(0, i, 1, pdim), for i : 1 thru vpardim do ( if i = vpardim then ( dH_dz_e[i] : diff(hamil_e,varsP[i]) @@ -159,21 +159,25 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := dirVar : varsP[dir], /* Variable in current direction. */ if dir = cdim then ( - alpha_e : rtg33inv_e*dH_dz_e[vpardim]/vmap_prime_e[1]/m_ + alpha_e : rtg33inv_e*dH_dz_e[vpardim]/vmap_prime_e[1]/m_ /* Contribution from B_0 . dH/dvpar . ∇ψ in z*/ ) else if dir = vpardim then ( - alpha_e : -rtg33inv_e * dH_dz_e[cdim]/m_ + alpha_e : -rtg33inv_e * dH_dz_e[cdim]/m_ /* Contribution from B_0 . ∇H . dψ/dvpar in z */ ) else ( - alpha_e : 0 + alpha_e : 0 /* all other B_0 contributions are 0 since B_0_x,y = 0 */ ), if no_by = false then ( + + /* Add curvature drift terms (m vpar/q * ∇ x b)/mB = (m vpar * (∇ x b)/B)/qm */ if cdim = 3 then ( + /* Sum each directions */ curvdriftdir : dir ), if cdim = 2 then ( + /* Select only x and z */ if dir = 1 then ( curvdriftdir : dir ), @@ -182,12 +186,28 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := ) ), if cdim = 1 then ( + /* Select z */ curvdriftdir : 3 ), - if dir < vpardim then ( - alpha_e : alpha_e + dualcurlbhatoverB_list[curvdriftdir]*dH_dz_e[vpardim]/vmap_prime_e[1]*dH_dz_e[vpardim]/vmap_prime_e[1]/m_/q_ + /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ + alpha_e : alpha_e + mvpar_e*dualcurlbhatoverB_list[curvdriftdir] * dH_dz_e[vpardim]/vmap_prime_e[1] / (q_*m_) + ) else ( + /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ + if cdim = 3 then ( + for k : 1 thru cdim do ( + alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_list[k]*dH_dz_e[k]/(q_*m_) + ) + ), + if cdim = 2 then ( + alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_list[1] * dH_dz_e[1]/(q_*m_) - mvpar_e*dualcurlbhatoverB_list[3] * dH_dz_e[2]/(q_*m_) + ), + if cdim = 1 then ( + alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_list[3] * dH_dz_e[1]/(q_*m_) + ) ), + + /* Add b x ∇H / qB term (only in configuration space) */ if cdim = 3 then ( if dir = 1 then ( alpha_e : alpha_e + 1/q_ * (bioverJB_list[2]*dH_dz_e[3] - bioverJB_list[3]*dH_dz_e[2]) @@ -206,27 +226,13 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := if dir = 2 then ( alpha_e : alpha_e - 1/q_ * (bioverJB_list[2]*dH_dz_e[1]) ) - ), - if dir = vpardim then ( - if cdim = 3 then ( - for k : 1 thru cdim do ( - alpha_e : alpha_e - dualcurlbhatoverB_list[k]*dH_dz_e[k]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ - ) - ), - if cdim = 2 then ( - alpha_e : alpha_e - dualcurlbhatoverB_list[1]*dH_dz_e[1]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ - dualcurlbhatoverB_list[3]*dH_dz_e[2]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ - ), - if cdim = 1 then ( - alpha_e : alpha_e - dualcurlbhatoverB_list[3]*dH_dz_e[1]*dH_dz_e[vpardim]/vmap_prime_e[1]/q_/m_ - ) ) - ), if dir < vpardim then ( alpha_e : alpha_e*rdx2vec[dir] ) - else if dir = vpardim then ( + else ( alpha_e : alpha_e/vmap_prime_e[1] ), @@ -239,7 +245,7 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := alpha_c : subst(dvparSimp, alpha_c), alphaLabel : eval_string(sconcat(alpha, dirLabel)), clst : [rdx2vec, rdv2vec, m_, q_, wvpar, rdvpar2Sq, - makelist(dxv[i-1],i,1,pDim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], + makelist(dxv[i-1],i,1,pdim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], writeCExprsCollect1(alphaLabel, alpha_c, clst), printf(fh, "~%"), flush_output(fh), @@ -263,25 +269,28 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := )$ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( - [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, + [pdim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, + dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, + replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e,dim_idx_list, xidx, yidx, zidx, vidx, replaceList,dvparSimp,phi_e,bmag_e,rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,bioverJB_list, - vmapSq_e,vmap_prime_e,hamil_c,hamilCvar,hamilNoZero_c,vpardim,i,k,Apar_e, - dBperpoverB_x,dBperpoverB_y,dBperpoverB_z,dBperpoverB_list,curvdriftdir,clst], + dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e, dH_dx, dH_dy, dH_dz, dH_dvpar, gradH_vec, + vmapSq_e,vmap_prime_e,hamil_c,hamilCvar,hamilNoZero_c,vpardim,i,k,Apar_e, dA_dx, dA_dy, dA_dz, gradA_vec, + rotAbovermB_x,rotAbovermB_y,rotAbovermB_z,rotAbovermB_list, gradAxbhatoverB_x,gradAxbhatoverB_y,gradAxbhatoverB_z,gradAxbhatoverB_vec, + curvdriftdir,clst], kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, + pdim : cdim+vdim, [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), numC : length(bC), numP : length(bP), - varLabel : makelist(string(varsP[d]),d,1,pDim), + varLabel : makelist(string(varsP[d]),d,1,pdim), print("Working on ", funcNm), printf(fh, "GKYL_CU_DH double ~a(const double *w, const double *dxv, const double *vmap, const double *vmapSq, - const double q_, const double m_, const double *bmag, const double *jacobtot_inv, + const double q_, const double m_, const double *bmag, const double *jacobtot_inv, const double *dualcurlbhatoverB, const double *bioverJB, const double *b_i, const double *phi, const double *apar, const double *fin, double* GKYL_RESTRICT out) ~%{ ~%", funcNm), printf(fh, " // w[NDIM]: cell-center.~%"), printf(fh, " // dxv[NDIM]: cell length.~%"), @@ -290,6 +299,8 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by printf(fh, " // q_,m_: species charge and mass.~%"), printf(fh, " // bmag: magnetic field amplitude.~%"), printf(fh, " // jacobtot_inv: reciprocal of the conf-space jacobian time the guiding center coordinate Jacobian.~%"), + printf(fh, " // dualcurlbhatoverB: dual curl of bhat over B.~%"), + printf(fh, " // bioverJB: b_i over J times B.~%"), printf(fh, " // b_i: covariant components of the field aligned unit vector.~%"), printf(fh, " // apar: parallel component of magnetic vector potential.~%"), printf(fh, " // phi: electrostatic potential .~%"), @@ -298,33 +309,57 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by printf(fh, "~%"), /* Declare cell-center variables and variables multiplying gradients. */ - for d : 1 thru pDim do ( + for d : 1 thru pdim do ( printf(fh, " double rd~a2 = 2.0/dxv[~a];~%", varLabel[d], d-1) ), printf(fh, "~%"), rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pdim), /* Declare variables with squared of cell centers and rdx2 variables (only need vpar^2). */ - printf(fh, " double rdvpar2Sq = rdvpar2*rdvpar2;~%"), - printf(fh, " double dvparSq = dxv[~a]*dxv[~a];~%", cdim, cdim), + /* printf(fh, " double rdvpar2Sq = rdvpar2*rdvpar2;~%"), */ + /* printf(fh, " double dvparSq = dxv[~a]*dxv[~a];~%", cdim, cdim), */ printf(fh, "~%"), - replaceList : [rdvpar2^2=rdvpar2Sq,dxv[cdim]^2=dvparSq,rdvpar2Sq=4/dvparSq], - dvparSimp : append(makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pDim), + replaceList : [rdx^2=dx2Sq, rdy^2=dy2Sq, rdz^2=dx2Sq, rdvpar2^2=rdvpar2Sq,dxv[cdim]^2=dvparSq,rdvpar2Sq=4/dvparSq], + dvparSimp : append(makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pdim), [dvparSq=4/rdvpar2Sq]), + /* Store indices of the coordinate directions. */ + if cdim = 3 then ( + xidx : 1, yidx : 2, zidx : 3, vidx : 4 + ) else if cdim = 2 then ( + xidx : 1, zidx : 2, vidx : 3 + ) else if cdim = 1 then ( + zidx : 1, vidx : 2 + ), + + /* Create pointers to the components of b_i. */ allVarLabelsC : ["x","y","z"], for d : 1 thru 3 do ( printf(fh, " const double *b_~a = &b_i[~a];~%", allVarLabelsC[d], numC*(d-1)) ), printf(fh, "~%"), + for d : 1 thru 3 do ( + printf(fh, " const double *bioverJB_~a = &bioverJB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) + ), + printf(fh, "~%"), + + /* Create pointers to the components of dualcurlbhatoverB. */ + for d : 1 thru 3 do ( + printf(fh, " const double *dualcurlbhatoverB_~a = &dualcurlbhatoverB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) + ), + printf(fh, "~%"), + /* Axisymmetric basis (independent of y). */ bmagBasis : getAxisymmetricConfBasis(bC), /* Expand input fields for Hamiltonian calculation */ phi_e : doExpand1(phi,bC), bmag_e : doExpand1(bmag, bmagBasis), rtg33inv_e : doExpand1(rtg33inv, bmagBasis), + dualcurlbhatoverB_x_e : doExpand1(dualcurlbhatoverB_x, bmagBasis), + dualcurlbhatoverB_y_e : doExpand1(dualcurlbhatoverB_y, bmagBasis), + dualcurlbhatoverB_z_e : doExpand1(dualcurlbhatoverB_z, bmagBasis), bioverJB_x_e : doExpand1(bioverJB_x, bmagBasis), bioverJB_y_e : doExpand1(bioverJB_y, bmagBasis), bioverJB_z_e : doExpand1(bioverJB_z, bmagBasis), @@ -334,6 +369,7 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by b_z_e : doExpand1(b_z, bmagBasis), jacobTotInv_e : doExpand1(jacobtot_inv, bmagBasis), + dualcurlbhatoverB_list : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], bioverJB_list : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e], /* Velocity mapping fields. */ @@ -342,12 +378,12 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by /* Redefine vmap_prime to exploit the relationship between it and vmap. */ vmap_prime_e : makelist(diff(vmap_e[d],varsP[cdim+d]),d,1,vdim), - /* Finally write out the hamiltonian*/ + /* Write out the hamiltonian*/ hamil_e : q_*phi_e + (1/2)*m_*vmapSq_e[1], if vdim > 1 then ( hamil_e : hamil_e + vmap_e[2]*bmag_e ), hamil_c : calcInnerProdList(varsP, 1, bP, hamil_e), printf(fh, " double hamil[~a] = {0.}; ~%", numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, rdy2^2=rdy2Sq, rdz2^2=rdz2Sq, m_^2=mSq, q_^2=qSq], hamilCvar : eval_string(sconcat("hamil")), writeCExprsNoExpand1(hamilCvar, gcfac(float(expand(subst(replaceList, hamil_c))))), printf(fh, "~%"), @@ -360,9 +396,9 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by Jf_e : doExpand1(fin,bP), /* Calculate expressions for dericatives of the hamiltonian*/ - vpardim : pDim-1, - if vdim = 1 then ( vpardim : pDim ), - dH_dz_e : makelist(0, i, 1, pDim), + vpardim : pdim-1, + if vdim = 1 then ( vpardim : pdim ), + dH_dz_e : makelist(0, i, 1, pdim), for i : 1 thru vpardim do ( if i = vpardim then ( dH_dz_e[i] : diff(hamil_e,varsP[i]) @@ -371,6 +407,23 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by dH_dz_e[i] : diff(hamil_e*rdx2vec[i],varsP[i]) ) ), + dH_dvpar : diff(hamil_e,varsP[vpardim])/vmap_prime_e[1], /* We do not multply by rdv2vec because it is inside vmap_prime */ + if cdim = 3 then ( + dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), + dH_dy : diff(hamil_e*rdx2vec[yidx],varsP[yidx]), + dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), + gradH_vec : [dH_dx, dH_dy, dH_dz, dH_dvpar] + ) else if cdim = 2 then ( + dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), + dH_dy : 0, + dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), + gradH_vec : [dH_dx, dH_dz, dH_dvpar] + ) else if cdim = 1 then ( + dH_dx : 0, + dH_dy : 0, + dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), + gradH_vec : [dH_dz, dH_dvpar] + ), /*Make sure to avoid having hamil[i]^2 or vmap[i]^2 in expressions*/ replaceListVpar : [vmap[1]^2=vmap2], @@ -395,14 +448,55 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by printf(fh, "~%"), /* Expand Apar.*/ + /* Apar_e : subst(y=0, doExpand1(apar,bC)), */ Apar_e : doExpand1(apar,bC), /* Expand dBperp/Bmag. */ - dBperpoverB_x : (rdy2*diff(Apar_e*b_z_e,y) - rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e, - dBperpoverB_y : (rdz2*diff(Apar_e*b_x_e,z) - rdx2*diff(Apar_e*b_z_e,x))*jacobTotInv_e, - dBperpoverB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e, - dBperpoverB_list : [dBperpoverB_x, dBperpoverB_y, dBperpoverB_z], + /* Direct method ∇ x (Apar bhat) */ + rotAbovermB_x : (rdy2*diff(Apar_e*b_z_e,y) - rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e/m_, + rotAbovermB_y : (rdz2*diff(Apar_e*b_x_e,z) - rdx2*diff(Apar_e*b_z_e,x))*jacobTotInv_e/m_, + rotAbovermB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e/m_, + rotAbovermB_list : [rotAbovermB_x, rotAbovermB_y, rotAbovermB_z], + + /* Product rule method Apar ∇ x bhat + ∇Apar x bhat. */ + /* Calculate ∇Apar in a list */ + if cdim = 3 then ( + dA_dx : diff(Apar_e*rdx2vec[xidx],varsC[xidx]), + dA_dy : diff(Apar_e*rdx2vec[yidx],varsC[yidx]), + dA_dz : diff(Apar_e*rdx2vec[zidx],varsC[zidx]), + gradA_vec : [dA_dx, dA_dy, dA_dz] + ) else if cdim = 2 then ( + dA_dx : diff(Apar_e*rdx2vec[xidx],varsC[xidx]), + dA_dy : 0, + dA_dz : diff(Apar_e*rdx2vec[zidx],varsC[zidx]), + gradA_vec : [dA_dx, dA_dz] + ) else if cdim = 1 then ( + dA_dx : 0, + dA_dy : 0, + dA_dz : diff(Apar_e*rdx2vec[zidx],varsC[zidx]), + gradA_vec : [dA_dz] + ), + /* Use bioverJB to calculate ∇Apar x b / B in a list */ + if cdim = 3 then ( + gradAxbhatoverB_x : gradA_vec[yidx]*bioverJB_list[3] - gradA_vec[zidx]*bioverJB_list[2], + gradAxbhatoverB_y : gradA_vec[zidx]*bioverJB_list[1] - gradA_vec[xidx]*bioverJB_list[3], + gradAxbhatoverB_z : gradA_vec[xidx]*bioverJB_list[2] - gradA_vec[yidx]*bioverJB_list[1], + gradAxbhatoverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_y, gradAxbhatoverB_z] + ) else if cdim = 2 then ( + gradAxbhatoverB_x : -gradA_vec[zidx]*bioverJB_list[2], + gradAxbhatoverB_y : 0, + gradAxbhatoverB_z : +gradA_vec[xidx]*bioverJB_list[2], + gradAxbhatoverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_z] + ) else if cdim = 1 then ( + gradAxbhatoverB_x : 0, + gradAxbhatoverB_y : 0, + gradAxbhatoverB_z : 0, + gradAxbhatoverB_vec : [gradAxbhatoverB_z] + ), + + dim_idx_list : [3, 1, 2], + /* Note: no contribution from mu. */ for dir : 1 thru cdim+1 do ( @@ -416,46 +510,28 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by alpha_e : 0, if no_by = false then ( - if cdim = 3 then ( - curvdriftdir : dir - ), - if cdim = 2 then ( - if dir = 1 then ( - curvdriftdir : dir + if dir < vpardim then ( /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ + list_idx : dim_idx_list[dir], + /* This is [Apar . (∇ x b)/B + ∇Apar x b/B]/m dH/dvpar . ∇ψ */ + alpha_e : alpha_e + 1/m_ * Apar_e * dualcurlbhatoverB_list[list_idx] * gradH_vec[vpardim], + /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ + /* The oscillation builds up at longer time (not observable at frame 1). */ + alpha_e : alpha_e + 1/m_ * gradAxbhatoverB_vec[dir] * gradH_vec[vpardim], + /* basis function gradient ∇ψ factor */ + alpha_e : alpha_e*rdx2vec[dir] + ) else ( /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ + for k : 1 thru cdim do ( + list_idx : dim_idx_list[k], + /* this is [Apar . (∇ x b)/B]/m . ∇H * dψ/dvpar */ + alpha_e : alpha_e - 1/m_ * (Apar_e * dualcurlbhatoverB_list[list_idx]) * gradH_vec[k], + /* this is [∇Apar x b/B]/m . ∇H * dψ/dvpar */ + alpha_e : alpha_e - 1/m_ * gradAxbhatoverB_vec[k] * gradH_vec[k] ), - if dir = 2 then ( - curvdriftdir : 3 - ) - ), - if cdim = 1 then ( - curvdriftdir : 3 - ), - - if dir < vpardim then ( /* This is \rot(Apar b) dHdvpar \cdot \grad\psi from Rdot \cdot \grad\psi volume integrated */ - alpha_e : alpha_e + dBperpoverB_list[curvdriftdir]/m_ * mvpar_e - ), - if dir = vpardim then ( /* This is \rot(Apar b) \cdot \grad H from vpardot dpsi/dvpar volume integrated */ - if cdim = 3 then ( - for k : 1 thru cdim do ( - alpha_e : alpha_e - dBperpoverB_list[k]/m_ * dH_dz_e[k] - ) - ), - if cdim = 2 then ( - alpha_e : alpha_e - dBperpoverB_list[1]/m_ * dH_dz_e[1] - dBperpoverB_list[3]/m_ * dH_dz_e[2] - ), - if cdim = 1 then ( - alpha_e : alpha_e - dBperpoverB_list[3]/m_ * dH_dz_e[1] - ) + /* basis function gradient dψ/dvpar factor */ + alpha_e : alpha_e/vmap_prime_e[1] ) ), - if dir < vpardim then ( - alpha_e : alpha_e*rdx2vec[dir] - ) - else if dir = vpardim then ( - alpha_e : alpha_e/vmap_prime_e[1] - ), - /* Project alpha on basis and write to array. */ printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), @@ -465,7 +541,7 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by alpha_c : subst(dvparSimp, alpha_c), alphaLabel : eval_string(sconcat(alpha, dirLabel)), clst : [rdx2vec, rdv2vec, m_, q_, wvpar, rdvpar2Sq, - makelist(dxv[i-1],i,1,pDim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], + makelist(dxv[i-1],i,1,pdim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], writeCExprsCollect1(alphaLabel, alpha_c, clst), printf(fh, "~%"), flush_output(fh), @@ -489,7 +565,7 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by )$ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( - [pDim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, + [pdim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, hamil_e,pbAuxFlds,alphaSum_e,vd,vpardir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, @@ -497,12 +573,12 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no vmapSq_e,vmap_prime_e,apardot_e,clst], kill(varsC,varsP,bC,bP), - pDim : cdim+vdim, + pdim : cdim+vdim, [varsC,bC,varsP,bP,vSub] : loadGkBasis(basisFun, cdim, vdim, polyOrder), numC : length(bC), numP : length(bP), - varLabel : makelist(string(varsP[d]),d,1,pDim), + varLabel : makelist(string(varsP[d]),d,1,pdim), print("Working on ", funcNm), printf(fh, "GKYL_CU_DH double ~a(const double *vmap, const double q_, const double m_, const double *apardot, @@ -514,7 +590,7 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no printf(fh, "~%"), rdx2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,1,cdim), - rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pDim), + rdv2vec : makelist(eval_string(sconcat("rd",varLabel[i],"2")),i,cdim+1,pdim), /* Velocity mapping fields. */ @@ -538,7 +614,7 @@ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), alphaLabel : eval_string(sconcat(alpha, dirLabel)), clst : [rdx2vec, rdv2vec, m_, q_, wvpar, rdvpar2Sq, - makelist(dxv[i-1],i,1,pDim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], + makelist(dxv[i-1],i,1,pdim), makelist(vmap[i-1],i,1,2*length(vmap_e[1]))], writeCExprsCollect1(alphaLabel, alpha_c, clst), printf(fh, "~%"), flush_output(fh), diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index eae64208..dcc33e8e 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -205,7 +205,7 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b for i : 1 thru cdim do ( dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) ), - /* It will be used to compute the contribution as curl(Apar * bhat) = nabla Aparallel cross bhat + Aparallel * curl(bhat) */ + /* It will be used to compute the contribution as ∇ x (A b) = ∇A x b + A ∇ x b */ /* Now calculate flux at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ @@ -295,7 +295,9 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* grad(Aparallel) x b contribution*/ if cdim = 3 then ( if surfDir = 1 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) + /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ + /* The oscillation appears at short time (observable frame 1). */ + printf(fh, " alpha_quad += 0*mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) ), if surfDir = 2 then( printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) From 984a83c528d55d0767240d0cdeafcf696eb0aebb Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 23 Feb 2026 09:27:47 -0500 Subject: [PATCH 30/66] update scripts to be compatible with latest commit. --- .../gk_collisionless/ms-dg_gyrokinetic-header.mac | 2 +- .../gk_collisionless/ms-gk_collisionless_flux.mac | 13 +++++++++---- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac index de6ccedd..06c9a6de 100644 --- a/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac +++ b/maxima/g0/gk_collisionless/ms-dg_gyrokinetic-header.mac @@ -101,7 +101,7 @@ printPrototypes() := block([], for polyOrder : 1 thru maxPolyOrderB do ( printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_apar_vol_~ax~av_~a_p~a(const double *w, const double *dxv, const double *vmap, const double *vmapSq, const double q_, const double m_, - const double *bmag, const double *jacobtot_inv, + const double *bmag, const double *jacobtot_inv, const double *dualcurlbhatoverB, const double *bioverJB, const double *b_i, const double *phi, const double *apar, const double *fin, double* GKYL_RESTRICT out); ~%", c, v, bName[bInd], polyOrder), printf(fh, "GKYL_CU_DH double dg_gyrokinetic_add_apardot_vol_~ax~av_~a_p~a(const double *vmap, const double q_, const double m_, diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 70096198..8120b8e5 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -93,21 +93,23 @@ for bInd : 1 thru length(bName) do ( edge : edgeBool[edgeI], edgeStr : edgeOpt[edgeI], + scheme : "upwind", fname : sconcat(outputDir,"gk_collisionless_flux_",emStr,no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), disp(printf(false,"Creating ~a flux surf~a ~a ~a file: ~a",edgeStr,dirStr,no_byStr,mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), funcName : sconcat("gk_collisionless_flux_",emStr,no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxConfKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, "upwind"), + buildGKFluxConfKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, scheme), close(fh), if (em) then ( + scheme : "upwind", fname : sconcat(outputDir,"gk_collisionless_flux_em_star_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), disp(printf(false,"Creating ~a flux surf~a ~a ~a file: ~a",edgeStr,dirStr,no_byStr,mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), funcName : sconcat("gk_collisionless_flux_em_star_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxConfKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, "upwind"), + buildGKFluxConfKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, scheme), close(fh) ) ) @@ -119,23 +121,26 @@ for bInd : 1 thru length(bName) do ( edgeStr : edgeOpt[1], add_apardot : em, /* Add apardot term if EM. */ + scheme : "upwind", fname : sconcat(outputDir,"gk_collisionless_flux_",emStr,no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), funcName : sconcat("gk_collisionless_flux_",emStr,no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, "upwind"), + buildGKFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, scheme), close(fh), if (em) then ( /* Add EM terms but not Apardot (star term) */ add_apardot : false, + + scheme : "upwind", fname : sconcat(outputDir,"gk_collisionless_flux_em_star_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), disp(printf(false,"Creating flux surfvpar file: ~a",fname)), fh : openw(fname), printf(fh, "#include ~%"), funcName : sconcat("gk_collisionless_flux_em_star_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, "upwind"), + buildGKFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, scheme), close(fh) ) ) From 3cfa3f07b2e76db3f122a0724f3be8d503fa5af4 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 27 Feb 2026 11:40:49 -0500 Subject: [PATCH 31/66] remove the 0 coeff in front of a problematic term. --- maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index dcc33e8e..e9bef03c 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -297,7 +297,7 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b if surfDir = 1 then( /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ /* The oscillation appears at short time (observable frame 1). */ - printf(fh, " alpha_quad += 0*mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) ), if surfDir = 2 then( printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) From 371612045949d2141de701ac31ce25f1f8c664d1 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 6 Apr 2026 15:27:54 -0400 Subject: [PATCH 32/66] Refactor the elctrostatic volume term: we simplify the logic by precomputing the cross products and required gradients --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 132 ++++++++++++----------- 1 file changed, 68 insertions(+), 64 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 93e42e7c..38f5c94a 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -15,10 +15,12 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,vmap_e,BstardBmag_e, hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, - dH_dz_e, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, + alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, replaceList,dvparSimp,phi_e,bmag_e,dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e, rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,dualcurlbhatoverB_list,bioverJB_list, - vmapSq_e,vmap_prime_e,hamilCvar,hamilNoZero_c,hamil_c,vpardim,i,k,curvdriftdir,clst], + dualcurlbhatoverB_vec,bioverJB_vec,vmapSq_e,vmap_prime_e,hamilCvar,hamilNoZero_c,hamil_c, + xidx,yidx,zidx,vidx,vpardim,dH_dx,dH_dy,dH_dz,dH_dvpar,gradH_vec,gradH_list, + bcrossgradH_x,bcrossgradH_y,bcrossgradH_z,bcrossgradH_vec,bcrossgradH_list,i,k,curvdriftdir,clst], kill(varsC,varsP,bC,bP), pdim : cdim+vdim, @@ -60,6 +62,15 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := dvparSimp : append(makelist(dxv[i-1]=2/eval_string(sconcat("rd",varLabel[i],"2")),i,1,pdim), [dvparSq=4/rdvpar2Sq]), + /* Store indices of the coordinate directions. */ + if cdim = 3 then ( + xidx : 1, yidx : 2, zidx : 3, vidx : 4 + ) else if cdim = 2 then ( + xidx : 1, zidx : 2, vidx : 3 + ) else if cdim = 1 then ( + zidx : 1, vidx : 2 + ), + /* Create pointers to the components of b_i. */ allVarLabelsC : ["x","y","z"], for d : 1 thru 3 do ( @@ -89,6 +100,16 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := dualcurlbhatoverB_list : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], bioverJB_list : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e], + if cdim = 3 then ( + dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], + bioverJB_vec : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e] + ) else if cdim = 2 then ( + dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_z_e], + bioverJB_vec : [bioverJB_x_e, bioverJB_z_e] + ) else if cdim = 1 then ( + dualcurlbhatoverB_vec : [dualcurlbhatoverB_z_e], + bioverJB_vec : [bioverJB_z_e] + ), /* Velocity mapping fields. */ [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), @@ -116,22 +137,50 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := /* Calculate expressions for dericatives of the hamiltonian*/ vpardim : pdim-1, if vdim = 1 then ( vpardim : pdim ), - dH_dz_e : makelist(0, i, 1, pdim), - for i : 1 thru vpardim do ( - if i = vpardim then ( - dH_dz_e[i] : diff(hamil_e,varsP[i]) - ) - else ( - dH_dz_e[i] : diff(hamil_e*rdx2vec[i],varsP[i]) - ) + dH_dvpar : diff(hamil_e,varsP[vpardim])/vmap_prime_e[1], /* We do not multply by rdv2vec because it is inside vmap_prime */ + if cdim = 3 then ( + dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), + dH_dy : diff(hamil_e*rdx2vec[yidx],varsP[yidx]), + dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), + gradH_vec : [dH_dx, dH_dy, dH_dz, dH_dvpar] + ) else if cdim = 2 then ( + dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), + dH_dy : 0, + dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), + gradH_vec : [dH_dx, dH_dz, dH_dvpar] + ) else if cdim = 1 then ( + dH_dx : 0, + dH_dy : 0, + dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), + gradH_vec : [dH_dz, dH_dvpar] + ), + gradH_list : [dH_dx, dH_dy, dH_dz, dH_dvpar], + + if cdim = 3 then ( + bcrossgradH_x : (bioverJB_y_e*dH_dz - bioverJB_z_e*dH_dy), + bcrossgradH_y : (bioverJB_z_e*dH_dx - bioverJB_x_e*dH_dz), + bcrossgradH_z : (bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx), + bcrossgradH_vec : [bcrossgradH_x, bcrossgradH_y, bcrossgradH_z] + ) else if cdim = 2 then ( + bcrossgradH_x : bioverJB_y_e * dH_dz, + bcrossgradH_y : 0, + bcrossgradH_z : -bioverJB_y_e * dH_dx, + bcrossgradH_vec : [bcrossgradH_x, bcrossgradH_z] + ) else if cdim = 1 then ( + bcrossgradH_x : 0, + bcrossgradH_y : 0, + bcrossgradH_z : 0, + bcrossgradH_vec : [0] ), + bcrossgradH_list : [bcrossgradH_x, bcrossgradH_y, bcrossgradH_z], /*Make sure to avoid having hamil[i]^2 or vmap[i]^2 in expressions*/ replaceListVpar : [vmap[1]^2=vmap2], printf(fh, " double vmap2 = vmap[1]*vmap[1]; ~%"), printf(fh, "~%"), - mvpar_e : dH_dz_e[vpardim]/vmap_prime_e[1], + mvpar_e : dH_dvpar, + mvparsq_e : mvpar_e*mvpar_e/m_, isqlist : [], for i : 1 thru numP do ( @@ -159,73 +208,28 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := dirVar : varsP[dir], /* Variable in current direction. */ if dir = cdim then ( - alpha_e : rtg33inv_e*dH_dz_e[vpardim]/vmap_prime_e[1]/m_ /* Contribution from B_0 . dH/dvpar . ∇ψ in z*/ + alpha_e : rtg33inv_e * dH_dvpar / m_ /* Contribution from B_0 . dH/dvpar . ∇ψ in z*/ ) else if dir = vpardim then ( - alpha_e : -rtg33inv_e * dH_dz_e[cdim]/m_ /* Contribution from B_0 . ∇H . dψ/dvpar in z */ + alpha_e : -rtg33inv_e * gradH_vec[zidx]/m_ /* Contribution from B_0 . ∇H . dψ/dvpar in z */ ) else ( alpha_e : 0 /* all other B_0 contributions are 0 since B_0_x,y = 0 */ ), - if no_by = false then ( /* Add curvature drift terms (m vpar/q * ∇ x b)/mB = (m vpar * (∇ x b)/B)/qm */ - if cdim = 3 then ( - /* Sum each directions */ - curvdriftdir : dir - ), - if cdim = 2 then ( - /* Select only x and z */ - if dir = 1 then ( - curvdriftdir : dir - ), - if dir = 2 then ( - curvdriftdir : 3 - ) - ), - if cdim = 1 then ( - /* Select z */ - curvdriftdir : 3 - ), if dir < vpardim then ( /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ - alpha_e : alpha_e + mvpar_e*dualcurlbhatoverB_list[curvdriftdir] * dH_dz_e[vpardim]/vmap_prime_e[1] / (q_*m_) + alpha_e : alpha_e + mvpar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar / (q_*m_), + /* Add b x ∇H / qB term (only in configuration space) */ + alpha_e : alpha_e + 1/q_ * bcrossgradH_vec[dir] ) else ( /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ - if cdim = 3 then ( - for k : 1 thru cdim do ( - alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_list[k]*dH_dz_e[k]/(q_*m_) - ) - ), - if cdim = 2 then ( - alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_list[1] * dH_dz_e[1]/(q_*m_) - mvpar_e*dualcurlbhatoverB_list[3] * dH_dz_e[2]/(q_*m_) - ), - if cdim = 1 then ( - alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_list[3] * dH_dz_e[1]/(q_*m_) - ) - ), - - /* Add b x ∇H / qB term (only in configuration space) */ - if cdim = 3 then ( - if dir = 1 then ( - alpha_e : alpha_e + 1/q_ * (bioverJB_list[2]*dH_dz_e[3] - bioverJB_list[3]*dH_dz_e[2]) - ), - if dir = 2 then ( - alpha_e : alpha_e + 1/q_ * (bioverJB_list[3]*dH_dz_e[1] - bioverJB_list[1]*dH_dz_e[3]) - ), - if dir = 3 then ( - alpha_e : alpha_e + 1/q_ * (bioverJB_list[1]*dH_dz_e[2] - bioverJB_list[2]*dH_dz_e[1]) - ) - ), - if cdim = 2 then ( - if dir = 1 then ( - alpha_e : alpha_e + 1/q_ * (bioverJB_list[2]*dH_dz_e[2]) - ), - if dir = 2 then ( - alpha_e : alpha_e - 1/q_ * (bioverJB_list[2]*dH_dz_e[1]) - ) + for k : 1 thru cdim do ( + alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_vec[k]*gradH_vec[k]/(q_*m_) + ) ) ), From b3173d2a9f2ec56c7709d99ac8df2b2d2ef14c2d Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 6 Apr 2026 15:30:10 -0400 Subject: [PATCH 33/66] The normalization by the basis gradient seemed to be misplaced in the EM terms compared to the ES terms. Does not look like it solves the oscillation issue though :( --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 33 ++++++++++++++++-------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 38f5c94a..721100eb 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -375,6 +375,16 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by dualcurlbhatoverB_list : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], bioverJB_list : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e], + if cdim = 3 then ( + dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], + bioverJB_vec : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e] + ) else if cdim = 2 then ( + dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_z_e], + bioverJB_vec : [bioverJB_x_e, bioverJB_z_e] + ) else if cdim = 1 then ( + dualcurlbhatoverB_vec : [dualcurlbhatoverB_z_e], + bioverJB_vec : [bioverJB_z_e] + ), /* Velocity mapping fields. */ [vmap_e,vmapSq_e,vmap_prime_e] : expandVmapFields(varsP), @@ -434,7 +444,7 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by printf(fh, " double vmap2 = vmap[1]*vmap[1]; ~%"), printf(fh, "~%"), - mvpar_e : dH_dz_e[vpardim]/vmap_prime_e[1], + mvpar_e : dH_dvpar, mvparsq_e : mvpar_e*mvpar_e/m_, isqlist : [], for i : 1 thru numP do ( @@ -515,27 +525,28 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by if no_by = false then ( if dir < vpardim then ( /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ - list_idx : dim_idx_list[dir], /* This is [Apar . (∇ x b)/B + ∇Apar x b/B]/m dH/dvpar . ∇ψ */ - alpha_e : alpha_e + 1/m_ * Apar_e * dualcurlbhatoverB_list[list_idx] * gradH_vec[vpardim], + alpha_e : alpha_e + 1/m_ * Apar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar, /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ /* The oscillation builds up at longer time (not observable at frame 1). */ - alpha_e : alpha_e + 1/m_ * gradAxbhatoverB_vec[dir] * gradH_vec[vpardim], - /* basis function gradient ∇ψ factor */ - alpha_e : alpha_e*rdx2vec[dir] + alpha_e : alpha_e + 1/m_ * gradAxbhatoverB_vec[dir] * dH_dvpar ) else ( /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ for k : 1 thru cdim do ( - list_idx : dim_idx_list[k], /* this is [Apar . (∇ x b)/B]/m . ∇H * dψ/dvpar */ - alpha_e : alpha_e - 1/m_ * (Apar_e * dualcurlbhatoverB_list[list_idx]) * gradH_vec[k], + alpha_e : alpha_e - 1/m_ * (Apar_e * dualcurlbhatoverB_vec[k]) * gradH_vec[k], /* this is [∇Apar x b/B]/m . ∇H * dψ/dvpar */ alpha_e : alpha_e - 1/m_ * gradAxbhatoverB_vec[k] * gradH_vec[k] - ), - /* basis function gradient dψ/dvpar factor */ - alpha_e : alpha_e/vmap_prime_e[1] + ) ) ), + if dir < vpardim then ( + alpha_e : alpha_e*rdx2vec[dir] + ) + else ( + alpha_e : alpha_e/vmap_prime_e[1] + ), + /* Project alpha on basis and write to array. */ printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), From 6474b52daf0874ab0e46ad67b22e51f1d07efb6a Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 6 Apr 2026 15:44:38 -0400 Subject: [PATCH 34/66] clean useless parenthesis --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 721100eb..303e9d71 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -157,9 +157,9 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := gradH_list : [dH_dx, dH_dy, dH_dz, dH_dvpar], if cdim = 3 then ( - bcrossgradH_x : (bioverJB_y_e*dH_dz - bioverJB_z_e*dH_dy), - bcrossgradH_y : (bioverJB_z_e*dH_dx - bioverJB_x_e*dH_dz), - bcrossgradH_z : (bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx), + bcrossgradH_x : bioverJB_y_e*dH_dz - bioverJB_z_e*dH_dy, + bcrossgradH_y : bioverJB_z_e*dH_dx - bioverJB_x_e*dH_dz, + bcrossgradH_z : bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx, bcrossgradH_vec : [bcrossgradH_x, bcrossgradH_y, bcrossgradH_z] ) else if cdim = 2 then ( bcrossgradH_x : bioverJB_y_e * dH_dz, From 73591a074e9333014b19129da58a11c6ff54e1bd Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 6 Apr 2026 17:31:51 -0400 Subject: [PATCH 35/66] Refactoring and try to make the code clearer to spot any mistake, the output is the same, still don't find a reason for the spurious oscillations --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 106 +++++++++++------------ 1 file changed, 52 insertions(+), 54 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 303e9d71..ccc47711 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -19,8 +19,8 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := replaceList,dvparSimp,phi_e,bmag_e,dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e, rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,dualcurlbhatoverB_list,bioverJB_list, dualcurlbhatoverB_vec,bioverJB_vec,vmapSq_e,vmap_prime_e,hamilCvar,hamilNoZero_c,hamil_c, - xidx,yidx,zidx,vidx,vpardim,dH_dx,dH_dy,dH_dz,dH_dvpar,gradH_vec,gradH_list, - bcrossgradH_x,bcrossgradH_y,bcrossgradH_z,bcrossgradH_vec,bcrossgradH_list,i,k,curvdriftdir,clst], + xidx,yidx,zidx,vidx,vpardim,dH_dx,dH_dy,dH_dz,dH_dvpar,gradH_vec, + boverBxgradH_x,boverBxgradH_y,boverBxgradH_z,boverBxgradH_vec,i,k,curvdriftdir,clst], kill(varsC,varsP,bC,bP), pdim : cdim+vdim, @@ -142,37 +142,32 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), dH_dy : diff(hamil_e*rdx2vec[yidx],varsP[yidx]), dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), - gradH_vec : [dH_dx, dH_dy, dH_dz, dH_dvpar] + gradH_vec : [dH_dx, dH_dy, dH_dz] ) else if cdim = 2 then ( dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), dH_dy : 0, dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), - gradH_vec : [dH_dx, dH_dz, dH_dvpar] + gradH_vec : [dH_dx, dH_dz] ) else if cdim = 1 then ( dH_dx : 0, dH_dy : 0, dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), - gradH_vec : [dH_dz, dH_dvpar] + gradH_vec : [dH_dz] ), - gradH_list : [dH_dx, dH_dy, dH_dz, dH_dvpar], if cdim = 3 then ( - bcrossgradH_x : bioverJB_y_e*dH_dz - bioverJB_z_e*dH_dy, - bcrossgradH_y : bioverJB_z_e*dH_dx - bioverJB_x_e*dH_dz, - bcrossgradH_z : bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx, - bcrossgradH_vec : [bcrossgradH_x, bcrossgradH_y, bcrossgradH_z] + boverBxgradH_x : bioverJB_y_e*dH_dz - bioverJB_z_e*dH_dy, + boverBxgradH_y : bioverJB_z_e*dH_dx - bioverJB_x_e*dH_dz, + boverBxgradH_z : bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx, + boverBxgradH_vec : [boverBxgradH_x, boverBxgradH_y, boverBxgradH_z] ) else if cdim = 2 then ( - bcrossgradH_x : bioverJB_y_e * dH_dz, - bcrossgradH_y : 0, - bcrossgradH_z : -bioverJB_y_e * dH_dx, - bcrossgradH_vec : [bcrossgradH_x, bcrossgradH_z] + boverBxgradH_x : bioverJB_y_e*dH_dz - bioverJB_z_e*dH_dy, + boverBxgradH_z : bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx, + boverBxgradH_vec : [boverBxgradH_x, boverBxgradH_z] ) else if cdim = 1 then ( - bcrossgradH_x : 0, - bcrossgradH_y : 0, - bcrossgradH_z : 0, - bcrossgradH_vec : [0] + boverBxgradH_z : bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx, + boverBxgradH_vec : [boverBxgradH_z] ), - bcrossgradH_list : [bcrossgradH_x, bcrossgradH_y, bcrossgradH_z], /*Make sure to avoid having hamil[i]^2 or vmap[i]^2 in expressions*/ replaceListVpar : [vmap[1]^2=vmap2], @@ -224,7 +219,7 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ alpha_e : alpha_e + mvpar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar / (q_*m_), /* Add b x ∇H / qB term (only in configuration space) */ - alpha_e : alpha_e + 1/q_ * bcrossgradH_vec[dir] + alpha_e : alpha_e + 1/q_ * boverBxgradH_vec[dir] ) else ( /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ for k : 1 thru cdim do ( @@ -276,12 +271,12 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by [pdim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, alphaJf_e, Jf_e, - replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e,dim_idx_list, xidx, yidx, zidx, vidx, + dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, alphaJf_e, Jf_e, + replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, xidx, yidx, zidx, vidx, replaceList,dvparSimp,phi_e,bmag_e,rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,bioverJB_list, dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e, dH_dx, dH_dy, dH_dz, dH_dvpar, gradH_vec, vmapSq_e,vmap_prime_e,hamil_c,hamilCvar,hamilNoZero_c,vpardim,i,k,Apar_e, dA_dx, dA_dy, dA_dz, gradA_vec, - rotAbovermB_x,rotAbovermB_y,rotAbovermB_z,rotAbovermB_list, gradAxbhatoverB_x,gradAxbhatoverB_y,gradAxbhatoverB_z,gradAxbhatoverB_vec, + rotAbovermB_x,rotAbovermB_y,rotAbovermB_z,rotAbovermB_vec, gradAxbhatoverB_x,gradAxbhatoverB_y,gradAxbhatoverB_z,gradAxbhatoverB_vec, curvdriftdir,clst], kill(varsC,varsP,bC,bP), @@ -412,15 +407,6 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by /* Calculate expressions for dericatives of the hamiltonian*/ vpardim : pdim-1, if vdim = 1 then ( vpardim : pdim ), - dH_dz_e : makelist(0, i, 1, pdim), - for i : 1 thru vpardim do ( - if i = vpardim then ( - dH_dz_e[i] : diff(hamil_e,varsP[i]) - ) - else ( - dH_dz_e[i] : diff(hamil_e*rdx2vec[i],varsP[i]) - ) - ), dH_dvpar : diff(hamil_e,varsP[vpardim])/vmap_prime_e[1], /* We do not multply by rdv2vec because it is inside vmap_prime */ if cdim = 3 then ( dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), @@ -467,49 +453,53 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by /* Expand dBperp/Bmag. */ /* Direct method ∇ x (Apar bhat) */ - rotAbovermB_x : (rdy2*diff(Apar_e*b_z_e,y) - rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e/m_, - rotAbovermB_y : (rdz2*diff(Apar_e*b_x_e,z) - rdx2*diff(Apar_e*b_z_e,x))*jacobTotInv_e/m_, - rotAbovermB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e/m_, - rotAbovermB_list : [rotAbovermB_x, rotAbovermB_y, rotAbovermB_z], + if cdim = 3 then ( + rotAbovermB_x : (rdy2*diff(Apar_e*b_z_e,y) - rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e/m_, + rotAbovermB_y : (rdz2*diff(Apar_e*b_x_e,z) - rdx2*diff(Apar_e*b_z_e,x))*jacobTotInv_e/m_, + rotAbovermB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e/m_, + rotAbovermB_vec : [rotAbovermB_x, rotAbovermB_y, rotAbovermB_z] + ) else if cdim = 2 then ( + rotAbovermB_x : (rdy2*diff(Apar_e*b_z_e,y) - rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e/m_, + rotAbovermB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e/m_, + rotAbovermB_vec : [rotAbovermB_x, rotAbovermB_z] + ) else if cdim = 1 then ( + rotAbovermB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e/m_, + rotAbovermB_vec : [rotAbovermB_z] + ), /* Product rule method Apar ∇ x bhat + ∇Apar x bhat. */ /* Calculate ∇Apar in a list */ if cdim = 3 then ( - dA_dx : diff(Apar_e*rdx2vec[xidx],varsC[xidx]), - dA_dy : diff(Apar_e*rdx2vec[yidx],varsC[yidx]), - dA_dz : diff(Apar_e*rdx2vec[zidx],varsC[zidx]), + dA_dx : diff(Apar_e*rdx2vec[xidx],varsP[xidx]), + dA_dy : diff(Apar_e*rdx2vec[yidx],varsP[yidx]), + dA_dz : diff(Apar_e*rdx2vec[zidx],varsP[zidx]), gradA_vec : [dA_dx, dA_dy, dA_dz] ) else if cdim = 2 then ( - dA_dx : diff(Apar_e*rdx2vec[xidx],varsC[xidx]), + dA_dx : diff(Apar_e*rdx2vec[xidx],varsP[xidx]), dA_dy : 0, - dA_dz : diff(Apar_e*rdx2vec[zidx],varsC[zidx]), + dA_dz : diff(Apar_e*rdx2vec[zidx],varsP[zidx]), gradA_vec : [dA_dx, dA_dz] ) else if cdim = 1 then ( dA_dx : 0, dA_dy : 0, - dA_dz : diff(Apar_e*rdx2vec[zidx],varsC[zidx]), + dA_dz : diff(Apar_e*rdx2vec[zidx],varsP[zidx]), gradA_vec : [dA_dz] ), /* Use bioverJB to calculate ∇Apar x b / B in a list */ if cdim = 3 then ( - gradAxbhatoverB_x : gradA_vec[yidx]*bioverJB_list[3] - gradA_vec[zidx]*bioverJB_list[2], - gradAxbhatoverB_y : gradA_vec[zidx]*bioverJB_list[1] - gradA_vec[xidx]*bioverJB_list[3], - gradAxbhatoverB_z : gradA_vec[xidx]*bioverJB_list[2] - gradA_vec[yidx]*bioverJB_list[1], + gradAxbhatoverB_x : dA_dy*bioverJB_z_e - dA_dz*bioverJB_y_e, + gradAxbhatoverB_y : dA_dz*bioverJB_x_e - dA_dx*bioverJB_z_e, + gradAxbhatoverB_z : dA_dx*bioverJB_y_e - dA_dy*bioverJB_x_e, gradAxbhatoverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_y, gradAxbhatoverB_z] ) else if cdim = 2 then ( - gradAxbhatoverB_x : -gradA_vec[zidx]*bioverJB_list[2], - gradAxbhatoverB_y : 0, - gradAxbhatoverB_z : +gradA_vec[xidx]*bioverJB_list[2], + gradAxbhatoverB_x : dA_dy*bioverJB_z_e - dA_dz*bioverJB_y_e, + gradAxbhatoverB_z : dA_dx*bioverJB_y_e - dA_dy*bioverJB_x_e, gradAxbhatoverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_z] ) else if cdim = 1 then ( - gradAxbhatoverB_x : 0, - gradAxbhatoverB_y : 0, - gradAxbhatoverB_z : 0, + gradAxbhatoverB_z : dA_dx*bioverJB_y_e - dA_dy*bioverJB_x_e, gradAxbhatoverB_vec : [gradAxbhatoverB_z] ), - - dim_idx_list : [3, 1, 2], /* Note: no contribution from mu. */ for dir : 1 thru cdim+1 do ( @@ -525,17 +515,25 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by if no_by = false then ( if dir < vpardim then ( /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ - /* This is [Apar . (∇ x b)/B + ∇Apar x b/B]/m dH/dvpar . ∇ψ */ + /* This is [Apar . (∇ x b)/B]/m dH/dvpar . ∇ψ */ alpha_e : alpha_e + 1/m_ * Apar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar, + /* This is [∇Apar x b/B]/m dH/dvpar . ∇ψ */ /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ /* The oscillation builds up at longer time (not observable at frame 1). */ alpha_e : alpha_e + 1/m_ * gradAxbhatoverB_vec[dir] * dH_dvpar + + /* Single term version ∇ x (Apar b)/m */ + /* alpha_e : alpha_e + rotAbovermB_vec[dir] * dH_dvpar */ + ) else ( /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ for k : 1 thru cdim do ( /* this is [Apar . (∇ x b)/B]/m . ∇H * dψ/dvpar */ alpha_e : alpha_e - 1/m_ * (Apar_e * dualcurlbhatoverB_vec[k]) * gradH_vec[k], /* this is [∇Apar x b/B]/m . ∇H * dψ/dvpar */ alpha_e : alpha_e - 1/m_ * gradAxbhatoverB_vec[k] * gradH_vec[k] + + /* Single term version ∇ x (Apar b) */ + /* alpha_e : alpha_e - rotAbovermB_vec[k] * gradH_vec[k] */ ) ) ), From b283b41b1216e6a08ebb120e7c0f219e18b3aef9 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 7 Apr 2026 10:37:42 -0400 Subject: [PATCH 36/66] cleaning of the volume kernels and introduction of gradpsi and dpsidvpar to make the equation more visible. --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 121 +++++++++++------------ 1 file changed, 59 insertions(+), 62 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index ccc47711..5374beee 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -11,16 +11,15 @@ load("utilities")$ fpprec : 24$ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( - [pdim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, - bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,vmap_e,BstardBmag_e, - hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, - alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, - replaceList,dvparSimp,phi_e,bmag_e,dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e, - rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,dualcurlbhatoverB_list,bioverJB_list, - dualcurlbhatoverB_vec,bioverJB_vec,vmapSq_e,vmap_prime_e,hamilCvar,hamilNoZero_c,hamil_c, - xidx,yidx,zidx,vidx,vpardim,dH_dx,dH_dy,dH_dz,dH_dvpar,gradH_vec, - boverBxgradH_x,boverBxgradH_y,boverBxgradH_z,boverBxgradH_vec,i,k,curvdriftdir,clst], + [pdim,varsC,bC,varsP,bP,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, + bmagBasis,vmap_e,hamil_e,dir,dirLabel,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,volTerm_c, + alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,isqlist,mvpar_e,mvparsq_e, + replaceList,dvparSimp,phi_e,bmag_e,rtg33inv_e, + dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e,dualcurlbhatoverB_vec, + bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,bioverJB_vec, + vmapSq_e,vmap_prime_e,hamilCvar,hamilNoZero_c,hamil_c, + xidx,yidx,zidx,vidx,vpardim,dH_dx,dH_dy,dH_dz,dH_dvpar,gradH_vec, gradpsi, dpsidvpar, + boverBxgradH_x,boverBxgradH_y,boverBxgradH_z,boverBxgradH_vec,i,k,clst], kill(varsC,varsP,bC,bP), pdim : cdim+vdim, @@ -98,8 +97,6 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := bioverJB_y_e : doExpand1(bioverJB_y, bmagBasis), bioverJB_z_e : doExpand1(bioverJB_z, bmagBasis), - dualcurlbhatoverB_list : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], - bioverJB_list : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e], if cdim = 3 then ( dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], bioverJB_vec : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e] @@ -192,21 +189,20 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := ), printf(fh, "~%"), + /* Auxiliary variables to improve reading */ + gradpsi : rdx2vec, + dpsidvpar : 1 / vmap_prime_e[1], + /* Note: no contribution from mu. */ for dir : 1 thru cdim+1 do ( - dirLabel : varLabel[dir], - - wDir : eval_string(sconcat("w",dirLabel)), - rdDirVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - dirVar : varsP[dir], /* Variable in current direction. */ + dirLabel : varLabel[dir], if dir = cdim then ( - alpha_e : rtg33inv_e * dH_dvpar / m_ /* Contribution from B_0 . dH/dvpar . ∇ψ in z*/ + alpha_e : rtg33inv_e * dH_dvpar / m_ * gradpsi[dir] /* Contribution from B_0 . dH/dvpar . ∇ψ in z*/ ) else if dir = vpardim then ( - alpha_e : -rtg33inv_e * gradH_vec[zidx]/m_ /* Contribution from B_0 . ∇H . dψ/dvpar in z */ + alpha_e : -rtg33inv_e * gradH_vec[zidx]/m_ * dpsidvpar /* Contribution from B_0 . ∇H . dψ/dvpar in z */ ) else ( alpha_e : 0 /* all other B_0 contributions are 0 since B_0_x,y = 0 */ @@ -217,23 +213,23 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := /* Add curvature drift terms (m vpar/q * ∇ x b)/mB = (m vpar * (∇ x b)/B)/qm */ if dir < vpardim then ( /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ - alpha_e : alpha_e + mvpar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar / (q_*m_), + alpha_e : alpha_e + mvpar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar / (q_*m_) * gradpsi[dir], /* Add b x ∇H / qB term (only in configuration space) */ - alpha_e : alpha_e + 1/q_ * boverBxgradH_vec[dir] + alpha_e : alpha_e + 1/q_ * boverBxgradH_vec[dir] * gradpsi[dir] ) else ( /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ for k : 1 thru cdim do ( - alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_vec[k]*gradH_vec[k]/(q_*m_) + alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_vec[k]*gradH_vec[k]/(q_*m_) * dpsidvpar ) ) ), - if dir < vpardim then ( + /* if dir < vpardim then ( alpha_e : alpha_e*rdx2vec[dir] ) else ( - alpha_e : alpha_e/vmap_prime_e[1] - ), + alpha_e : alpha_e + ), */ /* Project alpha on basis and write to array. */ printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), @@ -267,17 +263,32 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := )$ + + + + + + + + + + + + + + + + addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( - [pdim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, - bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, - hamil_e,pbAuxFlds,alphaSum_e,vd,dir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, alphaJf_e, Jf_e, - replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, xidx, yidx, zidx, vidx, - replaceList,dvparSimp,phi_e,bmag_e,rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,bioverJB_list, - dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e, dH_dx, dH_dy, dH_dz, dH_dvpar, gradH_vec, + [pdim,varsC,bC,varsP,bP,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, + bmagBasis,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,hamil_e,dir,dirLabel,gradpsi, dpsidvpar, + alpha_e,alpha_c,alphaLabel,alphaNoZero_c,volTerm_c, alphaJf_e, Jf_e, + replaceListHamil, replaceListVpar,isqlist,mvpar_e,mvparsq_e, xidx, yidx, zidx, vidx, + replaceList,dvparSimp,phi_e,bmag_e,rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,bioverJB_vec, + dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e,dualcurlbhatoverB_vec, dH_dx, dH_dy, dH_dz, dH_dvpar, gradH_vec, vmapSq_e,vmap_prime_e,hamil_c,hamilCvar,hamilNoZero_c,vpardim,i,k,Apar_e, dA_dx, dA_dy, dA_dz, gradA_vec, rotAbovermB_x,rotAbovermB_y,rotAbovermB_z,rotAbovermB_vec, gradAxbhatoverB_x,gradAxbhatoverB_y,gradAxbhatoverB_z,gradAxbhatoverB_vec, - curvdriftdir,clst], + clst], kill(varsC,varsP,bC,bP), pdim : cdim+vdim, @@ -368,8 +379,6 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by b_z_e : doExpand1(b_z, bmagBasis), jacobTotInv_e : doExpand1(jacobtot_inv, bmagBasis), - dualcurlbhatoverB_list : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], - bioverJB_list : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e], if cdim = 3 then ( dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], bioverJB_vec : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e] @@ -501,50 +510,41 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by gradAxbhatoverB_vec : [gradAxbhatoverB_z] ), + /* Auxiliary variables to improve reading */ + gradpsi : rdx2vec, + dpsidvpar : 1 / vmap_prime_e[1], + /* Note: no contribution from mu. */ for dir : 1 thru cdim+1 do ( dirLabel : varLabel[dir], - - wDir : eval_string(sconcat("w",dirLabel)), - rdDirVar2 : eval_string(sconcat("rd",dirLabel,"2")), - - dirVar : varsP[dir], /* Variable in current direction. */ - alpha_e : 0, if no_by = false then ( if dir < vpardim then ( /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ /* This is [Apar . (∇ x b)/B]/m dH/dvpar . ∇ψ */ - alpha_e : alpha_e + 1/m_ * Apar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar, + alpha_e : alpha_e + 1/m_ * Apar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar * gradpsi[dir], /* This is [∇Apar x b/B]/m dH/dvpar . ∇ψ */ /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ /* The oscillation builds up at longer time (not observable at frame 1). */ - alpha_e : alpha_e + 1/m_ * gradAxbhatoverB_vec[dir] * dH_dvpar + alpha_e : alpha_e + 1/m_ * gradAxbhatoverB_vec[dir] * dH_dvpar * gradpsi[dir] /* Single term version ∇ x (Apar b)/m */ - /* alpha_e : alpha_e + rotAbovermB_vec[dir] * dH_dvpar */ + /* alpha_e : alpha_e + rotAbovermB_vec[dir] * dH_dvpar * gradpsi[dir] */ ) else ( /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ for k : 1 thru cdim do ( /* this is [Apar . (∇ x b)/B]/m . ∇H * dψ/dvpar */ - alpha_e : alpha_e - 1/m_ * (Apar_e * dualcurlbhatoverB_vec[k]) * gradH_vec[k], + alpha_e : alpha_e - 1/m_ * (Apar_e * dualcurlbhatoverB_vec[k]) * gradH_vec[k] * dpsidvpar, /* this is [∇Apar x b/B]/m . ∇H * dψ/dvpar */ - alpha_e : alpha_e - 1/m_ * gradAxbhatoverB_vec[k] * gradH_vec[k] + alpha_e : alpha_e - 1/m_ * gradAxbhatoverB_vec[k] * gradH_vec[k] * dpsidvpar - /* Single term version ∇ x (Apar b) */ - /* alpha_e : alpha_e - rotAbovermB_vec[k] * gradH_vec[k] */ + /* Single term version ∇ x (Apar b)/m */ + /* alpha_e : alpha_e - rotAbovermB_vec[k] * gradH_vec[k] * dpsidvpar */ ) ) ), - if dir < vpardim then ( - alpha_e : alpha_e*rdx2vec[dir] - ) - else ( - alpha_e : alpha_e/vmap_prime_e[1] - ), - /* Project alpha on basis and write to array. */ printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), @@ -578,12 +578,9 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by )$ addApardotGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( - [pdim,varsC,bC,varsP,bP,varsV,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, - bmagBasis,ignoreVars,inFlds_e,cmag_e,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,BstardBmag_e, - hamil_e,pbAuxFlds,alphaSum_e,vd,vpardir,dirLabel,wDir,rdDirVar2,vmap_prime_fac,dirVar, - dirVar_phys,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,alphaDotGradBasis_e,f_e,volTerm_c, dH_dz_e, - alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,hamil2_c,isqlist,mvpar_e,mvparsq_e, - vmapSq_e,vmap_prime_e,apardot_e,clst], + [pdim,varsC,bC,varsP,bP,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec, vmap_e,vpardir,dirLabel, + alpha_e,alpha_c,alphaLabel,alphaNoZero_c,volTerm_c, alphaJf_e, Jf_e,vmapSq_e,vmap_prime_e, + apardot_e,clst], kill(varsC,varsP,bC,bP), pdim : cdim+vdim, From 5f18a98741537f700c3c4ee05c5bf16db04dd284 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 7 Apr 2026 11:00:22 -0400 Subject: [PATCH 37/66] clean additional space, this version is also tested for lost local variables --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 5374beee..c13dd83d 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -263,22 +263,6 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := )$ - - - - - - - - - - - - - - - - addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( [pdim,varsC,bC,varsP,bP,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, bmagBasis,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,hamil_e,dir,dirLabel,gradpsi, dpsidvpar, From d4b7570436d3d614befa322a1e180807a8c4f551 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 7 Apr 2026 13:23:25 -0400 Subject: [PATCH 38/66] We split the ES term to simplify the logic --- .../gk_collisionless_flux-surf-vpar.mac | 20 +++++++------------ 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 8bcccdd0..feec7895 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -225,19 +225,15 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, "~%"), /* printf(fh, " mvpar_over_q = (~a)/q_; ~%", dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), */ - if no_by = true then ( - /* Start ES term */ - printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ;~%", dH_dz_nodes[cdim][j1index]) - ), + /* Start ES term */ + printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad; ~%", dH_dz_nodes[cdim][j1index]), + if no_by = false then ( - /* Start ES term */ - printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad ", dH_dz_nodes[cdim][j1index]), if cdim = 3 then ( /* Finish ES term */ for k : 1 thru cdim do ( - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[k][j1index], k-1, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[k][j1index], k-1, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) ), - printf(fh, ";~%"), if em = true then ( /* EM term curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ for k : 1 thru cdim do ( @@ -252,9 +248,8 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ), if cdim = 2 then ( /* Finish ES term */ - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 0, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), - printf(fh, ";~%"), + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 0, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), if em = true then ( /* EM term curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ /* Apar * curl(b) */ @@ -267,8 +262,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ), if cdim = 1 then ( /* Finish ES term */ - printf(fh, "-(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a)", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), - printf(fh, ";~%"), + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), if em = true then ( /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ /* Apar * curl(b) */ From 851ff29e38807463116c35ac7b46ccc657d634e6 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 7 Apr 2026 13:33:54 -0400 Subject: [PATCH 39/66] standardize the use of space in "; ~%" --- .../g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index e9bef03c..0926efcb 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -261,7 +261,7 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " alpha_quad = 0.0; ~%") ) ) else ( - /*printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) ;~%", vpar0index),*/ + /*printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_); ~%", vpar0index),*/ if cdim = 3 then ( if surfDir = 1 then( printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[1]*(~a) - bhat_quad[2]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[3][j1index], dH_dz_nodes[2][j1index]) @@ -278,7 +278,7 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[2][j1index]) ), if surfDir = 2 then( - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad) + mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * -bhat_quad[1]*(~a))*area_elem_quad/Jc_quad;~%", vpar0index, vpar0index, dH_dz_nodes[1][j1index]) + printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad) + mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * -bhat_quad[1]*(~a))*area_elem_quad/Jc_quad; ~%", vpar0index, vpar0index, dH_dz_nodes[1][j1index]) ) ), if cdim = 1 then ( From 9b4eb5f62182d26540b8c6763bf9b60932c7c209 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 7 Apr 2026 14:06:41 -0400 Subject: [PATCH 40/66] simplification of the logic by building the alpha_quad with += instead of in one line. --- .../gk_collisionless_flux-surf-conf.mac | 38 +++++++------------ 1 file changed, 14 insertions(+), 24 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 0926efcb..87d508fc 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -13,7 +13,7 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b bmagSurf_e,vmap_e,vmapSq_e, vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c, jacobgeo_rat_surfR_e,jacobgeo_rat_surfL_e,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,mvpar_nodes,di3,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL, + dH_dz_nodes,mvpar_nodes,i,j,j0index,j1index,vparindex,vpar0index,pOrderCFL, surfIntVarsC,bSurfC,hamilCvar,aparCvar,apar_nodes,apar_c,dA_dx_nodes ], @@ -183,13 +183,6 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b mvpar_nodes : append(mvpar_nodes, [dH_dz_nodes[vpardim][i]]) ), - if surfDir = cdim then( - di3 : true - ) - else ( - di3 : false - ), - /* Expand Aparallel. */ apar_e : doExpand1(apar,bC), apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), @@ -253,37 +246,34 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, "~%"), /* Electrostatic term */ - if no_by = true then ( - if di3 = true then ( - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad))*area_elem_quad/Jc_quad; ~%", vpar0index) - ) - else ( - printf(fh, " alpha_quad = 0.0; ~%") - ) + if surfDir = cdim then ( + /* Parallel streaming term */ + printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad))*area_elem_quad/Jc_quad; ~%", vpar0index) ) else ( - /*printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_); ~%", vpar0index),*/ + printf(fh, " alpha_quad = 0.0; ~%") + ), + + if no_by = false then ( + printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_)*area_elem_quad/Jc_quad; ~%", vpar0index), if cdim = 3 then ( if surfDir = 1 then( - printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[1]*(~a) - bhat_quad[2]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[3][j1index], dH_dz_nodes[2][j1index]) + printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[1]*(~a) - bhat_quad[2]*(~a)) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[3][j1index], dH_dz_nodes[2][j1index]) ), if surfDir = 2 then( - printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[2]*(~a) - bhat_quad[0]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[1][j1index], dH_dz_nodes[3][j1index]) + printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[2]*(~a) - bhat_quad[0]*(~a)) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[1][j1index], dH_dz_nodes[3][j1index]) ), if surfDir = 3 then( - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad) + mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[0]*(~a) - bhat_quad[1]*(~a)))*area_elem_quad/Jc_quad; ~%", vpar0index, vpar0index, dH_dz_nodes[2][j1index], dH_dz_nodes[1][j1index]) + printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[0]*(~a) - bhat_quad[1]*(~a)) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[2][j1index], dH_dz_nodes[1][j1index]) ) ), if cdim = 2 then ( if surfDir = 1 then( - printf(fh, " alpha_quad = (mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a))*area_elem_quad/Jc_quad; ~%", vpar0index, dH_dz_nodes[2][j1index]) + printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[2][j1index]) ), if surfDir = 2 then( - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad) + mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_) + 1/(q_*bmag_quad*area_elem_quad) * -bhat_quad[1]*(~a))*area_elem_quad/Jc_quad; ~%", vpar0index, vpar0index, dH_dz_nodes[1][j1index]) + printf(fh, " alpha_quad -= 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[1][j1index]) ) ), - if cdim = 1 then ( - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad))*area_elem_quad/Jc_quad; ~%", vpar0index) - ), if em = true then ( /* Electromagnetic Apar contribution curl(Apar b) = grad(Apar) x b + Apar curl(b)*/ From 4dbc21ba4bb206fde33ffcd484dc58a53f44915d Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 7 Apr 2026 14:49:47 -0400 Subject: [PATCH 41/66] Found a missing factor in conf surf flux kernel for Apar, it seems that 1/area_elem_quad and the area_elem_quad/Jc_quad factor was missing in the gradA times b term. Also combine the area_elem_quad/Jc_quad factor at the end of the building of alpha_quad to avoid repeating this operation. --- .../gk_collisionless_flux-surf-conf.mac | 27 ++++++++++--------- 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 87d508fc..7b5715ab 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -248,30 +248,30 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* Electrostatic term */ if surfDir = cdim then ( /* Parallel streaming term */ - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad))*area_elem_quad/Jc_quad; ~%", vpar0index) + printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad)); ~%", vpar0index) ) else ( printf(fh, " alpha_quad = 0.0; ~%") ), if no_by = false then ( - printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_)*area_elem_quad/Jc_quad; ~%", vpar0index), + printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_); ~%", vpar0index), if cdim = 3 then ( if surfDir = 1 then( - printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[1]*(~a) - bhat_quad[2]*(~a)) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[3][j1index], dH_dz_nodes[2][j1index]) + printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[1]*(~a) - bhat_quad[2]*(~a)); ~%", dH_dz_nodes[3][j1index], dH_dz_nodes[2][j1index]) ), if surfDir = 2 then( - printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[2]*(~a) - bhat_quad[0]*(~a)) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[1][j1index], dH_dz_nodes[3][j1index]) + printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[2]*(~a) - bhat_quad[0]*(~a)); ~%", dH_dz_nodes[1][j1index], dH_dz_nodes[3][j1index]) ), if surfDir = 3 then( - printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[0]*(~a) - bhat_quad[1]*(~a)) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[2][j1index], dH_dz_nodes[1][j1index]) + printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[0]*(~a) - bhat_quad[1]*(~a)); ~%", dH_dz_nodes[2][j1index], dH_dz_nodes[1][j1index]) ) ), if cdim = 2 then ( if surfDir = 1 then( - printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[2][j1index]) + printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a); ~%", dH_dz_nodes[2][j1index]) ), if surfDir = 2 then( - printf(fh, " alpha_quad -= 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a) * area_elem_quad/Jc_quad; ~%", dH_dz_nodes[1][j1index]) + printf(fh, " alpha_quad -= 1/(q_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a); ~%", dH_dz_nodes[1][j1index]) ) ), @@ -287,26 +287,29 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b if surfDir = 1 then( /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ /* The oscillation appears at short time (observable frame 1). */ - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) ), if surfDir = 2 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) ), if surfDir = 3 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", vpar0index, dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", vpar0index, dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) ) ), if cdim = 2 then ( if surfDir = 1 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[2][j1index]) + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[2][j1index]) ), if surfDir = 2 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[1][j1index]) + printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[1][j1index]) ) ) ) ), + /* Multiply by the surface element */ + printf(fh, " alpha_quad = alpha_quad * area_elem_quad/Jc_quad; ~%"), + printf(fh, "~%"), printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)); ~%"), printf(fh, " JfL_quad = ~a; ~%", JfL_nodes[j1index]), From fa1fbcbeaea2e6627f0787333642f112fd55c123 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Wed, 8 Apr 2026 12:59:47 -0400 Subject: [PATCH 42/66] add a note about what area_elem_quad is --- maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 7b5715ab..784e2756 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -307,7 +307,7 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ) ), - /* Multiply by the surface element */ + /* Multiply by |e^i|, note: area_elem_quad = J_c |e^i| */ printf(fh, " alpha_quad = alpha_quad * area_elem_quad/Jc_quad; ~%"), printf(fh, "~%"), From 4946c4a86bb92d7863a0a2856995f7e1ff7a6381 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Wed, 8 Apr 2026 13:00:07 -0400 Subject: [PATCH 43/66] refactor the kernel and use bioverJB now. --- .../gk_collisionless_flux-surf-vpar.mac | 94 ++++++++++--------- 1 file changed, 52 insertions(+), 42 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index feec7895..9017c0ca 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -12,7 +12,8 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_nodes,dA_dx_nodes,k, - apardot_e,apardot_nodes + apardot_e,apardot_nodes,mvpar_j1,dH_dx,dH_dy,dH_dz,dH_dvpar,dA_dx,dA_dy,dA_dz, + gradAxgradH, apar_bP_e ], kill(varsC,varsP,bC,bP), @@ -134,13 +135,16 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* Expand Apar */ apar_e : doExpand1(apar, bC), - apar_nodes : float(evAtNodes(apar_e,configNodes,surf_cvars)), + apar_nodes : float(evAtNodes(apar_e,surfNodes,surfIntVars)), /* Compute gradient of Aparallel */ dA_dx_nodes : makelist(0, i, 1, cdim), for i : 1 thru cdim do ( - dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsC[i]),configNodes,surf_cvars)) + dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsC[i]),surfNodes,surfIntVars)) ), + /* Create a Apar expansion on phase space basis */ + apar_bP_e : doExpand1(apar, bP), + /*fl and fr */ JfL_e : doExpand1(JfL, bP), JfR_e : doExpand1(JfR, bP), @@ -168,13 +172,40 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ) ), + if cdim = 3 then ( + dH_dx : dH_dz_nodes[1], + dH_dy : dH_dz_nodes[2], + dH_dz : dH_dz_nodes[3], + dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsC[1]),surfNodes,surfIntVars)), + dA_dy : float(evAtNodes(diff(apar_e*rdx2vec[2],varsC[2]),surfNodes,surfIntVars)), + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[3],varsC[3]),surfNodes,surfIntVars)) + ) else if cdim = 2 then ( + dH_dx : dH_dz_nodes[1], + dH_dy : 0, + dH_dz : dH_dz_nodes[2], + dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsC[1]),surfNodes,surfIntVars)), + dA_dy : 0, + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[2],varsC[2]),surfNodes,surfIntVars)) + ) else if cdim = 1 then ( + dH_dx : 0, + dH_dy : 0, + dH_dz : dH_dz_nodes[1], + dA_dx : 0, + dA_dy : 0, + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[1],varsC[1]),surfNodes,surfIntVars)) + ), + gradAxgradH : [ + dA_dy*dH_dz - dA_dz*dH_dy, + dA_dz*dH_dx - dA_dx*dH_dz, + dA_dx*dH_dy - dA_dy*dH_dx + ], + /* Now calculate alpha at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), printf(fh, " double cfl = 0.0; ~%"), printf(fh, " double bmag_quad = 0.0; ~%"), printf(fh, " double B3_quad = 0.0; ~%"), - printf(fh, " double Jc_quad = 0.0; ~%"), printf(fh, " double dualcurlbhat_quad[3] = {0.0}; ~%"), printf(fh, " double alpha_quad = 0.0; ~%"), printf(fh, " double JfL_quad = 0.0; ~%"), @@ -182,12 +213,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " double Jfavg_quad = 0.0; ~%"), printf(fh, " double Jfjump_quad = 0.0; ~%"), if em = true then ( - printf(fh, " double m_bmag_inv = 0.0; ~%"), - printf(fh, " double mvpar_over_q = 0.0; ~%"), - printf(fh, " double g_13 = 0.0; ~%"), - printf(fh, " double g_23 = 0.0; ~%"), - printf(fh, " double g_33 = 0.0; ~%"), - printf(fh, " double mag_e_3 = 0.0; ~%") + printf(fh, " double bioverJB_quad[3] = {0.0}; ~%") ), printf(fh, "~%"), @@ -196,34 +222,21 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b i1index : i, printf(fh, " bmag_quad = gkdgv[~a].bmag; ~%", i0index), printf(fh, " B3_quad = gkdgv[~a].B3; ~%", i0index), - printf(fh, " Jc_quad = dgv[~a].Jc; ~%", i0index), printf(fh, " dualcurlbhat_quad[0] = gkdgv[~a].dualcurlbhat.x[0]; ~%", i0index), printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i0index), printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i0index), if em = true then ( - printf(fh, " m_bmag_inv = 1.0/(m_*bmag_quad); ~%"), - /* - We develop the component grad(Apar) x b as - e^m . grad(Apar) x b = e^m x grad(Apar) . b = e^m x e^i dApar/dx^i . e_3/|e_3| - which gives - coeff * (g_33 dApar/dx2 - g_23 dApar/dx3) for m=1 - coeff * (g_13 dApar/dx3 - g_33 dApar/dx1) for m=2 - coeff * (g_23 dApar/dx1 - g_13 dApar/dx2) for m=3 - with - coeff = Jc/sqrt(g_33) - */ - printf(fh, " g_13 = gkdgv[~a].g_13; ~%", i-1), - printf(fh, " g_23 = gkdgv[~a].g_23; ~%", i-1), - printf(fh, " g_33 = gkdgv[~a].g_33; ~%", i-1), - printf(fh, " mag_e_3 = gkdgv[~a].mag_e_3; ~%", i-1) + printf(fh, " bioverJB_quad[0] = gkdgv[~a].bioverJB.x[0]; ~%", i0index), + printf(fh, " bioverJB_quad[1] = gkdgv[~a].bioverJB.x[1]; ~%", i0index), + printf(fh, " bioverJB_quad[2] = gkdgv[~a].bioverJB.x[2]; ~%", i0index) ), for j : 1 thru numVelNodes do ( j0index : j-1+(i-1)*numVelNodes, j1index : j+(i-1)*numVelNodes, + mvpar_j1 : dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index], printf(fh, "~%"), - /* printf(fh, " mvpar_over_q = (~a)/q_; ~%", dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), */ /* Start ES term */ printf(fh, " alpha_quad = -(~a)/m_/bmag_quad * B3_quad; ~%", dH_dz_nodes[cdim][j1index]), @@ -232,41 +245,38 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b if cdim = 3 then ( /* Finish ES term */ for k : 1 thru cdim do ( - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[k][j1index], k-1, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]) + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[k][j1index], k-1, mvpar_j1) ), if em = true then ( /* EM term curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ for k : 1 thru cdim do ( /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[i1index], k-1) - ), - /* grad(Apar) x b */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_33 * (~a) - g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][i1index], dA_dx_nodes[3][i1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_13 * (~a) - g_33 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[3][i1index], dA_dx_nodes[1][i1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (g_23 * (~a) - g_13 * (~a)); ~%", dH_dz_nodes[3][j1index], dA_dx_nodes[1][i1index], dA_dx_nodes[2][i1index]) + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[j1index], k-1), + /* grad(Apar) x b */ + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ * (~a); ~%", k-1, gradAxgradH[k][j1index]) + ) ) ), if cdim = 2 then ( /* Finish ES term */ - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 0, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[2][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 0, mvpar_j1), + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[2][j1index], 2, mvpar_j1), if em = true then ( /* EM term curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 0), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[i1index], 2), + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 0), + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[j1index], 2), /* grad(Apar) x b */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * (-g_23 * (~a)); ~%", dH_dz_nodes[1][j1index], dA_dx_nodes[2][i1index]), - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * 1/mag_e_3/Jc_quad * ( g_23 * (~a)); ~%", dH_dz_nodes[2][j1index], dA_dx_nodes[1][i1index]) + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 1, gradAxgradH[2][j1index]) ) ), if cdim = 1 then ( /* Finish ES term */ - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 2, dH_dz_nodes[vpardim][j1index]/vmap_prime_nodes[j1index]), + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 2, mvpar_j1), if em = true then ( /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ /* Apar * curl(b) */ - printf(fh, " alpha_quad += -(~a)*m_bmag_inv * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[i1index], 2) + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 2) /* grad(Apar) x b */ /* none */ ) From f0bf4b09a1c28cf372b992dacf15882e81cf9ab0 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 9 Apr 2026 14:00:21 -0400 Subject: [PATCH 44/66] =?UTF-8?q?=F0=9F=90=9B=F0=9F=97=91=EF=B8=8F=20wrong?= =?UTF-8?q?=20sign,=20thanks=20@akashukla?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 9017c0ca..7210fe10 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -253,7 +253,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* Apar * curl(b) */ printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[j1index], k-1), /* grad(Apar) x b */ - printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ * (~a); ~%", k-1, gradAxgradH[k][j1index]) + printf(fh, " alpha_quad += bioverJB_quad[~a]/m_ * (~a); ~%", k-1, gradAxgradH[k][j1index]) ) ) ), @@ -267,7 +267,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 0), printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[j1index], 2), /* grad(Apar) x b */ - printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 1, gradAxgradH[2][j1index]) + printf(fh, " alpha_quad += bioverJB_quad[~a]/m_ *(~a); ~%", 1, gradAxgradH[2][j1index]) ) ), if cdim = 1 then ( From c961e797d3e99ab835a162fc8eeece7b3aa791ec Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 10 Apr 2026 19:35:00 -0400 Subject: [PATCH 45/66] make the equation look more like the math representation --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index c13dd83d..de39a4d3 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -212,14 +212,15 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := /* Add curvature drift terms (m vpar/q * ∇ x b)/mB = (m vpar * (∇ x b)/B)/qm */ if dir < vpardim then ( - /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ - alpha_e : alpha_e + mvpar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar / (q_*m_) * gradpsi[dir], - /* Add b x ∇H / qB term (only in configuration space) */ + /* 1/m vpar/q [(∇ x b)/B] dH/dvpar . ∇ψ */ + alpha_e : alpha_e + 1/m_ * mvpar_e/q_ * dualcurlbhatoverB_vec[dir] * dH_dvpar * gradpsi[dir], + /* 1/q (b/B x ∇H) . ∇ψ */ alpha_e : alpha_e + 1/q_ * boverBxgradH_vec[dir] * gradpsi[dir] + ) else ( - /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ + /* 1/m (m vpar/q [(∇ x b)/B]) . ∇H dψ/dvpar */ for k : 1 thru cdim do ( - alpha_e : alpha_e - mvpar_e*dualcurlbhatoverB_vec[k]*gradH_vec[k]/(q_*m_) * dpsidvpar + alpha_e : alpha_e - 1/m_ * mvpar_e/q_ * dualcurlbhatoverB_vec[k] * gradH_vec[k] * dpsidvpar ) ) ), From 608bc146a8c1deb554fae54346eb7f9eb995c02f Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 10 Apr 2026 19:36:01 -0400 Subject: [PATCH 46/66] remove the factor at the end and replace it by gradpsi and dpsidvpar variables --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 7 ------- 1 file changed, 7 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index de39a4d3..36abb61f 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -225,13 +225,6 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := ) ), - /* if dir < vpardim then ( - alpha_e : alpha_e*rdx2vec[dir] - ) - else ( - alpha_e : alpha_e - ), */ - /* Project alpha on basis and write to array. */ printf(fh, " double alpha~a[~a] = {0.}; ~%", dirLabel, numP), alpha_c : fullratsimp(calcInnerProdList(varsP, 1, bP, alpha_e)), From 56b11a236e8480aae0db84ad6118138087ffb8f8 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 10 Apr 2026 20:07:47 -0400 Subject: [PATCH 47/66] refactor the magnetic equ data from x,y,z to 1,2,3 because they are always 3 coordinates in the magnetic equilibrium but x and y may not be present. --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 167 ++++++++++------------- 1 file changed, 70 insertions(+), 97 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index 36abb61f..ceab2dc9 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -15,8 +15,8 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := bmagBasis,vmap_e,hamil_e,dir,dirLabel,alpha_e,alpha_c,alphaLabel,alphaNoZero_c,volTerm_c, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,isqlist,mvpar_e,mvparsq_e, replaceList,dvparSimp,phi_e,bmag_e,rtg33inv_e, - dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e,dualcurlbhatoverB_vec, - bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,bioverJB_vec, + dualcurlbhatoverB_1_e,dualcurlbhatoverB_2_e,dualcurlbhatoverB_3_e,dualcurlbhatoverB_vec, + bioverJB_1_e,bioverJB_2_e,bioverJB_3_e,bioverJB_vec, vmapSq_e,vmap_prime_e,hamilCvar,hamilNoZero_c,hamil_c, xidx,yidx,zidx,vidx,vpardim,dH_dx,dH_dy,dH_dz,dH_dvpar,gradH_vec, gradpsi, dpsidvpar, boverBxgradH_x,boverBxgradH_y,boverBxgradH_z,boverBxgradH_vec,i,k,clst], @@ -73,14 +73,14 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := /* Create pointers to the components of b_i. */ allVarLabelsC : ["x","y","z"], for d : 1 thru 3 do ( - printf(fh, " const double *bioverJB_~a = &bioverJB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) + printf(fh, " const double *bioverJB_~a = &bioverJB[~a]; ~%", d, numC*(d-1)) ), printf(fh, "~%"), /* Create pointers to the components of dualcurlbhatoverB. */ allVarLabelsC : ["x","y","z"], for d : 1 thru 3 do ( - printf(fh, " const double *dualcurlbhatoverB_~a = &dualcurlbhatoverB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) + printf(fh, " const double *dualcurlbhatoverB_~a = &dualcurlbhatoverB[~a]; ~%", d, numC*(d-1)) ), printf(fh, "~%"), @@ -89,23 +89,23 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := /* Expand input fields for Hamiltonian calculation */ phi_e : doExpand1(phi,bC), bmag_e : doExpand1(bmag, bmagBasis), - dualcurlbhatoverB_x_e : doExpand1(dualcurlbhatoverB_x, bmagBasis), - dualcurlbhatoverB_y_e : doExpand1(dualcurlbhatoverB_y, bmagBasis), - dualcurlbhatoverB_z_e : doExpand1(dualcurlbhatoverB_z, bmagBasis), + dualcurlbhatoverB_1_e : doExpand1(dualcurlbhatoverB_1, bmagBasis), + dualcurlbhatoverB_2_e : doExpand1(dualcurlbhatoverB_2, bmagBasis), + dualcurlbhatoverB_3_e : doExpand1(dualcurlbhatoverB_3, bmagBasis), rtg33inv_e : doExpand1(rtg33inv, bmagBasis), - bioverJB_x_e : doExpand1(bioverJB_x, bmagBasis), - bioverJB_y_e : doExpand1(bioverJB_y, bmagBasis), - bioverJB_z_e : doExpand1(bioverJB_z, bmagBasis), + bioverJB_1_e : doExpand1(bioverJB_1, bmagBasis), + bioverJB_2_e : doExpand1(bioverJB_2, bmagBasis), + bioverJB_3_e : doExpand1(bioverJB_3, bmagBasis), if cdim = 3 then ( - dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], - bioverJB_vec : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e] + dualcurlbhatoverB_vec : [dualcurlbhatoverB_1_e, dualcurlbhatoverB_2_e, dualcurlbhatoverB_3_e], + bioverJB_vec : [bioverJB_1_e, bioverJB_2_e, bioverJB_3_e] ) else if cdim = 2 then ( - dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_z_e], - bioverJB_vec : [bioverJB_x_e, bioverJB_z_e] + dualcurlbhatoverB_vec : [dualcurlbhatoverB_1_e, dualcurlbhatoverB_3_e], + bioverJB_vec : [bioverJB_1_e, bioverJB_3_e] ) else if cdim = 1 then ( - dualcurlbhatoverB_vec : [dualcurlbhatoverB_z_e], - bioverJB_vec : [bioverJB_z_e] + dualcurlbhatoverB_vec : [dualcurlbhatoverB_3_e], + bioverJB_vec : [bioverJB_3_e] ), /* Velocity mapping fields. */ @@ -136,33 +136,33 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := if vdim = 1 then ( vpardim : pdim ), dH_dvpar : diff(hamil_e,varsP[vpardim])/vmap_prime_e[1], /* We do not multply by rdv2vec because it is inside vmap_prime */ if cdim = 3 then ( - dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), - dH_dy : diff(hamil_e*rdx2vec[yidx],varsP[yidx]), - dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), + dH_dx : diff(hamil_e * rdx2vec[xidx],varsP[xidx]), + dH_dy : diff(hamil_e * rdx2vec[yidx],varsP[yidx]), + dH_dz : diff(hamil_e * rdx2vec[zidx],varsP[zidx]), gradH_vec : [dH_dx, dH_dy, dH_dz] ) else if cdim = 2 then ( - dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), + dH_dx : diff(hamil_e * rdx2vec[xidx],varsP[xidx]), dH_dy : 0, - dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), + dH_dz : diff(hamil_e * rdx2vec[zidx],varsP[zidx]), gradH_vec : [dH_dx, dH_dz] ) else if cdim = 1 then ( dH_dx : 0, dH_dy : 0, - dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), + dH_dz : diff(hamil_e * rdx2vec[zidx],varsP[zidx]), gradH_vec : [dH_dz] ), if cdim = 3 then ( - boverBxgradH_x : bioverJB_y_e*dH_dz - bioverJB_z_e*dH_dy, - boverBxgradH_y : bioverJB_z_e*dH_dx - bioverJB_x_e*dH_dz, - boverBxgradH_z : bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx, + boverBxgradH_x : bioverJB_2_e*dH_dz - bioverJB_3_e*dH_dy, + boverBxgradH_y : bioverJB_3_e*dH_dx - bioverJB_1_e*dH_dz, + boverBxgradH_z : bioverJB_1_e*dH_dy - bioverJB_2_e*dH_dx, boverBxgradH_vec : [boverBxgradH_x, boverBxgradH_y, boverBxgradH_z] ) else if cdim = 2 then ( - boverBxgradH_x : bioverJB_y_e*dH_dz - bioverJB_z_e*dH_dy, - boverBxgradH_z : bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx, + boverBxgradH_x : bioverJB_2_e*dH_dz - bioverJB_3_e*dH_dy, + boverBxgradH_z : bioverJB_1_e*dH_dy - bioverJB_2_e*dH_dx, boverBxgradH_vec : [boverBxgradH_x, boverBxgradH_z] ) else if cdim = 1 then ( - boverBxgradH_z : bioverJB_x_e*dH_dy - bioverJB_y_e*dH_dx, + boverBxgradH_z : bioverJB_1_e*dH_dy - bioverJB_2_e*dH_dx, boverBxgradH_vec : [boverBxgradH_z] ), @@ -259,13 +259,13 @@ buildGKVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by) := block( [pdim,varsC,bC,varsP,bP,vSub,numC,numP,varLabel,d,rdx2vec,rdv2vec,allVarLabelsC, - bmagBasis,b_x_e,b_y_e,b_z_e,jacobTotInv_e,vmap_e,hamil_e,dir,dirLabel,gradpsi, dpsidvpar, + bmagBasis,b_1_e,b_2_e,b_3_e,jacobTotInv_e,vmap_e,hamil_e,dir,dirLabel,gradpsi, dpsidvpar, alpha_e,alpha_c,alphaLabel,alphaNoZero_c,volTerm_c, alphaJf_e, Jf_e, replaceListHamil, replaceListVpar,isqlist,mvpar_e,mvparsq_e, xidx, yidx, zidx, vidx, - replaceList,dvparSimp,phi_e,bmag_e,rtg33inv_e,bioverJB_x_e,bioverJB_y_e,bioverJB_z_e,bioverJB_vec, - dualcurlbhatoverB_x_e,dualcurlbhatoverB_y_e,dualcurlbhatoverB_z_e,dualcurlbhatoverB_vec, dH_dx, dH_dy, dH_dz, dH_dvpar, gradH_vec, + replaceList,dvparSimp,phi_e,bmag_e,rtg33inv_e,bioverJB_1_e,bioverJB_2_e,bioverJB_3_e,bioverJB_vec, + dualcurlbhatoverB_1_e,dualcurlbhatoverB_2_e,dualcurlbhatoverB_3_e,dualcurlbhatoverB_vec, dH_dx, dH_dy, dH_dz, dH_dvpar, gradH_vec, vmapSq_e,vmap_prime_e,hamil_c,hamilCvar,hamilNoZero_c,vpardim,i,k,Apar_e, dA_dx, dA_dy, dA_dz, gradA_vec, - rotAbovermB_x,rotAbovermB_y,rotAbovermB_z,rotAbovermB_vec, gradAxbhatoverB_x,gradAxbhatoverB_y,gradAxbhatoverB_z,gradAxbhatoverB_vec, + rotAbovermB_x,rotAbovermB_y,rotAbovermB_z,rotAbovermB_vec, gradAxbhatoverB_x,gradAxbhatoverB_y,gradAxbhatoverB_z,gradAxboverB_vec, clst], kill(varsC,varsP,bC,bP), @@ -324,18 +324,18 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by /* Create pointers to the components of b_i. */ allVarLabelsC : ["x","y","z"], for d : 1 thru 3 do ( - printf(fh, " const double *b_~a = &b_i[~a];~%", allVarLabelsC[d], numC*(d-1)) + printf(fh, " const double *b_~a = &b_i[~a];~%", d, numC*(d-1)) ), printf(fh, "~%"), for d : 1 thru 3 do ( - printf(fh, " const double *bioverJB_~a = &bioverJB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) + printf(fh, " const double *bioverJB_~a = &bioverJB[~a]; ~%", d, numC*(d-1)) ), printf(fh, "~%"), /* Create pointers to the components of dualcurlbhatoverB. */ for d : 1 thru 3 do ( - printf(fh, " const double *dualcurlbhatoverB_~a = &dualcurlbhatoverB[~a]; ~%", allVarLabelsC[d], numC*(d-1)) + printf(fh, " const double *dualcurlbhatoverB_~a = &dualcurlbhatoverB[~a]; ~%", d, numC*(d-1)) ), printf(fh, "~%"), @@ -345,27 +345,27 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by phi_e : doExpand1(phi,bC), bmag_e : doExpand1(bmag, bmagBasis), rtg33inv_e : doExpand1(rtg33inv, bmagBasis), - dualcurlbhatoverB_x_e : doExpand1(dualcurlbhatoverB_x, bmagBasis), - dualcurlbhatoverB_y_e : doExpand1(dualcurlbhatoverB_y, bmagBasis), - dualcurlbhatoverB_z_e : doExpand1(dualcurlbhatoverB_z, bmagBasis), - bioverJB_x_e : doExpand1(bioverJB_x, bmagBasis), - bioverJB_y_e : doExpand1(bioverJB_y, bmagBasis), - bioverJB_z_e : doExpand1(bioverJB_z, bmagBasis), - b_x_e : doExpand1(b_x, bmagBasis), - b_y_e : doExpand1(b_y, bmagBasis), - if (no_by or cdim = 1) then (b_y_e : 0), - b_z_e : doExpand1(b_z, bmagBasis), + dualcurlbhatoverB_1_e : doExpand1(dualcurlbhatoverB_1, bmagBasis), + dualcurlbhatoverB_2_e : doExpand1(dualcurlbhatoverB_2, bmagBasis), + dualcurlbhatoverB_3_e : doExpand1(dualcurlbhatoverB_3, bmagBasis), + bioverJB_1_e : doExpand1(bioverJB_1, bmagBasis), + bioverJB_2_e : doExpand1(bioverJB_2, bmagBasis), + bioverJB_3_e : doExpand1(bioverJB_3, bmagBasis), + b_1_e : doExpand1(b_x, bmagBasis), + b_2_e : doExpand1(b_y, bmagBasis), + if (no_by or cdim = 1) then (b_2_e : 0), + b_3_e : doExpand1(b_z, bmagBasis), jacobTotInv_e : doExpand1(jacobtot_inv, bmagBasis), if cdim = 3 then ( - dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_y_e, dualcurlbhatoverB_z_e], - bioverJB_vec : [bioverJB_x_e, bioverJB_y_e, bioverJB_z_e] + dualcurlbhatoverB_vec : [dualcurlbhatoverB_1_e, dualcurlbhatoverB_2_e, dualcurlbhatoverB_3_e], + bioverJB_vec : [bioverJB_1_e, bioverJB_2_e, bioverJB_3_e] ) else if cdim = 2 then ( - dualcurlbhatoverB_vec : [dualcurlbhatoverB_x_e, dualcurlbhatoverB_z_e], - bioverJB_vec : [bioverJB_x_e, bioverJB_z_e] + dualcurlbhatoverB_vec : [dualcurlbhatoverB_1_e, dualcurlbhatoverB_3_e], + bioverJB_vec : [bioverJB_1_e, bioverJB_3_e] ) else if cdim = 1 then ( - dualcurlbhatoverB_vec : [dualcurlbhatoverB_z_e], - bioverJB_vec : [bioverJB_z_e] + dualcurlbhatoverB_vec : [dualcurlbhatoverB_3_e], + bioverJB_vec : [bioverJB_3_e] ), /* Velocity mapping fields. */ @@ -402,12 +402,9 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by gradH_vec : [dH_dx, dH_dy, dH_dz, dH_dvpar] ) else if cdim = 2 then ( dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), - dH_dy : 0, dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), gradH_vec : [dH_dx, dH_dz, dH_dvpar] ) else if cdim = 1 then ( - dH_dx : 0, - dH_dy : 0, dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), gradH_vec : [dH_dz, dH_dvpar] ), @@ -438,24 +435,8 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by /* Apar_e : subst(y=0, doExpand1(apar,bC)), */ Apar_e : doExpand1(apar,bC), - /* Expand dBperp/Bmag. */ - /* Direct method ∇ x (Apar bhat) */ - if cdim = 3 then ( - rotAbovermB_x : (rdy2*diff(Apar_e*b_z_e,y) - rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e/m_, - rotAbovermB_y : (rdz2*diff(Apar_e*b_x_e,z) - rdx2*diff(Apar_e*b_z_e,x))*jacobTotInv_e/m_, - rotAbovermB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e/m_, - rotAbovermB_vec : [rotAbovermB_x, rotAbovermB_y, rotAbovermB_z] - ) else if cdim = 2 then ( - rotAbovermB_x : (rdy2*diff(Apar_e*b_z_e,y) - rdz2*diff(Apar_e*b_y_e,z))*jacobTotInv_e/m_, - rotAbovermB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e/m_, - rotAbovermB_vec : [rotAbovermB_x, rotAbovermB_z] - ) else if cdim = 1 then ( - rotAbovermB_z : (rdx2*diff(Apar_e*b_y_e,x) - rdy2*diff(Apar_e*b_x_e,y))*jacobTotInv_e/m_, - rotAbovermB_vec : [rotAbovermB_z] - ), - - /* Product rule method Apar ∇ x bhat + ∇Apar x bhat. */ - /* Calculate ∇Apar in a list */ + /* Expand dBperp/Bmag using product rule method Apar ∇ x bhat + ∇Apar x bhat. */ + /* Calculate ∇Apar in a vector */ if cdim = 3 then ( dA_dx : diff(Apar_e*rdx2vec[xidx],varsP[xidx]), dA_dy : diff(Apar_e*rdx2vec[yidx],varsP[yidx]), @@ -463,29 +444,26 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by gradA_vec : [dA_dx, dA_dy, dA_dz] ) else if cdim = 2 then ( dA_dx : diff(Apar_e*rdx2vec[xidx],varsP[xidx]), - dA_dy : 0, dA_dz : diff(Apar_e*rdx2vec[zidx],varsP[zidx]), gradA_vec : [dA_dx, dA_dz] ) else if cdim = 1 then ( - dA_dx : 0, - dA_dy : 0, dA_dz : diff(Apar_e*rdx2vec[zidx],varsP[zidx]), gradA_vec : [dA_dz] ), - /* Use bioverJB to calculate ∇Apar x b / B in a list */ + /* Use bioverJB to calculate ∇Apar x b / B in a vector */ if cdim = 3 then ( - gradAxbhatoverB_x : dA_dy*bioverJB_z_e - dA_dz*bioverJB_y_e, - gradAxbhatoverB_y : dA_dz*bioverJB_x_e - dA_dx*bioverJB_z_e, - gradAxbhatoverB_z : dA_dx*bioverJB_y_e - dA_dy*bioverJB_x_e, - gradAxbhatoverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_y, gradAxbhatoverB_z] + gradAxbhatoverB_x : gradA_vec[2]*bioverJB_vec[3] - gradA_vec[3]*bioverJB_vec[2], + gradAxbhatoverB_y : gradA_vec[3]*bioverJB_vec[1] - gradA_vec[1]*bioverJB_vec[3], + gradAxbhatoverB_z : gradA_vec[1]*bioverJB_vec[2] - gradA_vec[2]*bioverJB_vec[1], + gradAxboverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_y, gradAxbhatoverB_z] ) else if cdim = 2 then ( - gradAxbhatoverB_x : dA_dy*bioverJB_z_e - dA_dz*bioverJB_y_e, - gradAxbhatoverB_z : dA_dx*bioverJB_y_e - dA_dy*bioverJB_x_e, - gradAxbhatoverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_z] + gradAxbhatoverB_x : 0 - gradA_vec[2]*bioverJB_vec[2], + gradAxbhatoverB_z : gradA_vec[1]*bioverJB_vec[2] - 0, + gradAxboverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_z] ) else if cdim = 1 then ( - gradAxbhatoverB_z : dA_dx*bioverJB_y_e - dA_dy*bioverJB_x_e, - gradAxbhatoverB_vec : [gradAxbhatoverB_z] + gradAxbhatoverB_z : 0, + gradAxboverB_vec : [gradAxbhatoverB_z] ), /* Auxiliary variables to improve reading */ @@ -500,25 +478,20 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by if no_by = false then ( if dir < vpardim then ( /* Config space contributions ( curv drift * dH/dvpar . ∇ψ ) */ - /* This is [Apar . (∇ x b)/B]/m dH/dvpar . ∇ψ */ + /* 1/m Apar [(∇ x b)/B] dH/dvpar . ∇ψ */ alpha_e : alpha_e + 1/m_ * Apar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar * gradpsi[dir], - /* This is [∇Apar x b/B]/m dH/dvpar . ∇ψ */ + /* 1/m [∇Apar x b/B] dH/dvpar . ∇ψ */ /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ /* The oscillation builds up at longer time (not observable at frame 1). */ - alpha_e : alpha_e + 1/m_ * gradAxbhatoverB_vec[dir] * dH_dvpar * gradpsi[dir] - - /* Single term version ∇ x (Apar b)/m */ - /* alpha_e : alpha_e + rotAbovermB_vec[dir] * dH_dvpar * gradpsi[dir] */ + alpha_e : alpha_e + 1/m_ * gradAxboverB_vec[dir] * dH_dvpar * gradpsi[dir] ) else ( /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ for k : 1 thru cdim do ( - /* this is [Apar . (∇ x b)/B]/m . ∇H * dψ/dvpar */ - alpha_e : alpha_e - 1/m_ * (Apar_e * dualcurlbhatoverB_vec[k]) * gradH_vec[k] * dpsidvpar, - /* this is [∇Apar x b/B]/m . ∇H * dψ/dvpar */ - alpha_e : alpha_e - 1/m_ * gradAxbhatoverB_vec[k] * gradH_vec[k] * dpsidvpar + /* 1/m [Apar . (∇ x b)/B] . ∇H * dψ/dvpar */ + alpha_e : alpha_e - 1/m_ * Apar_e * dualcurlbhatoverB_vec[k] * gradH_vec[k] * dpsidvpar, + /* 1/m [∇Apar x b/B] . ∇H * dψ/dvpar */ + alpha_e : alpha_e - 1/m_ * gradAxboverB_vec[k] * gradH_vec[k] * dpsidvpar - /* Single term version ∇ x (Apar b)/m */ - /* alpha_e : alpha_e - rotAbovermB_vec[k] * gradH_vec[k] * dpsidvpar */ ) ) ), From d9b1ee1bf981305ac7c87c71d566b157efe1111f Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 10 Apr 2026 20:22:59 -0400 Subject: [PATCH 48/66] polish the velocity surface flux generator --- .../gk_collisionless_flux-surf-vpar.mac | 30 +++++++++---------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 7210fe10..510d5fc2 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -13,7 +13,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_nodes,dA_dx_nodes,k, apardot_e,apardot_nodes,mvpar_j1,dH_dx,dH_dy,dH_dz,dH_dvpar,dA_dx,dA_dy,dA_dz, - gradAxgradH, apar_bP_e + gradHxgradA, apar_bP_e ], kill(varsC,varsP,bC,bP), @@ -194,10 +194,10 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b dA_dy : 0, dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[1],varsC[1]),surfNodes,surfIntVars)) ), - gradAxgradH : [ - dA_dy*dH_dz - dA_dz*dH_dy, - dA_dz*dH_dx - dA_dx*dH_dz, - dA_dx*dH_dy - dA_dy*dH_dx + gradHxgradA : [ + dH_dy*dA_dz - dH_dz*dA_dy, + dH_dz*dA_dx - dH_dx*dA_dz, + dH_dx*dA_dy - dH_dy*dA_dx ], /* Now calculate alpha at all quadrature nodes */ @@ -248,12 +248,12 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[k][j1index], k-1, mvpar_j1) ), if em = true then ( - /* EM term curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ + /* EM term using ∇ x (A b) . ∇H = A . ∇ x b . ∇H + ∇A x b . ∇H = A . ∇ x b . ∇H + ∇H x ∇A . b */ for k : 1 thru cdim do ( - /* Apar * curl(b) */ + /* - A ∇ x b . ∇H dψ/dvpar = - A (∇ x b)_i dH/dxi dψ/dvpar */ printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[j1index], k-1), - /* grad(Apar) x b */ - printf(fh, " alpha_quad += bioverJB_quad[~a]/m_ * (~a); ~%", k-1, gradAxgradH[k][j1index]) + /* - ∇H x ∇A . b dψ/dvpar = - b_i/B 1/J eps_ijk dH/dx_j dA/dx_k */ + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", k-1, gradHxgradA[k][j1index]) ) ) ), @@ -262,22 +262,20 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 0, mvpar_j1), printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[2][j1index], 2, mvpar_j1), if em = true then ( - /* EM term curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ - /* Apar * curl(b) */ + /* - A * ∇ x b . ∇H dψ/dvpar*/ printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 0), printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[j1index], 2), - /* grad(Apar) x b */ - printf(fh, " alpha_quad += bioverJB_quad[~a]/m_ *(~a); ~%", 1, gradAxgradH[2][j1index]) + /* - ∇H x ∇A . b dψ/dvpar */ + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 1, gradHxgradA[2][j1index]) ) ), if cdim = 1 then ( /* Finish ES term */ printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 2, mvpar_j1), if em = true then ( - /* Terms related to Aparallel following curl(Apar*b) = Apar * curl(b) + grad(Apar) x b */ - /* Apar * curl(b) */ + /* - A * ∇ x b . ∇H dψ/dvpar*/ printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 2) - /* grad(Apar) x b */ + /* - ∇H x ∇A . b dψ/dvpar */ /* none */ ) ) From 8beb786a26b54a75d3425f9e478857adca7f2c10 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 10 Apr 2026 20:53:47 -0400 Subject: [PATCH 49/66] make it look more like the equations like renaming mvpar dHdvpar and adding spaces. --- .../gk_collisionless_flux-surf-conf.mac | 34 ++++++++++--------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 784e2756..d60f3e3d 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -178,15 +178,14 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ) ), - mvpar_nodes : [], + dHdvpar_nodes : [], for i : 1 thru numVparNodes do ( - mvpar_nodes : append(mvpar_nodes, [dH_dz_nodes[vpardim][i]]) + dHdvpar_nodes : append(dHdvpar_nodes, [dH_dz_nodes[vpardim][i]]) ), /* Expand Aparallel. */ apar_e : doExpand1(apar,bC), apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), - /* printf(fh, " double apar[~a] = {0.}; ~%", numP), */ aparCvar : eval_string(sconcat("apar")), apar_c : makelistNoZeros1(apar_c, aparCvar), /* Expand projected Apar on basis. */ @@ -217,14 +216,14 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " double Jfavg_quad = 0.0; ~%"), printf(fh, " double Jfjump_quad = 0.0; ~%"), - printf(fh, " double mvpar_quad[3] = {0.0}; ~%"), + printf(fh, " double dHdvpar_quad[3] = {0.0}; ~%"), for i : 1 thru numVparNodes do ( - printf(fh, " mvpar_quad[~a] = ~a; ~%", i-1, mvpar_nodes[i]) + printf(fh, " dHdvpar_quad[~a] = ~a; ~%", i-1, dHdvpar_nodes[i]) ), printf(fh, " double mvparsq_quad[3] = {0.0}; ~%"), for i : 1 thru numVparNodes do ( - printf(fh, " mvparsq_quad[~a] = mvpar_quad[~a]*mvpar_quad[~a]/m_; ~%", i-1, i-1,i-1) + printf(fh, " mvparsq_quad[~a] = dHdvpar_quad[~a]*dHdvpar_quad[~a]/m_; ~%", i-1, i-1,i-1) ), printf(fh, "~%"), @@ -248,13 +247,14 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* Electrostatic term */ if surfDir = cdim then ( /* Parallel streaming term */ - printf(fh, " alpha_quad = (mvpar_quad[~a]*B3_quad/(m_*bmag_quad)); ~%", vpar0index) + printf(fh, " alpha_quad = (dHdvpar_quad[~a]*B3_quad/(m_*bmag_quad)); ~%", vpar0index) ) else ( printf(fh, " alpha_quad = 0.0; ~%") ), if no_by = false then ( printf(fh, " alpha_quad += mvparsq_quad[~a]*normcurlbhat_quad/(bmag_quad*q_); ~%", vpar0index), + /* + 1/q b/B x ∇H . ∇ψ*/ if cdim = 3 then ( if surfDir = 1 then( printf(fh, " alpha_quad += 1/(q_*bmag_quad*area_elem_quad) * (bhat_quad[1]*(~a) - bhat_quad[2]*(~a)); ~%", dH_dz_nodes[3][j1index], dH_dz_nodes[2][j1index]) @@ -276,34 +276,36 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ), if em = true then ( - /* Electromagnetic Apar contribution curl(Apar b) = grad(Apar) x b + Apar curl(b)*/ + /* Electromagnetic Apar contribution using ∇ x (A b) = A ∇ x b + ∇A x b */ /* No contribution for cdim = 1 */ if cdim > 1 then ( - /* Aparallel curl b contribution */ - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad) * (~a) * normcurlbhat_quad; ~%", vpar0index, apar_nodes[j1index]) + /* + 1/m A (∇ x b)/B . ∇ψ dH/dvpar */ + printf(fh, " alpha_quad += 1/m_ * (~a) * normcurlbhat_quad/bmag_quad * dHdvpar_quad[~a]; ~%", apar_nodes[j1index], vpar0index) ), - /* grad(Aparallel) x b contribution*/ + /* + 1/m ∇A x b/B . ∇ψ dH/dvpar */ if cdim = 3 then ( if surfDir = 1 then( /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ /* The oscillation appears at short time (observable frame 1). */ - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", vpar0index, dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index]) + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index], vpar0index) ), if surfDir = 2 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", vpar0index, dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index]) + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index], vpar0index) ), if surfDir = 3 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", vpar0index, dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index]) + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index], vpar0index) ) ), + /* in 2D, we take the first and last component of the 3D cross product, setting d/dy = 0.*/ if cdim = 2 then ( if surfDir = 1 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[2][j1index]) + printf(fh, " alpha_quad -= 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1] * dHdvpar_quad[~a]; ~%", dA_dx_nodes[2][j1index], vpar0index) ), if surfDir = 2 then( - printf(fh, " alpha_quad += mvpar_quad[~a]/(m_*bmag_quad*area_elem_quad) * bhat_quad[1]*(~a); ~%", vpar0index, dA_dx_nodes[1][j1index]) + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1] * dHdvpar_quad[~a]; ~%", dA_dx_nodes[1][j1index], vpar0index) ) ) + /* Nothing in 1D */ ) ), From 4920f43494280eb0b056b4c68c24e3b610d4bc0d Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 17 Apr 2026 17:04:43 -0400 Subject: [PATCH 50/66] this kernel setup is able to run the alfven 3x2v case without showing spurious oscillations, changes: - The new quantities like gradA x gradH are now computed using the expansion before being evaluated at nodes. This commit need to be cleaned and not all of the changes may be necessary. --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 8 +-- .../gk_collisionless_flux-surf-conf.mac | 49 +++++++++++++-- .../gk_collisionless_flux-surf-vpar.mac | 61 +++++++++++++++++-- 3 files changed, 101 insertions(+), 17 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index ceab2dc9..d74abea1 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -399,14 +399,14 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), dH_dy : diff(hamil_e*rdx2vec[yidx],varsP[yidx]), dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), - gradH_vec : [dH_dx, dH_dy, dH_dz, dH_dvpar] + gradH_vec : [dH_dx, dH_dy, dH_dz] ) else if cdim = 2 then ( dH_dx : diff(hamil_e*rdx2vec[xidx],varsP[xidx]), dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), - gradH_vec : [dH_dx, dH_dz, dH_dvpar] + gradH_vec : [dH_dx, dH_dz] ) else if cdim = 1 then ( dH_dz : diff(hamil_e*rdx2vec[zidx],varsP[zidx]), - gradH_vec : [dH_dz, dH_dvpar] + gradH_vec : [dH_dz] ), /*Make sure to avoid having hamil[i]^2 or vmap[i]^2 in expressions*/ @@ -481,8 +481,6 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by /* 1/m Apar [(∇ x b)/B] dH/dvpar . ∇ψ */ alpha_e : alpha_e + 1/m_ * Apar_e * dualcurlbhatoverB_vec[dir] * dH_dvpar * gradpsi[dir], /* 1/m [∇Apar x b/B] dH/dvpar . ∇ψ */ - /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ - /* The oscillation builds up at longer time (not observable at frame 1). */ alpha_e : alpha_e + 1/m_ * gradAxboverB_vec[dir] * dH_dvpar * gradpsi[dir] ) else ( /* Vpar contribution ( curv drift . ∇H * dψ/dvpar )*/ diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index d60f3e3d..0063a005 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -186,8 +186,12 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* Expand Aparallel. */ apar_e : doExpand1(apar,bC), apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), - aparCvar : eval_string(sconcat("apar")), - apar_c : makelistNoZeros1(apar_c, aparCvar), + printf(fh, " double apar_surf[~a] = {0.}; ~%", length(bSurf)), + aparSurfCvar : eval_string(sconcat("apar_surf")), + writeCExprsNoExpand1(aparSurfCvar, gcfac(float(expand(apar_c)))), + printf(fh, "~%"), + flush_output(fh), + apar_c : makelistNoZeros1(apar_c, aparSurfCvar), /* Expand projected Apar on basis. */ apar_e : doExpand(apar_c, bSurf), /* Eval Aparallel at nodes. */ @@ -199,6 +203,32 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ), /* It will be used to compute the contribution as ∇ x (A b) = ∇A x b + A ∇ x b */ + /* Try a version where we work with expansion of ∇A dH/dvpar = m vpar ∇A */ + dH_dvpar_e : diff(hamil_e,varsP[vpardim]), + mvpargradA_e : makelist(0, i, 1, cdim), + apar_e : doExpand1(apar,bC), + if em = true then ( + for i : 1 thru cdim do ( + dA_dx_e_ : diff(apar_e*rdx2vec[i],varsP[i]), + mvpargradA_e_ : dA_dx_e_*m_*vmap_e[1], + mvpargradA_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,mvpargradA_e_)), + printf(fh, " double mvpargradA_~a[~a] = {0.}; ~%", i, numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + mvpargradACvar : eval_string(sconcat("mvpargradA_",i)), + writeCExprsNoExpand1(mvpargradACvar, gcfac(float(expand(subst(replaceList, mvpargradA_c))))), + printf(fh, "~%"), + flush_output(fh), + mvpargradANoZero_c : makelistNoZeros1(mvpargradA_c, mvpargradACvar), + mvpargradA_e[i] : doExpand(mvpargradANoZero_c, bSurf) + ) + ), + + /* Now eval at nodes the ∇A dH/dvpar expansion */ + mvpargradA_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + mvpargradA_nodes[i] : float(evAtNodes(mvpargradA_e[i],surfNodes,surfIntVars)) + ), + /* Now calculate flux at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", length(bSurf)*(surfDir-1)), @@ -284,16 +314,23 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ), /* + 1/m ∇A x b/B . ∇ψ dH/dvpar */ if cdim = 3 then ( + /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ + /* Making the dA/dy and dA/dx terms vanish remove the oscillations. */ if surfDir = 1 then( - /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ - /* The oscillation appears at short time (observable frame 1). */ printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index], vpar0index) + /* printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", mvpargradA_nodes[2][j1index], mvpargradA_nodes[3][j1index]) */ + /* printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[2]; ~%", mvpargradA_nodes[2][j1index]), + printf(fh, " alpha_quad -= 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1]; ~%", mvpargradA_nodes[3][j1index]) */ ), if surfDir = 2 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index], vpar0index) + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", mvpargradA_nodes[3][j1index], mvpargradA_nodes[1][j1index]) + /* printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[2]; ~%", mvpargradA_nodes[3][j1index]), + printf(fh, " alpha_quad -= 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1]; ~%", mvpargradA_nodes[1][j1index]) */ ), if surfDir = 3 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index], vpar0index) + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", mvpargradA_nodes[1][j1index], mvpargradA_nodes[2][j1index]) + /* printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[2]; ~%", mvpargradA_nodes[1][j1index]), + printf(fh, " alpha_quad -= 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1]; ~%", mvpargradA_nodes[2][j1index]) */ ) ), /* in 2D, we take the first and last component of the 3D cross product, setting d/dy = 0.*/ diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 510d5fc2..80b12907 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -176,23 +176,23 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b dH_dx : dH_dz_nodes[1], dH_dy : dH_dz_nodes[2], dH_dz : dH_dz_nodes[3], - dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsC[1]),surfNodes,surfIntVars)), - dA_dy : float(evAtNodes(diff(apar_e*rdx2vec[2],varsC[2]),surfNodes,surfIntVars)), - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[3],varsC[3]),surfNodes,surfIntVars)) + dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), + dA_dy : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)), + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[3],varsP[3]),surfNodes,surfIntVars)) ) else if cdim = 2 then ( dH_dx : dH_dz_nodes[1], dH_dy : 0, dH_dz : dH_dz_nodes[2], - dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsC[1]),surfNodes,surfIntVars)), + dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), dA_dy : 0, - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[2],varsC[2]),surfNodes,surfIntVars)) + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)) ) else if cdim = 1 then ( dH_dx : 0, dH_dy : 0, dH_dz : dH_dz_nodes[1], dA_dx : 0, dA_dy : 0, - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[1],varsC[1]),surfNodes,surfIntVars)) + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)) ), gradHxgradA : [ dH_dy*dA_dz - dH_dz*dA_dy, @@ -200,6 +200,55 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b dH_dx*dA_dy - dH_dy*dA_dx ], + /* Work with expansions to the last point before evAtNodes */ + if cdim = 3 then ( + dH_dx_e : diff(hamil_e*rdx2vec[1],varsP[1]), + dH_dy_e : diff(hamil_e*rdx2vec[2],varsP[2]), + dH_dz_e : diff(hamil_e*rdx2vec[3],varsP[3]), + dA_dx_e : diff(apar_e*rdx2vec[1],varsP[1]), + dA_dy_e : diff(apar_e*rdx2vec[2],varsP[2]), + dA_dz_e : diff(apar_e*rdx2vec[3],varsP[3]) + ) else if cdim = 2 then ( + dH_dx_e : diff(hamil_e*rdx2vec[1],varsP[1]), + dH_dy_e : 0, + dH_dz_e : diff(hamil_e*rdx2vec[2],varsP[2]), + dA_dx_e : diff(apar_e*rdx2vec[1],varsP[1]), + dA_dy_e : 0, + dA_dz_e : diff(apar_e*rdx2vec[2],varsP[2]) + ) else if cdim = 1 then ( + dH_dx_e : 0, + dH_dy_e : 0, + dH_dz_e : diff(hamil_e*rdx2vec[1],varsP[1]), + dA_dx_e : 0, + dA_dy_e : 0, + dA_dz_e : diff(apar_e*rdx2vec[1],varsP[1]) + ), + gradHxgradA_e : [ + dH_dy_e*dA_dz_e - dH_dz_e*dA_dy_e, + dH_dz_e*dA_dx_e - dH_dx_e*dA_dz_e, + dH_dx_e*dA_dy_e - dH_dy_e*dA_dx_e + ], + + /* Write out the gradHxgradA expansion to be evaluated at nodes later. */ + for i : 1 thru 3 do ( + gradHxgradA_c_ : calcInnerProdList(varsP, 1, bP, gradHxgradA_e[i]), + printf(fh, " double gradHxgradA_~a[~a] = {0.}; ~%", i, numP), + replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], + gradHxgradACvar_ : eval_string(sconcat("gradHxgradA_",i)), + writeCExprsNoExpand1(gradHxgradACvar_, gcfac(float(expand(subst(replaceList, gradHxgradA_c_))))), + printf(fh, "~%"), + flush_output(fh), + gradHxgradANoZero_c_ : makelistNoZeros1(gradHxgradA_c_, gradHxgradACvar_), + /* Expand projected Hamiltonian on basis. */ + gradHxgradA_e[i] : doExpand(gradHxgradANoZero_c_,bP) + ), + + /* Now eval at nodes the ∇H x ∇A expansion */ + gradHxgradA_nodes : makelist(0, i, 1, 3), + for i : 1 thru 3 do ( + gradHxgradA_nodes[i] : float(evAtNodes(gradHxgradA_e[i],surfNodes,surfIntVars)) + ), + /* Now calculate alpha at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), From b1ba575454cabbe11d351f38d0283dbc11f78fca Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 17 Apr 2026 17:10:03 -0400 Subject: [PATCH 51/66] one line one missing but all good :sweat: --- .../gk_collisionless_flux-surf-conf.mac | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 0063a005..4ee4a55f 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -314,23 +314,14 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ), /* + 1/m ∇A x b/B . ∇ψ dH/dvpar */ if cdim = 3 then ( - /* This term is responsible of y oscillations in the Alfven 3x2v regression test. */ - /* Making the dA/dy and dA/dx terms vanish remove the oscillations. */ if surfDir = 1 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index], vpar0index) - /* printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", mvpargradA_nodes[2][j1index], mvpargradA_nodes[3][j1index]) */ - /* printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[2]; ~%", mvpargradA_nodes[2][j1index]), - printf(fh, " alpha_quad -= 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1]; ~%", mvpargradA_nodes[3][j1index]) */ + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", mvpargradA_nodes[2][j1index], mvpargradA_nodes[3][j1index]) ), if surfDir = 2 then( printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", mvpargradA_nodes[3][j1index], mvpargradA_nodes[1][j1index]) - /* printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[2]; ~%", mvpargradA_nodes[3][j1index]), - printf(fh, " alpha_quad -= 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1]; ~%", mvpargradA_nodes[1][j1index]) */ ), if surfDir = 3 then( printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", mvpargradA_nodes[1][j1index], mvpargradA_nodes[2][j1index]) - /* printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[2]; ~%", mvpargradA_nodes[1][j1index]), - printf(fh, " alpha_quad -= 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1]; ~%", mvpargradA_nodes[2][j1index]) */ ) ), /* in 2D, we take the first and last component of the 3D cross product, setting d/dy = 0.*/ From 27f9530ee0f675a4820eb4c2cb6c05814086c87c Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 17 Apr 2026 18:13:03 -0400 Subject: [PATCH 52/66] this is the minimal fix for the spurious alfven 3x2v oscillations --- .../gk_collisionless/gk_collisionless_flux-surf-conf.mac | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index d60f3e3d..9ba1f7d6 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -186,8 +186,12 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* Expand Aparallel. */ apar_e : doExpand1(apar,bC), apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), - aparCvar : eval_string(sconcat("apar")), - apar_c : makelistNoZeros1(apar_c, aparCvar), + printf(fh, " double apar_surf[~a] = {0.}; ~%", length(bSurf)), + aparSurfCvar : eval_string(sconcat("apar_surf")), + writeCExprsNoExpand1(aparSurfCvar, gcfac(float(expand(apar_c)))), + printf(fh, "~%"), + flush_output(fh), + apar_c : makelistNoZeros1(apar_c, aparSurfCvar), /* Expand projected Apar on basis. */ apar_e : doExpand(apar_c, bSurf), /* Eval Aparallel at nodes. */ From 460ff63ee27c54f17f130716396ec9c27e944f38 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 17 Apr 2026 18:21:17 -0400 Subject: [PATCH 53/66] Revert "Merge remote-tracking branch 'origin/main' into get_em_back_full_upwind" This reverts commit 5a5f0993afae591968a586a20884b75e210e4490, reversing changes made to 8beb786a26b54a75d3425f9e478857adca7f2c10. --- .../ambi_bolt_potential_funcs.mac | 122 +- .../ms-ambi_bolt_potential-header.mac | 6 +- .../g0/charge_exchange/ms-sigma-cx-calc.mac | 36 - maxima/g0/charge_exchange/sigma-cx-calc.mac | 117 - .../gkCrossPrimMomsBGKFuncs.mac | 88 +- .../ms-gkCrossPrimMomsBGK-header.mac | 67 - .../cross_prim_moms/ms-gkCrossPrimMomsBGK.mac | 56 +- .../ms-gkCrossPrimMomsBGKHeader.mac | 66 + .../gk_neut_fluid_prim_vars-flowE.mac | 187 - .../gk_neut_fluid_prim_vars-pressure.mac | 58 - .../gk_neut_fluid_prim_vars-temp.mac | 211 - .../gk_neut_fluid_prim_vars-udrift.mac | 187 - .../gk_neut_fluid_prim_vars-udrift_temp.mac | 279 -- .../ms-gk_neut_fluid_prim_vars-flowE.mac | 61 - .../ms-gk_neut_fluid_prim_vars-header.mac | 70 - .../ms-gk_neut_fluid_prim_vars-pressure.mac | 53 - .../ms-gk_neut_fluid_prim_vars-temp.mac | 61 - .../ms-gk_neut_fluid_prim_vars-udrift.mac | 61 - ...ms-gk_neut_fluid_prim_vars-udrift_temp.mac | 61 - .../g0/gk_pol_den/ms-pol_density-header.mac | 8 +- maxima/g0/gk_pol_den/ms-pol_density.mac | 14 +- maxima/g0/gk_pol_den/pol_density.mac | 6 +- maxima/g0/neutrals/sigma-cx-calc.mac | 139 + maxima/g0/prim_moments/CrossPrimMomsLBO.mac | 55 +- .../g0/prim_moments/ms-gkCrossPrimMomsLBO.mac | 4 +- .../prim_moments/ms-gkPrimMoments-header.mac | 2 +- .../code_generator_core.rkt | 126 +- .../code_generator_vector.rkt | 132 +- .../finite_volume/code_generator_core_2d.rkt | 1977 --------- .../code_generator_vector_2d.rkt | 3281 --------------- .../finite_volume/prover_vector.rkt | 1916 --------- .../finite_volume/test_inviscid_burgers.rkt | 448 -- .../test_isothermal_euler_2d.rkt | 350 -- .../finite_volume/test_linear_advection.rkt | 451 -- .../gkyl_code_generator_lax.rkt | 0 .../gkyl_code_generator_lax_vector.rkt | 0 .../gkyl_code_generator_roe.rkt | 0 .../gkyl_code_generator_roe_vector.rkt | 0 .../gkyl_test_inviscid_burgers.rkt | 0 .../gkyl_test_isothermal_euler_mom_x.rkt | 0 .../gkyl_test_isothermal_euler_mom_yz.rkt | 0 .../gkyl_test_limiters.rkt | 0 .../gkyl_test_linear_advection.rkt | 0 .../gkyl_test_maxwell_1d_Bx_psi.rkt | 0 .../gkyl_test_maxwell_1d_Ex_phi.rkt | 0 .../gkyl_test_maxwell_1d_Ey_Bz.rkt | 0 .../gkyl_test_maxwell_1d_Ez_By.rkt | 0 .../code_generator_core_training.rkt | 1415 ------- .../code_generator_core_training_2d.rkt | 2325 ----------- .../code_generator_core_validation.rkt | 976 ----- .../code_generator_matrix_training.rkt | 920 ---- .../code_generator_matrix_training_2d.rkt | 1827 -------- .../code_generator_matrix_validation.rkt | 1074 ----- .../code_generator_vector_training.rkt | 1888 --------- .../code_generator_vector_training_2d.rkt | 3717 ----------------- .../code_generator_vector_validation.rkt | 1036 ----- .../neural_networks/prover_core.rkt | 624 --- .../neural_networks/prover_matrix.rkt | 901 ---- .../neural_networks/prover_vector.rkt | 826 ---- .../neural_networks/test_euler_shallow.rkt | 450 -- .../test_inviscid_burgers_shallow.rkt | 403 -- .../test_isothermal_euler_shallow.rkt | 480 --- .../test_linear_advection_shallow.rkt | 405 -- .../{finite_volume => }/prover_core.rkt | 365 -- provable-algorithms/prover_vector.rkt | 1052 +++++ provable-algorithms/test_inviscid_burgers.rkt | 217 + .../test_isothermal_euler_mom_x.rkt | 0 .../test_isothermal_euler_mom_yz.rkt | 0 .../{finite_volume => }/test_limiters.rkt | 0 provable-algorithms/test_linear_advection.rkt | 218 + .../test_maxwell_1d_Bx_psi.rkt | 0 .../test_maxwell_1d_Ex_phi.rkt | 0 .../test_maxwell_1d_Ey_Bz.rkt | 0 .../test_maxwell_1d_Ez_By.rkt | 0 74 files changed, 1920 insertions(+), 29955 deletions(-) delete mode 100644 maxima/g0/charge_exchange/ms-sigma-cx-calc.mac delete mode 100644 maxima/g0/charge_exchange/sigma-cx-calc.mac delete mode 100644 maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac create mode 100644 maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGKHeader.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-flowE.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-header.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-pressure.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-temp.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift.mac delete mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift_temp.mac create mode 100644 maxima/g0/neutrals/sigma-cx-calc.mac rename provable-algorithms/{finite_volume => }/code_generator_core.rkt (92%) rename provable-algorithms/{finite_volume => }/code_generator_vector.rkt (94%) delete mode 100644 provable-algorithms/finite_volume/code_generator_core_2d.rkt delete mode 100644 provable-algorithms/finite_volume/code_generator_vector_2d.rkt delete mode 100644 provable-algorithms/finite_volume/prover_vector.rkt delete mode 100644 provable-algorithms/finite_volume/test_inviscid_burgers.rkt delete mode 100644 provable-algorithms/finite_volume/test_isothermal_euler_2d.rkt delete mode 100644 provable-algorithms/finite_volume/test_linear_advection.rkt rename provable-algorithms/{finite_volume => }/gkyl_code_generator_lax.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_code_generator_lax_vector.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_code_generator_roe.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_code_generator_roe_vector.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_test_inviscid_burgers.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_test_isothermal_euler_mom_x.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_test_isothermal_euler_mom_yz.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_test_limiters.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_test_linear_advection.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_test_maxwell_1d_Bx_psi.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_test_maxwell_1d_Ex_phi.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_test_maxwell_1d_Ey_Bz.rkt (100%) rename provable-algorithms/{finite_volume => }/gkyl_test_maxwell_1d_Ez_By.rkt (100%) delete mode 100644 provable-algorithms/neural_networks/code_generator_core_training.rkt delete mode 100644 provable-algorithms/neural_networks/code_generator_core_training_2d.rkt delete mode 100644 provable-algorithms/neural_networks/code_generator_core_validation.rkt delete mode 100644 provable-algorithms/neural_networks/code_generator_matrix_training.rkt delete mode 100644 provable-algorithms/neural_networks/code_generator_matrix_training_2d.rkt delete mode 100644 provable-algorithms/neural_networks/code_generator_matrix_validation.rkt delete mode 100644 provable-algorithms/neural_networks/code_generator_vector_training.rkt delete mode 100644 provable-algorithms/neural_networks/code_generator_vector_training_2d.rkt delete mode 100644 provable-algorithms/neural_networks/code_generator_vector_validation.rkt delete mode 100644 provable-algorithms/neural_networks/prover_core.rkt delete mode 100644 provable-algorithms/neural_networks/prover_matrix.rkt delete mode 100644 provable-algorithms/neural_networks/prover_vector.rkt delete mode 100644 provable-algorithms/neural_networks/test_euler_shallow.rkt delete mode 100644 provable-algorithms/neural_networks/test_inviscid_burgers_shallow.rkt delete mode 100644 provable-algorithms/neural_networks/test_isothermal_euler_shallow.rkt delete mode 100644 provable-algorithms/neural_networks/test_linear_advection_shallow.rkt rename provable-algorithms/{finite_volume => }/prover_core.rkt (69%) create mode 100644 provable-algorithms/prover_vector.rkt create mode 100644 provable-algorithms/test_inviscid_burgers.rkt rename provable-algorithms/{finite_volume => }/test_isothermal_euler_mom_x.rkt (100%) rename provable-algorithms/{finite_volume => }/test_isothermal_euler_mom_yz.rkt (100%) rename provable-algorithms/{finite_volume => }/test_limiters.rkt (100%) create mode 100644 provable-algorithms/test_linear_advection.rkt rename provable-algorithms/{finite_volume => }/test_maxwell_1d_Bx_psi.rkt (100%) rename provable-algorithms/{finite_volume => }/test_maxwell_1d_Ex_phi.rkt (100%) rename provable-algorithms/{finite_volume => }/test_maxwell_1d_Ey_Bz.rkt (100%) rename provable-algorithms/{finite_volume => }/test_maxwell_1d_Ez_By.rkt (100%) diff --git a/maxima/g0/ambi_bolt_potential/ambi_bolt_potential_funcs.mac b/maxima/g0/ambi_bolt_potential/ambi_bolt_potential_funcs.mac index 5cb2552c..2b9a5187 100644 --- a/maxima/g0/ambi_bolt_potential/ambi_bolt_potential_funcs.mac +++ b/maxima/g0/ambi_bolt_potential/ambi_bolt_potential_funcs.mac @@ -8,22 +8,19 @@ load("modal-basis"); load("out-scripts"); load(stringproc)$ load("nodal_operations/quadrature_functions")$ -load("utilities_gyrokinetic")$ fpprec : 24$ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( /* Compute the sheath entrance potential using Gaussian quadrature. */ - [numQuad,vars,basis,numB,bmagBasis,sheathDir,sheathVar,sheathSurfVars,varsLowD,basisLowD,numBLowD, - boundaryStr,ghostEvSign,skinEvSign,GammaJacIon_e,GammaJacIonB_c, - cmag_e,jacobtotInv_e,x3HalfMomJacElc_e,x3HalfMomJacElcB_c,x3HalfMomJacElcB_e,x3HalfMomJacElcB_n, - GammaJacIonB_e,m0JacIon_e,m0JacIonB_c,m0JacIonB_e,phiSlowD_c, - phiSlowD_e,phiS_c,expr,m0Ion_c,m0Ion_e,m0IonS_c], + [numQuad,vars,basis,numB,sheathDir,sheathVar,sheathSurfVars,varsLowD,basisLowD,numBLowD, + boundaryStr,ghostEvSign,skinEvSign,GammaJacIon_e,GammaJacIonB_c,GammaJacIonB_noZero_c, + GammaJacIonB_e,m0JacIon_e,m0JacIonB_c,m0JacIonB_noZero_c,m0JacIonB_e,phiSlowD_c, + phiSlowD_e,phiS_c,expr,jacInv_e,m0Ion_c,m0Ion_e,m0IonS_c], numQuad : polyOrder+1, /* Number of quarature points in 1D. */ [vars, basis] : loadBasis(basisNm, dim, polyOrder), numB : length(basis), - bmagBasis : getAxisymmetricConfBasis(basis), sheathDir : dim, /* Assume the last dimension is the sheath direction. */ sheathVar : vars[sheathDir], @@ -51,71 +48,57 @@ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( ghostEvSign : [1, -1], skinEvSign : [-1, 1], for bS : 1 thru 2 do ( /* One kernel for each of lower and upper boundaries. */ - printf(fh,sconcat("GKYL_CU_DH void ",funcNm,"(double sheathDirDx, double q_e, double m_e, double T_e, const double *cmag, const double *jacobtotInv, const double *GammaJac_i, const double *m0Ion, const double *m0JacIon, double *out) ~%{ ~%"), boundaryStr[bS]), + printf(fh,sconcat("GKYL_CU_DH void ",funcNm,"(double sheathDirDx, double q_e, double m_e, double T_e, const double *jacInv, const double *GammaJac_i, const double *m0JacIon, double *out) ~%{ ~%"), boundaryStr[bS]), printf(fh," // sheathDirDx: cell length in direction of the sheath.~%"), printf(fh," // q_e: electron change.~%"), printf(fh," // m_e: electron mass.~%"), printf(fh," // T_e: electron temperature.~%"), - printf(fh," // cmag: Clebsch function in definition of magnetic field.~%"), - printf(fh," // jacobtotInv: reciprocal of the phase-space and conf-space Jacobians (1/(J*B)).~%"), + printf(fh," // jacInv: reciprocal of the geometry Jacobian (1/J).~%"), printf(fh," // GammaJac_i: ion particle flux (times the Jacobian) through sheath entrance.~%"), - printf(fh," // m0Ion: ion density.~%"), printf(fh," // m0JacIon: ion density (times the geometry Jacobian).~%"), printf(fh," // out: ion density and electrostatic potential at the sheath entrance.~%"), printf(fh,"~%"), - m0Ion_e : doExpand1(m0Ion, basis), - m0JacIon_e : doExpand1(m0JacIon, basis), - - m0IonS_c : calcInnerProdList(vars, 1, basis, subst(sheathVar=skinEvSign[bS],m0Ion_e)), - printf(fh," // Particle number density evaluate at the sheath entrance~%"), - expr : float(m0IonS_c), - for i : 1 thru length(expr) do ( - if expr[i] # 0.0 then printf(fh, " ~a = ~a; ~%", out[i-1], gcfac(expr[i])) - ), - printf(fh,"~%"), - /* Particle flux expanded in basis. Need to multiply by an extra dx/2 because of the way the boundary fluxes are computed. */ GammaJacIon_e : (sheathDirDx/2)*doExpand1(GammaJac_i, basis), /* Evaluate the (ghost cell) flux at the boundary surface. */ GammaJacIonB_c : calcInnerProdList(varsLowD,1,basisLowD,subst(sheathVar=ghostEvSign[bS], GammaJacIon_e)), + GammaJacIonB_noZero_c : makelistNoZeros1(GammaJacIonB_c, GammaJacIonB), + GammaJacIonB_e : doExpand(GammaJacIonB_noZero_c,basisLowD), printf(fh," double GammaJacIonB[~a];~%", numBLowD), writeCExprs1(GammaJacIonB, GammaJacIonB_c), printf(fh,"~%"), - GammaJacIonB_c : makelistNoZeros1(GammaJacIonB_c, GammaJacIonB), - GammaJacIonB_e : doExpand(GammaJacIonB_c,basisLowD), - - /* - Evaluate the x^3 half moment (over positive or negative vpar) of the electrons, - where x^3=C*vpar/(J*B), and assume quasineutrality so n_i appears instead of n_e. - */ - cmag_e : doExpand1(cmag, bmagBasis), - jacobtotInv_e : doExpand1(jacobtotInv, bmagBasis), - x3HalfMomJacElc_e : (1/sqrt(2*%pi))*cmag_e*jacobtotInv_e*m0JacIon_e*sqrt(T_e/m_e), - x3HalfMomJacElcB_c : calcInnerProdList(varsLowD,1,basisLowD,subst(sheathVar=skinEvSign[bS], x3HalfMomJacElc_e)), - printf(fh," double x3HalfMomJacElcB[~a];~%", numBLowD), - writeCExprs1(x3HalfMomJacElcB, x3HalfMomJacElcB_c), - printf(fh,"~%"), - x3HalfMomJacElcB_c : makelistNoZeros1(x3HalfMomJacElcB_c, x3HalfMomJacElcB), - x3HalfMomJacElcB_e : doExpand(x3HalfMomJacElcB_c,basisLowD), + m0JacIon_e : doExpand1(m0JacIon, basis), /* Evaluate the (skin cell) ion density at the boundary surface. */ m0JacIonB_c : calcInnerProdList(varsLowD,1,basisLowD,subst(sheathVar=skinEvSign[bS], m0JacIon_e)), + m0JacIonB_noZero_c : makelistNoZeros1(m0JacIonB_c, m0JacIonB), + m0JacIonB_e : doExpand(m0JacIonB_noZero_c,basisLowD), printf(fh," double m0JacIonB[~a];~%", numBLowD), writeCExprs1(m0JacIonB, m0JacIonB_c), printf(fh,"~%"), - m0JacIonB_c : makelistNoZeros1(m0JacIonB_c, m0JacIonB), - m0JacIonB_e : doExpand(m0JacIonB_c,basisLowD), + + /* Density at the sheath entrance. */ + jacInv_e : doExpand1(jacInv,basis), + m0Ion_c : calcInnerProdList(vars, jacInv_e, basis, m0JacIon_e), + m0Ion_e : doExpand(m0Ion_c,basis), + + m0IonS_c : calcInnerProdList(vars, 1, basis, subst(sheathVar=skinEvSign[bS],m0Ion_e)), + printf(fh," // Particle number density evaluate at the sheath entrance~%"), + expr : float(m0IonS_c), + for i : 1 thru length(expr) do ( + if expr[i] # 0.0 then printf(fh, " ~a = ~a; ~%", out[i-1], gcfac(expr[i])) + ), + printf(fh,"~%"), /* Compute the sheath potential - phiS = (T_e/q_e)*log( GammaJac_i/((1/sqrt(2*pi))*(c/(J*B))*n_i*sqrt(T_e/m_e)) ) + phiS = (T_e/q_e)*log( sqrt(2*pi)*GammaJac_i/(n_i*sqrt(T_e/m_e)) ) using quadrature. If dim=1 no quadrature is needed. */ phiSlowD_c : makelist(0,i,1,numBLowD), if dim=1 then ( - printf(fh," double phiS_qp[1];~%"), - phiSlowD_c : [(T_e/q_e)*log(GammaJacIonB_e/x3HalfMomJacElcB_e)], + phiSlowD_c : [(T_e/q_e)*log(sqrt(2*%pi)*GammaJacIonB_e/(m0JacIonB_e*sqrt(T_e/m_e)))], printf(fh," if ((isfinite(~a)) && (~a>0.) && (~a>0.)) {~%",GammaJacIonB_e,GammaJacIonB_e,m0JacIonB_e), printf(fh," phiS_qp[0] = ~a;~%",float(expand(phiSlowD_c[1]))), printf(fh," } else {~%"), @@ -123,25 +106,21 @@ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( printf(fh," }~%"), printf(fh,"~%"), phiSlowD_e : phiS_qp[0] - ) else ( - - m0JacIonB_n : makelist(0,i,1,ordNum), + m0JacIonB_n : makelist(0,i,1,ordNum), GammaJacIonB_n : makelist(0,i,1,ordNum), - x3HalfMomJacElcB_n : makelist(0,i,1,ordNum), for i : 1 thru ordNum do ( nOrd : normOrds[i], cSub : makelist(varsLowD[d]=normOrds[i][d],d,1,dim-1), - m0JacIonB_n[i] : subst(cSub, m0JacIonB_e), - GammaJacIonB_n[i] : subst(cSub, GammaJacIonB_e), - x3HalfMomJacElcB_n[i] : subst(cSub, x3HalfMomJacElcB_e) + m0JacIonB_n[i] : subst(cSub, m0JacIonB_e), + GammaJacIonB_n[i] : subst(cSub, GammaJacIonB_e) ), printf(fh," double phiS_qp[~a];~%", ordNum), phiS_n : makelist(0,i,1,ordNum), for i : 1 thru ordNum do ( - phiS_n[i] : (T_e/q_e)*log(GammaJacIonB_n[i]/x3HalfMomJacElcB_n[i]), + phiS_n[i] : (T_e/q_e)*log(sqrt(2*%pi)*GammaJacIonB_n[i]/(m0JacIonB_n[i]*sqrt(T_e/m_e))), printf(fh," if ((isfinite(~a)) && (~a>0.) && (~a>0.)) {~%",float(GammaJacIonB_n[i]),float(GammaJacIonB_n[i]),float(m0JacIonB_n[i])), printf(fh," phiS_qp[~a] = ~a;~%",i-1,float(expand(phiS_n[i]))), printf(fh," } else {~%"), @@ -159,7 +138,6 @@ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( ) ), phiSlowD_e : doExpand(phiSlowD_c, basisLowD) - ), phiS_c : calcInnerProdList(vars, 1, basis, phiSlowD_e), @@ -177,8 +155,8 @@ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( genPhiCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( /* Compute the potential in the domain volume using Gaussian quadrature. */ - [numQuad,vars,basis,numB,normOrds,weights,ordNum, - m0Ion_e,m0IonS_e,phiS_e,m0Ion_n,m0IonS_n, + [numQuad,vars,basis,numB,normOrds,weights,ordNum,m0JacIon_e, + jacInv_e,m0Ion_c,m0Ion_e,m0Ion_noZero_c,m0IonS_e,phiS_e,m0Ion_n,m0IonS_n, phiS_n,nOrd,cSub,phi_n,phi_c], numQuad : polyOrder+1, /* Number of quarature points in 1D. */ @@ -190,15 +168,25 @@ genPhiCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( [normOrds, weights] : gaussOrdWeight(numQuad,dim), ordNum : length(normOrds), - printf(fh,sconcat("GKYL_CU_DH void ",funcNm,"(double q_e, double T_e, const double *m0Ion, const double *sheathvals, double *phi) ~%{ ~%")), - printf(fh," // q_e: electron change.~%"), - printf(fh," // T_e: electron temperature.~%"), - printf(fh," // m0Ion: ion density.~%"), + printf(fh,sconcat("GKYL_CU_DH void ",funcNm,"(double q_e, double T_e, const double *jacInv, const double *m0JacIon, const double *sheathvals, double *phi) ~%{ ~%")), + printf(fh," // q_e: electron change.~%"), + printf(fh," // T_e: electron temperature.~%"), + printf(fh," // jacInv: reciprocal of the geometry Jacobian (1/J).~%"), + printf(fh," // m0JacIon: ion density.~%"), printf(fh," // sheathvals: ion density and electrostatic potential at the sheath entrance.~%"), - printf(fh," // phi: electrostatic potential in domain volume.~%"), + printf(fh," // phi: electrostatic potential in domain volume.~%"), printf(fh,"~%"), - m0Ion_e : doExpand1(m0Ion, basis), + m0JacIon_e : doExpand1(m0JacIon, basis), + + jacInv_e : doExpand1(jacInv,basis), + m0Ion_c : calcInnerProdList(vars, jacInv_e, basis, m0JacIon_e), + m0Ion_e : doExpand(m0Ion_c,basis), + m0Ion_noZero_c : makelistNoZeros1(m0Ion_c, m0Ion), + m0Ion_e : doExpand(m0Ion_noZero_c,basis), + printf(fh," double m0Ion[~a];~%", numB), + writeCExprs1(m0Ion, m0Ion_c), + printf(fh,"~%"), m0IonS_e : doExpand(makelist(sheathvals[i-1],i,1,numB), basis), phiS_e : doExpand(makelist(sheathvals[numB+i-1],i,1,numB), basis), @@ -218,20 +206,12 @@ genPhiCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( phiS_n[i] : subst(cSub, phiS_e) ), - printf(fh," double phi_qp[~a];~%", ordNum), - printf(fh," double m0IonS_curr;~%"), phi_n : makelist(0,i,1,ordNum), for i : 1 thru ordNum do ( - printf(fh," m0IonS_curr = ~a;~%",float(expand(m0IonS_n[i]))), - - phi_n[i] : phiS_n[i] - (T_e/q_e)*log(fmax(m0Ion_n[i],m0IonS_curr)/m0IonS_curr), - - printf(fh," if ((isfinite(~a)) && (~a>0.)) {~%",m0IonS_curr,m0IonS_curr), - printf(fh," phi_qp[~a] = ~a;~%",i-1,float(expand(phi_n[i]))), - printf(fh," } else {~%"), - printf(fh," phi_qp[~a] = 0.0;~%",i-1), - printf(fh," }~%") + phi_n[i] : phiS_n[i] - (T_e/q_e)*log(m0Ion_n[i]/m0IonS_n[i]) ), + printf(fh," double phi_qp[~a];~%", ordNum), + writeCExprs1(phi_qp, phi_n), printf(fh,"~%"), phi_c : makelist(0,i,1,numB), diff --git a/maxima/g0/ambi_bolt_potential/ms-ambi_bolt_potential-header.mac b/maxima/g0/ambi_bolt_potential/ms-ambi_bolt_potential-header.mac index 4c1eb4f0..09618c60 100644 --- a/maxima/g0/ambi_bolt_potential/ms-ambi_bolt_potential-header.mac +++ b/maxima/g0/ambi_bolt_potential/ms-ambi_bolt_potential-header.mac @@ -18,7 +18,7 @@ printf(fh, "//------------------------------------------------------------------ printf(fh, "#pragma once~%")$ printf(fh, "~%")$ printf(fh, "#include ~%")$ -printf(fh, "#include ~%~%")$ +printf(fh, "#include ~%~%")$ printf(fh, "~%")$ printf(fh, "EXTERN_C_BEG~%")$ @@ -30,9 +30,9 @@ for bInd : 1 thru length(bName) do ( for ci : 1 thru 3 do ( for bS : 1 thru 2 do ( /* One kernel for each of lower and upper boundaries. */ - printf(fh, " GKYL_CU_DH void ambi_bolt_potential_sheath_calc_~a_~ax_~a_p~a(double sheathDirDx, double q_e, double m_e, double T_e, const double *cmag, const double *jacobtotInv, const double *GammaJac_i, const double *m0Ion, const double *m0JacIon, double *out); ~%", boundaryStr[bS], ci, bName[bInd], pi) + printf(fh, " GKYL_CU_DH void ambi_bolt_potential_sheath_calc_~a_~ax_~a_p~a(double sheathDirDx, double q_e, double m_e, double T_e, const double *jacInv, const double *GammaJac_i, const double *m0JacIon, double *out); ~%", boundaryStr[bS], ci, bName[bInd], pi) ), - printf(fh, " GKYL_CU_DH void ambi_bolt_potential_phi_calc_~ax_~a_p~a(double q_e, double T_e, const double *m0Ion, const double *sheathvals, double *phi); ~%", ci, bName[bInd], pi), + printf(fh, " GKYL_CU_DH void ambi_bolt_potential_phi_calc_~ax_~a_p~a(double q_e, double T_e, const double *jacInv, const double *m0JacIon, const double *sheathvals, double *phi); ~%", ci, bName[bInd], pi), printf(fh, "~%") ), diff --git a/maxima/g0/charge_exchange/ms-sigma-cx-calc.mac b/maxima/g0/charge_exchange/ms-sigma-cx-calc.mac deleted file mode 100644 index 7b521f2d..00000000 --- a/maxima/g0/charge_exchange/ms-sigma-cx-calc.mac +++ /dev/null @@ -1,36 +0,0 @@ -/* Generate CX cross section (vSigmaCX) kernels for charge - exchange operator */ - -load("charge_exchange/sigma-cx-calc.mac"); -load(stringproc)$ -fpprec : 24$ - -/* Serendipity basis. */ -maxPolyOrder_Ser : 2$ - -bName : ["ser"]$ -maxPolyOrder : [maxPolyOrder_Ser]$ - -fh : openw("~/max-out/gkyl_dg_cx_kernels.h")$ -printf(fh, "#pragma once ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ - -for bInd : 1 thru length(bName) do ( - for c : 1 thru 3 do ( - - max_p : maxPolyOrder[bInd], - if c = 3 then (max_p : 1), - - for p : 1 thru max_p do ( - disp(printf(false,sconcat("Creating v_sigma_cx ", bName[bInd]," ~ax"),c)), - - print("attempting to print",c,"x",p,"p functions..."), - /*. Calculate CX cross section. */ - funcNm : sconcat("sigma_cx_", c, "x_", bName[bInd]), - - calcSigmaCXcellAv(fh, funcNm, c, bName[bInd], p) - ) - ) -); -close(fh)$ diff --git a/maxima/g0/charge_exchange/sigma-cx-calc.mac b/maxima/g0/charge_exchange/sigma-cx-calc.mac deleted file mode 100644 index 24e71300..00000000 --- a/maxima/g0/charge_exchange/sigma-cx-calc.mac +++ /dev/null @@ -1,117 +0,0 @@ -/* Generate CX cross section (vSigmaCX) kernels for charge - exchange operator */ - -load("modal-basis"); -load("out-scripts"); -load(stringproc)$ -fpprec : 24$ - -declareWriteCExprsC(lhs, rhs) := block([expr], - expr : float(expand(rhs)), - if expr # 0.0 then ( - ep : string(expr), - for i : 0 thru 60 do ( - ep : ssubst(string(pow(u_ion[i],2.)),string(u_ion[i]^2),ep), - ep : ssubst(string(pow(u_neut[i],2.)),string(u_neut[i]^2),ep) - ), - printf(fh, " double ~a = ~a; ~%", lhs, ep) - ) -)$ - -writeCExprsCs(lhs, rhs) := block([expr], - expr : float(expand(rhs)), - for i : 1 thru length(expr) do ( - if expr[i] # 0.0 then ( - ep : string(expr[i]), - ep : ssubst("log(","ln(",ep), - printf(fh, " ~a = ~a; ~%", lhs[i-1], ep) - ) - ) -)$ - -writeCExprsC(lhs, rhs) := block([expr], - expr : float(expand(rhs)), - if expr # 0.0 then ( - ep : string(expr), - printf(fh, " ~a = ~a; ~%", lhs, ep) - ) -)$ - -/* vSigmaCX for charge exchange cross section */ -calcSigmaCXcellAv(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC,bC,NC,m0_e,m0_av,u_ion_av_c,u_neut_av_c,u_ion_av,u_neut_av,vi,vt_sq_ion_av_c, - vt_sq_neut_av_c,v_in_sq_c,v_sigma_cx_c,v_sigma_cx_e,v_sigma_cx_av], - - vdim : 3, /* Assume neutrals are always 3v. */ - - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - NC : length(bC), - - printf(fh, " ~%"), - printf(fh, "GKYL_CU_DH static inline ~%"), - printf(fh, "double ~a_p~a(const double a, const double b, double vt_sq_ion_min, double vt_sq_neut_min, const double *maxwellian_moms_ion, const double *maxwellian_moms_neut, const double *u_ion, double* GKYL_RESTRICT v_sigma_cx) ~%{ ~%", funcNm, p), - printf(fh, " // a: constant in fitting function.~%"), - printf(fh, " // b: constant in fitting function.~%"), - printf(fh, " // maxwellian_moms_ion[~a]: ion prim vars.~%", NC*(1+2)), - printf(fh, " // maxwellian_moms_neut[~a]: neut prim vars.~%", NC*(3+2)), - printf(fh, " // u_ion[~a]: ion drift velocity vector (upar_i b_1, upar_i b_2, upar_i b_3).~%",NC*3), - printf(fh, " // v_sigma_cx: cell ave cross section fitting eqn.~%"), - printf(fh, "~%"), - - m0_neut_e : doExpand1(maxwellian_moms_neut,bC), - m0_neut_av_e : innerProd(varsC,1.0,1.0,m0_neut_e)/innerProd(varsC,1.0,1.0,1.0), - declareWriteCExprsC(m0_neut_av, m0_neut_av_e), - printf(fh, " ~%"), - - printf(fh, " const double *vt_sq_ion = &maxwellian_moms_ion[~a]; ~%", NC*(1+1)), - printf(fh, " const double *u_neut = &maxwellian_moms_neut[~a]; ~%", NC), - printf(fh, " const double *vt_sq_neut = &maxwellian_moms_neut[~a]; ~%", NC*(3+1)), - printf(fh, " ~%"), - - u_ion_e : subst(makelist( u_ion[i]=u_ion[i+a0] ,i,0,NC-1), doExpand1(u_ion,bC)), - u_neut_e : subst(makelist(u_neut[i]=u_neut[i+a0],i,0,NC-1), doExpand1(u_neut,bC)), - - u_ion_av : makelist(0,i,1,vdim), - u_neut_av : makelist(0,i,1,vdim), - for vi : 1 thru vdim do ( - u_ion_av[vi] : innerProd(varsC,1.0,1.0,u_ion_e)/innerProd(varsC,1.0,1.0,1.0), - u_ion_av[vi] : fullratsimp(subst(a0=(vi-1)*NC,u_ion_av[vi])), - - u_neut_av[vi] : innerProd(varsC,1.0,1.0,u_neut_e)/innerProd(varsC,1.0,1.0,1.0), - u_neut_av[vi] : fullratsimp(subst(a0=(vi-1)*NC,u_neut_av[vi])) - ), - - vt_sq_ion_av_c : innerProd(varsC,1.0,1.0, doExpand1(vt_sq_ion,bC))/innerProd(varsC,1.0,1.0,1.0), - vt_sq_neut_av_c : innerProd(varsC,1.0,1.0, doExpand1(vt_sq_neut,bC))/innerProd(varsC,1.0,1.0,1.0), - - declareWriteCExprsC(vt_sq_ion_av, vt_sq_ion_av_c), - declareWriteCExprsC(vt_sq_neut_av, vt_sq_neut_av_c), - - /* Limit how low the temperature can get (set by the velocity grid). */ - printf(fh, " if ((vt_sq_ion_av > 0.) && (vt_sq_ion_av < vt_sq_ion_min)) vt_sq_ion_av = vt_sq_ion_min;~%"), - printf(fh, " if ((vt_sq_neut_av > 0.) && (vt_sq_neut_av < vt_sq_neut_min)) vt_sq_neut_av = vt_sq_neut_min;~%"), - printf(fh, " ~%"), - - /* Define and write v_sigma_cx */ - printf(fh, " if (m0_neut_av <= 0 || vt_sq_neut_av <= 0 || vt_sq_ion_av <= 0) { ~%"), - printf(fh, " v_sigma_cx[0] = 0.0;~%"), - printf(fh, " return 0.0; ~%"), - printf(fh, " } else {~%"), - - /* Define v_in variable: v_in_sq = |u_ion - u_neut|^2 */ - v_in_sq_c : innerProd(varsC,1.0,1.0,sum((u_ion_av[d] - u_neut_av[d])^2,d,1,vdim))/innerProd(varsC,1.0,1.0,1.0), - declareWriteCExprsC(v_in_sq_av, v_in_sq_c), - printf(fh, " ~%"), - - printf(fh, " double v_cx = ~a;~%",float(sqrt(4/%pi*vt_sq_ion_av + 4/%pi*vt_sq_neut_av + v_in_sq_av))), - v_sigma_cx_c : calcInnerProdList(varsC,1.0,bC,v_cx*(a - b*ln(v_cx))), - writeCExprsCs(v_sigma_cx, v_sigma_cx_c), - printf(fh, " ~%"), - - v_sigma_cx_e : doExpand1(v_sigma_cx,bC), - v_sigma_cx_av : innerProd(varsC,1.0,1.0,v_sigma_cx_e)/innerProd(varsC,1.0,1.0,1.0), - cflRate : float(expand(fullratsimp(m0_neut_av*v_sigma_cx_av/(2*p+1)))), - printf(fh, " return ~a; ~%",cflRate), - printf(fh, " }~%"), - printf(fh, "} ~%") -)$ diff --git a/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac b/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac index 318dbbf9..63575363 100644 --- a/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac +++ b/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac @@ -9,16 +9,18 @@ load("nodal_operations/nodal_functions"); load(stringproc)$ fpprec : 24$ -calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( +calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vgk, basisFun, polyOrder) := block( [varsC, bC, NC], + kill(varsC, bC), + /* Load basis of dimensionality requested. */ [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), /* Number of basis monomials. */ - NC : length(bC), + NC : length(bC), - print("gk ", cdim,"x", vdim, "v", polyOrder, "p"), + print("gk ", cdim,"x", vgk, "v", polyOrder, "p"), /* Include the header files. */ printf(fh, "#include ~%"), @@ -27,13 +29,9 @@ calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( printf(fh, " ~%"), /* Function declaration with input/output variables. */ - printf(fh, "GKYL_CU_DH void ~a(const double delta_sr, const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, double *prim_moms_cross) ~%{ ~%", funcNm), - printf(fh, " // delta_sr: Free parameter in relation between nu_sr and alpha_E. ~%"), - printf(fh, " // betaGreenep1: Greene's beta + 1. ~%"), - printf(fh, " // m_self: mass of this species. ~%"), - printf(fh, " // prim_moms_self: primitive moments of this species. ~%"), - printf(fh, " // m_other: mass of other species. ~%"), - printf(fh, " // prim_moms_other: primitive moments of other species. ~%"), + printf(fh, "GKYL_CU_DH void ~a(const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, const double *nu_sr, const double *nu_rs, double *prim_moms_cross) ~%{ ~%", funcNm), + printf(fh, " // m_: mass. ~%"), + printf(fh, " // prim_moms_: primitive moments of the distribution function. ~%"), printf(fh, " // prim_moms_cross: cross primitive moments. ~%"), printf(fh, " ~%"), @@ -51,6 +49,41 @@ calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( printf(fh, " double *n_sr = &prim_moms_cross[~a]; ~%", 0), printf(fh, " double *upar_sr = &prim_moms_cross[~a]; ~%", NC*1), printf(fh, " double *vtsq_sr = &prim_moms_cross[~a]; ~%", NC*2), + printf(fh, " ~%"), + /* Create the arrays of the temps. */ + printf(fh, " double msNsNusr[~a] = {0.0}; ~%", NC), + printf(fh, " double mrNrNurs[~a] = {0.0}; ~%", NC), + printf(fh, " double m_n_nu[~a] = {0.0}; ~%", NC), + printf(fh, " double m_n_nu_inv[~a] = {0.0}; ~%", NC), + printf(fh, " double alphaE[~a] = {0.0}; ~%", NC), + printf(fh, "~%"), + printf(fh, " double msNsNusr_inv[~a] = {0.0}; ~%", NC), + printf(fh, " double coeff[~a] = {0.0}; ~%", NC), + printf(fh, " double dUpar[~a] = {0.0}; ~%", NC), + printf(fh, " double cUpar[~a] = {0.0}; ~%", NC), + printf(fh, "~%"), + printf(fh, " double dv; ~%"), + printf(fh, " double T1[~a] = {0.0}; ~%", NC), + printf(fh, " double T2[~a] = {0.0}; ~%", NC), + printf(fh, " double T3[~a] = {0.0}; ~%", NC), + printf(fh, " double cVtsq[~a] = {0.0}; ~%", NC), + printf(fh, " bool negative_cross_temp = false; ~%"), + printf(fh, "~%"), + + /* Caculate alphaE. */ + printf(fh, " binop_mul_~ad_~a_p~a(n_s, nu_sr, msNsNusr); ~%", cdim, basisFun, polyOrder), + printf(fh, " binop_mul_~ad_~a_p~a(n_r, nu_rs, mrNrNurs); ~%", cdim, basisFun, polyOrder), + for i : 1 thru NC do ( + printf(fh, " msNsNusr[~a] = m_s * msNsNusr[~a]; ~%", i-1, i-1), + printf(fh, " mrNrNurs[~a] = m_r * mrNrNurs[~a]; ~%", i-1, i-1), + printf(fh, " m_n_nu[~a] = msNsNusr[~a] + mrNrNurs[~a]; ~%", i-1, i-1, i-1) + ), + printf(fh, " ~a_~ax_p~a_inv(m_n_nu, m_n_nu_inv); ~%", basisFun, cdim, polyOrder), + printf(fh, " binop_mul_~ad_~a_p~a(msNsNusr, mrNrNurs, alphaE); ~%", cdim, basisFun, polyOrder), + printf(fh, " binop_mul_~ad_~a_p~a(alphaE, m_n_nu_inv, alphaE); ~%", cdim, basisFun, polyOrder), + for i : 1 thru NC do ( + printf(fh, " alphaE[~a] = alphaE[~a] * 2.0 * betaGreenep1 / (m_s+m_r); ~%", i-1, i-1) + ), printf(fh, "~%"), /* Calculate cross density n_sr. */ @@ -60,40 +93,39 @@ calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( printf(fh, " ~%"), /* Calculate cross parallel velocity upar_sr. */ - printf(fh, " const double deltaTbetap1 = delta_sr*betaGreenep1;~%"), - printf(fh, " ~%"), - - printf(fh, " double dUpar[~a]; ~%", NC), + printf(fh, " ~a_~ax_p~a_inv(msNsNusr, msNsNusr_inv); ~%", basisFun, cdim, polyOrder), + printf(fh, " binop_mul_~ad_~a_p~a(alphaE, msNsNusr_inv, coeff); ~%", cdim, basisFun, polyOrder), for i : 1 thru NC do ( printf(fh, " dUpar[~a] = upar_r[~a] - upar_s[~a]; ~%", i-1, i-1, i-1) ), + printf(fh, " binop_mul_~ad_~a_p~a(coeff, dUpar, cUpar); ~%", cdim, basisFun, polyOrder), for i : 1 thru NC do ( - printf(fh, " upar_sr[~a] = upar_s[~a] + 0.5*deltaTbetap1*dUpar[~a]; ~%", i-1, i-1, i-1) + printf(fh, " upar_sr[~a] = upar_s[~a] + cUpar[~a]*(m_s+m_r)/2.0; ~%", i-1, i-1, i-1) ), printf(fh, " ~%"), /* Calculate cross thermal velocity square vtsq_sr. */ - printf(fh, " const double vdimPhys = ~a; ~%", (vdim-1)*2+1), - printf(fh, " const double mSum = m_self + m_other;~%"), - printf(fh, " ~%"), - - printf(fh, " double dTemp[~a] = {0.0}; ~%", NC), + if vgk=1 then ( + printf(fh, " dv = 1.0; ~%") + ) else ( + printf(fh, " dv = 3.0; ~%") + ), for i : 1 thru NC do ( - printf(fh, " dTemp[~a] = vdimPhys * (m_r*vtsq_r[~a]-m_s*vtsq_s[~a]); ~%", i-1, i-1, i-1) + printf(fh, " T1[~a] = dv * (m_r*vtsq_r[~a]-m_s*vtsq_s[~a]); ~%", i-1, i-1, i-1) ), - - printf(fh, " double dUparSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(dUpar, dUpar, dUparSq); ~%", cdim, basisFun, polyOrder), - - printf(fh, " const double dUparSq_fac = (m_r-0.25*deltaTbetap1*mSum/vdimPhys);~%"), + printf(fh, " binop_mul_~ad_~a_p~a(dUpar, dUpar, T2); ~%", cdim, basisFun, polyOrder), + printf(fh, " binop_mul_~ad_~a_p~a(coeff, T2, T3); ~%", cdim, basisFun, polyOrder), for i : 1 thru NC do ( - printf(fh, " vtsq_sr[~a] = vtsq_s[~a] + deltaTbetap1/(vdimPhys*mSum)*(dTemp[~a]+dUparSq_fac*dUparSq[~a]); ~%", i-1, i-1, i-1, i-1) + printf(fh, " cVtsq[~a] = T1[~a] + m_r*T2[~a] - (m_s+m_r)*(m_s+m_r)/4.0*T3[~a] ; ~%", i-1, i-1, i-1, i-1) + ), + printf(fh, " binop_mul_~ad_~a_p~a(coeff, cVtsq, cVtsq); ~%", cdim, basisFun, polyOrder), + for i : 1 thru NC do ( + printf(fh, " vtsq_sr[~a] = vtsq_s[~a] + cVtsq[~a]/dv; ~%", i-1, i-1, i-1) ), printf(fh, " ~%"), /* Turn collisions off when vtsq_sr is not positive-definite. */ printf(fh, " // If vtsq_sr is negative at a corner, turn off collisions.~%"), - printf(fh, " bool negative_cross_temp = false; ~%"), nodes : getNodes(basisFun, cdim, 1), vtsq_sr_e : doExpand1(vtsq_sr,bC), vtsq_sr_corners : gcfac(float(fullratsimp( evAtNodes(vtsq_sr_e,nodes,varsC) ))), diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac deleted file mode 100644 index 752a42c8..00000000 --- a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac +++ /dev/null @@ -1,67 +0,0 @@ -load("cross_prim_moms/gkCrossPrimMomsBGKFuncs")$ -load(stringproc)$ - -/* Generate a header file for cross primitive moments kernels in the GkBGK. */ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 1$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor order basis. No need to generate p=1. */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ - -/* Vdim possibilities for each of Cdim=[1,2,3]. */ -gkVdims : [[1,2], [2], [2]]$ - -/* ...... END OF USER INPUTS........ */ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -printPrototypeGK(deco, ci, vi, bStr, pi) := block([si], - printf(fh, "~avoid gyrokinetic_cross_prim_moms_bgk_~ax~av_~a_p~a(const double delta_sr, const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, double *prim_moms_cross); ~%", deco, ci, vi, bStr, pi), - printf(fh, "~%") -)$ - -fh : openw("~/max-out/gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h")$ -printf(fh, "#pragma once ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, " ~%")$ -printf(fh, "EXTERN_C_BEG ~%")$ -printf(fh, "~%")$ - -decorator : "GKYL_CU_DH "$ - -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - - printPrototypeGK(decorator, c, v, bName[bInd], polyOrder) - - ) - ) - ) -); - -printf(fh, "EXTERN_C_END ~%")$ -close(fh)$ - -/* gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h */ diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac index 834a14f2..958e86f5 100644 --- a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac +++ b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac @@ -5,41 +5,47 @@ load(stringproc)$ /* Serendipity basis. */ minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 2$ minCdim_Ser : 1$ maxCdim_Ser : 3$ +minVdim_Ser : 1$ +maxVdim_Ser : 3$ +minGkVdim_Ser : 1$ +maxGkVdim_Ser : 2$ -/* Tensor order basis. No need to generate p=1. */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ - -/* Vdim possibilities for each of Cdim=[1,2,3]. */ -gkVdims : [[1,2], [2], [2]]$ /* ...... END OF USER INPUTS........ */ -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ +bName : ["ser"]$ +minPolyOrder : [minPolyOrder_Ser]$ +maxPolyOrder : [maxPolyOrder_Ser]$ +minCdim : [minCdim_Ser]$ +maxCdim : [maxCdim_Ser]$ +minVdim : [minVdim_Ser]$ +maxVdim : [maxVdim_Ser]$ +minGkVdim : [minGkVdim_Ser]$ +maxGkVdim : [maxGkVdim_Ser]$ + +polyOrder : 1$ for bInd : 1 thru length(bName) do ( for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - - fname : sconcat("~/max-out/gyrokinetic_cross_prim_moms_bgk_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + minPolyOrderB : minPolyOrder[bInd], + maxPolyOrderB : maxPolyOrder[bInd], + for polyOrder : minPolyOrderB thru maxPolyOrderB do ( + if (c=1) then ( + for vgk : minGkVdim[bInd] thru maxGkVdim[bInd] do ( + fname : sconcat("~/max-out/cross_prim_moms/gyrokinetic_cross_prim_moms_bgk_", c, "x", vgk, "v_", bName[bInd], "_p", polyOrder, ".c"), + fh : openw(fname), + funcName : sconcat("gyrokinetic_cross_prim_moms_bgk_", c, "x", vgk, "v_", bName[bInd], "_p", polyOrder), + calcGKCrossPrimMomsBGK(fh, funcName, c, vgk, bName[bInd], polyOrder), + close(fh) + ) + ) else ( + fname : sconcat("~/max-out/cross_prim_moms/gyrokinetic_cross_prim_moms_bgk_", c, "x", 2, "v_", bName[bInd], "_p", polyOrder, ".c"), fh : openw(fname), - funcName : sconcat("gyrokinetic_cross_prim_moms_bgk_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - calcGKCrossPrimMomsBGK(fh, funcName, c, v, bName[bInd], polyOrder), + funcName : sconcat("gyrokinetic_cross_prim_moms_bgk_", c, "x", 2, "v_", bName[bInd], "_p", polyOrder), + calcGKCrossPrimMomsBGK(fh, funcName, c, 2, bName[bInd], polyOrder), close(fh) ) ) diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGKHeader.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGKHeader.mac new file mode 100644 index 00000000..2422988a --- /dev/null +++ b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGKHeader.mac @@ -0,0 +1,66 @@ +load("cross_prim_moms/gkCrossPrimMomsBGKFuncs")$ +load(stringproc)$ + +/* Generate a header file for cross primitive moments kernels in the GkBGK. */ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 2$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ +minVdim_Ser : 1$ +maxVdim_Ser : 3$ +minGkVdim_Ser : 1$ +maxGkVdim_Ser : 2$ + + +/* ...... END OF USER INPUTS........ */ + +bName : ["ser"]$ +minPolyOrder : [minPolyOrder_Ser]$ +maxPolyOrder : [maxPolyOrder_Ser]$ +minCdim : [minCdim_Ser]$ +maxCdim : [maxCdim_Ser]$ +minVdim : [minVdim_Ser]$ +maxVdim : [maxVdim_Ser]$ +minGkVdim : [minGkVdim_Ser]$ +maxGkVdim : [maxGkVdim_Ser]$ + +printPrototypeGK(deco, ci, vi, bStr, pi) := block([si], + printf(fh, "~avoid gyrokinetic_cross_prim_moms_bgk_~ax~av_~a_p~a(const double beta, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, const double *nu_sr, const double *nu_rs, double *prim_moms_cross); ~%", deco, ci, vi, bStr, pi), + printf(fh, "~%") +)$ + +fh : openw("~/max-out/cross_prim_moms/gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h")$ +printf(fh, "#pragma once ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, " ~%")$ +printf(fh, "EXTERN_C_BEG ~%")$ +printf(fh, "~%")$ + +decorator : "GKYL_CU_DH "$ +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + minPolyOrderB : minPolyOrder[bInd], + maxPolyOrderB : maxPolyOrder[bInd], + if c=1 then ( + for vgk : minGkVdim[bInd] thru maxGkVdim[bInd] do ( + for polyOrder : minPolyOrderB thru maxPolyOrderB do ( + printPrototypeGK(decorator, c, vgk, bName[bInd], polyOrder) + ) + ) + ) else ( + for polyOrder : minPolyOrderB thru maxPolyOrderB do ( + printPrototypeGK(decorator, c, 2, bName[bInd], polyOrder) + ) + ) + ) +); +printf(fh, "EXTERN_C_END ~%")$ +close(fh)$ + +/* gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h */ diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE.mac deleted file mode 100644 index d92b341e..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE.mac +++ /dev/null @@ -1,187 +0,0 @@ -/* This script generates the kernels for calculating the flow energy - using weak division. */ - -load("modal-basis")$ -load("out-scripts")$ -load(stringproc)$ -load("scifac")$ -load("nodal_operations/nodal_functions")$ -fpprec : 24$ - -/* Special set of kernels which analytically invert the matrix for 1/rho - for p=1 using the basis_inv operator. Significantly faster than the bin_op operator, - but only works for p=1 */ -gk_neut_fluid_prim_vars_flowE_set_prob_p1(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, rho_e, expr_flowE, i], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, - const double *moms) ~%{ ~%", funcNm, polyOrder), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // A: preallocated LHS matrix. ~%"), - printf(fh, " // rhs: preallocated RHS vector. ~%"), - printf(fh, " // moms: moments (rho, rho ux, rho uy, rho uz, totalE).~%"), - printf(fh, "~%"), - - printf(fh, " // For poly_order = 1, we can analytically invert the matrix and just store the solution ~%"), - printf(fh, " struct gkyl_mat rhs_flowE = gkyl_nmat_get(rhs, count); ~%"), - - printf(fh, " // Clear rhs for each component of flow velocity being solved for ~%"), - printf(fh, " gkyl_mat_clear(&rhs_flowE, 0.0); ~%"), - - printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), - printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), - printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), - printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), - printf(fh, "~%"), - - /* Terms in sum rhou . rhou */ - printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Compute 0.5 * (rho u)^2. */ - printf(fh, " double rhouSqD2[~a]; ~%", NC), - for i : 1 thru NC do ( - printf(fh, " rhouSqD2[~a] = 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a]); ~%", i-1, i-1, i-1, i-1) - ), - printf(fh, "~%"), - - /* Expand rho. */ - rho_e : doExpand1(rho, bC), - - /* Arrays for storing inverse of rho */ - printf(fh, " double rho_inv[~a] = {0.0}; ~%", NC), - printf(fh, " ~a_~ax_p~a_inv(rho, rho_inv); ~%", basisFun, cdim, polyOrder), - - printf(fh, " // Calculate expansions of flow energy. ~%"), - printf(fh, " double flowE[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouSqD2, flowE); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - expr_flowE : float(expand(makelist(flowE[i],i,0,NC-1))), - - for i : 1 thru length(expr_flowE) do ( - printf(fh," gkyl_mat_set(&rhs_flowE,~a,0,~a); ~%", i-1, expr_flowE[i]) - ), - printf(fh, " ~%"), - printf(fh, "} ~%") -)$ - -gk_neut_fluid_prim_vars_flowE_set_prob(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, rho_e, expr_flowE, i, flowE_e, flowE_c, eq_rho, E_rho, j], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, - const double *moms) ~%{ ~%", funcNm, polyOrder), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // A: preallocated LHS matrix. ~%"), - printf(fh, " // rhs: preallocated RHS vector. ~%"), - printf(fh, " // moms: Moments [rho, rho ux, rho uy, rho uz, totalE].~%"), - printf(fh, "~%"), - - printf(fh, " struct gkyl_mat A_flowE = gkyl_nmat_get(A, count); ~%"), - - printf(fh, " struct gkyl_mat rhs_flowE = gkyl_nmat_get(rhs, count); ~%"), - - printf(fh, " // Clear matrix and rhs.~%"), - printf(fh, " gkyl_mat_clear(&A_flowE, 0.0); gkyl_mat_clear(&rhs_flowE, 0.0); ~%"), - - printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), - printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), - printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), - printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), - - printf(fh, "~%"), - /* Terms in sum rhou . rhou */ - printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Compute 0.5 * (rho u)^2. */ - printf(fh, " double rhouSqD2[~a]; ~%", NC), - for i : 1 thru NC do ( - printf(fh, " rhouSqD2[~a] = 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a]); ~%", i-1, i-1, i-1, i-1) - ), - printf(fh, "~%"), - - /* Expand rho. */ - rho_e : doExpand1(rho, bC), - - expr_flowE : float(expand(makelist(rhouSqD2[i],i,0,NC-1))), - - for i : 1 thru length(expr_flowE) do ( - printf(fh," gkyl_mat_set(&rhs_flowE,~a,0,~a); ~%", i-1, expr_flowE[i]) - ), - printf(fh, " ~%"), - - /* Generate matrix of unknown coefficients */ - flowE_e : doExpand1(flowE,bC), - flowE_c : makelist(flowE[i],i,0,NC-1), - eq_rho : calcInnerProdList(varsC,flowE_e,bC,rho_e), - E_rho : fullratsimp(coefmatrix(eq_rho,flowE_c)), - - /* Matrix is dense so just do a simple write routine */ - for i : 1 thru NC do ( - for j : 1 thru NC do ( - printf(fh," gkyl_mat_set(&A_flowE,~a,~a,~a); ~%", i-1, j-1, float(expand(E_rho[i,j]))), - printf(fh, " ~%") - ) - ), - printf(fh, "} ~%") -)$ - -gk_neut_fluid_prim_vars_flowE_get_sol(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, i], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - /* Function declaration with input/output variables. */ - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *xsol, - double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // xsol: Input solution vector. ~%"), - printf(fh, " // out: Output volume expansion of flow velocity and temperature;~%"), - printf(fh, " ~%"), - - printf(fh, " struct gkyl_mat x_flowE = gkyl_nmat_get(xsol, count); ~%"), - - printf(fh, " double *flowE = &out[~a]; ~%", 0*NC), - printf(fh, "~%"), - - /* Fetch volume expansion solution from linear solve */ - for i : 1 thru NC do ( - printf(fh," flowE[~a] = gkyl_mat_get(&x_flowE,~a,0); ~%", i-1, i-1) - ), - printf(fh, "~%"), - - printf(fh, "} ~%"), - printf(fh, " ~%") -)$ - diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac deleted file mode 100644 index b29df747..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac +++ /dev/null @@ -1,58 +0,0 @@ -/* This script generates the kernels for calculating the pressure for updating - fluid equations. Pressure different for each equation system: - Euler -> p = (gas_gamma - 1)*(E - 1/2 rho u^2)*/ - -load("modal-basis")$ -load("out-scripts")$ -load(stringproc)$ -load("scifac")$ -fpprec : 24$ - -gk_neut_fluid_prim_vars_pressure(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, i], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - printf(fh, "GKYL_CU_DH void ~a(double gas_gamma, const double *moms, const double *udrift, - double* GKYL_RESTRICT out) ~%{ ~%", funcNm, polyOrder), - printf(fh, " // gas_gamma: Adiabatic index.~%"), - printf(fh, " // moms: Moments (rho, rho ux, rho uy, rho uz, totalE).~%"), - printf(fh, " // udrift: Input volume expansion of flow velocity: [ux, uy, uz]. ~%"), - printf(fh, " // out: Output volume expansion of pressure.~%"), - printf(fh, "~%"), - - /* Fetch pointers needed to compute pressure from other fluid variables - Either p = (gas_gamma - 1)*(E - 1/2 rho u^2) */ - printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), - printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), - printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), - printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), - printf(fh, " const double *energy = &moms[~a]; ~%", 4*NC), - printf(fh, "~%"), - printf(fh, " const double *ux = &udrift[~a]; ~%", 0*NC), - printf(fh, " const double *uy = &udrift[~a]; ~%", 1*NC), - printf(fh, " const double *uz = &udrift[~a]; ~%", 2*NC), - printf(fh, "~%"), - - /* First construct volume expansion of rhou . u */ - printf(fh, " double rhoux2[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhoux, ux, rhoux2); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouy2[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouy, uy, rhouy2); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouz2[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouz, uz, rhouz2); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Compute pressure from energy */ - for i : 1 thru NC do ( - printf(fh, " out[~a] = (gas_gamma - 1.0)*(energy[~a] - 0.5*(rhoux2[~a] + rhouy2[~a] + rhouz2[~a])); ~%", i-1, i-1, i-1, i-1, i-1) - ), - - printf(fh, "} ~%") -)$ diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp.mac deleted file mode 100644 index 4fc7a6de..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp.mac +++ /dev/null @@ -1,211 +0,0 @@ -/* This script generates the kernels for calculating the temperature - using weak division. */ - -load("modal-basis")$ -load("out-scripts")$ -load(stringproc)$ -load("scifac")$ -load("nodal_operations/nodal_functions")$ -fpprec : 24$ - -/* Special set of kernels which analytically invert the matrix for 1/rho - for p=1 using the basis_inv operator. Significantly faster than the bin_op operator, - but only works for p=1 */ -gk_neut_fluid_prim_vars_temp_set_prob_p1(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, expr_ux, expr_uy, expr_uz, i], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, - const double *moms, double gas_gamma, double mass) ~%{ ~%", funcNm, polyOrder), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // A: preallocated LHS matrix. ~%"), - printf(fh, " // rhs: preallocated RHS vector. ~%"), - printf(fh, " // moms: moments (rho, rho ux, rho uy, rho uz, totalE).~%"), - printf(fh, " // gas_gamma: Adiabatic index. ~%"), - printf(fh, " // mass: Species mass. ~%"), - printf(fh, "~%"), - - printf(fh, " // For poly_order = 1, we can analytically invert the matrix and just store the solution ~%"), - printf(fh, " struct gkyl_mat rhs_temp = gkyl_nmat_get(rhs, count); ~%"), - - printf(fh, " // Clear rhs for each component of flow velocity being solved for ~%"), - printf(fh, " gkyl_mat_clear(&rhs_temp, 0.0); ~%"), - - printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), - printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), - printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), - printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), - printf(fh, " const double *totE = &moms[~a]; ~%", 4*NC), - printf(fh, "~%"), - - /* Mass density squared. */ - printf(fh, " double rhoSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rho, rho, rhoSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Mass density times total kinetic energy. */ - printf(fh, " double rho_totE[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rho, totE, rho_totE); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Terms in sum rhou . rhou */ - printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Compute mass density times temperature. */ - /* rho T = (gas_gamma - 1)*(mass * E - m/2 rho u^2) */ - /* rho^2 T = m (gas_gamma - 1)*(rho * E - 1/2 (rho u)^2) */ - printf(fh, " double rhoSq_temp[~a]; ~%", NC), - for i : 1 thru NC do ( - printf(fh, " rhoSq_temp[~a] = mass*(gas_gamma-1.0)*(rho_totE[~a] - 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a])); ~%", i-1, i-1, i-1, i-1, i-1) - ), - printf(fh, "~%"), - - /* Arrays for storing inverse of rho^2 */ - printf(fh, " double rhoSq_inv[~a] = {0.0}; ~%", NC), - printf(fh, " ~a_~ax_p~a_inv(rhoSq, rhoSq_inv); ~%", basisFun, cdim, polyOrder), - - printf(fh, " // Calculate expansions of temperature. ~%"), - printf(fh, " double temp[~a] = {0.0}; ~%", NC), - printf(fh, " ~%"), - - printf(fh, " binop_mul_~ad_~a_p~a(rhoSq_inv, rhoSq_temp, temp); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - expr_temp : float(expand(makelist(temp[i],i,0,NC-1))), - - for i : 1 thru length(expr_temp) do ( - printf(fh," gkyl_mat_set(&rhs_temp,~a,0,~a); ~%", i-1, expr_temp[i]) - ), - printf(fh, " ~%"), - printf(fh, "} ~%") -)$ - -gk_neut_fluid_prim_vars_temp_set_prob(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, i, ue, un, eq_rho, E_rhoSq, j], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, - const double *moms, double gas_gamma, double mass) ~%{ ~%", funcNm, polyOrder), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // A: preallocated LHS matrix. ~%"), - printf(fh, " // rhs: preallocated RHS vector. ~%"), - printf(fh, " // moms: Moments [rho, rho ux, rho uy, rho uz, totalE].~%"), - printf(fh, " // gas_gamma: Adiabatic index. ~%"), - printf(fh, " // mass: Species mass. ~%"), - printf(fh, "~%"), - - printf(fh, " struct gkyl_mat A_temp = gkyl_nmat_get(A, count); ~%"), - - printf(fh, " struct gkyl_mat rhs_temp = gkyl_nmat_get(rhs, count); ~%"), - - printf(fh, " // Clear matrix and rhs. ~%"), - printf(fh, " gkyl_mat_clear(&A_temp, 0.0); gkyl_mat_clear(&rhs_temp, 0.0); ~%"), - - printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), - printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), - printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), - printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), - printf(fh, " const double *totE = &moms[~a]; ~%", 4*NC), - printf(fh, "~%"), - - /* Mass density squared. */ - printf(fh, " double rhoSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rho, rho, rhoSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Mass density times total kinetic energy. */ - printf(fh, " double rho_totE[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rho, totE, rho_totE); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Terms in sum rhou . rhou */ - printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Compute mass density times temperature. */ - /* rho T = (gas_gamma - 1)*(mass * E - m/2 rho u^2) */ - /* rho^2 T = m (gas_gamma - 1)*(rho * E - 1/2 (rho u)^2) */ - printf(fh, " double rhoSq_temp[~a]; ~%", NC), - for i : 1 thru NC do ( - printf(fh, " rhoSq_temp[~a] = mass*(gas_gamma-1.0)*(rho_totE[~a] - 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a])); ~%", i-1, i-1, i-1, i-1, i-1) - ), - printf(fh, "~%"), - - expr_rhoSq_temp : float(expand(makelist(rhoSq_temp[i],i,0,NC-1))), - - for i : 1 thru length(expr_rhoSq_temp) do ( - printf(fh," gkyl_mat_set(&rhs_temp,~a,0,~a); ~%", i-1, expr_rhoSq_temp[i]) - ), - printf(fh, " ~%"), - - /* Generate matrix of unknown coefficients */ - rhoSq_e : doExpand1(rhoSq, bC), - temp_e : doExpand1(temp_e,bC), - temp_c : makelist(temp[i],i,0,NC-1), - eq_rhoSq : calcInnerProdList(varsC,temp_e,bC,rhoSq_e), - E_rhoSq : fullratsimp(coefmatrix(eq_rhoSq,temp_c)), - - /* Matrix is dense so just do a simple write routine */ - for i : 1 thru NC do ( - for j : 1 thru NC do ( - printf(fh," gkyl_mat_set(&A_temp,~a,~a,~a); ~%", i-1, j-1, float(expand(E_rhoSq[i,j]))), - printf(fh, " ~%") - ) - ), - printf(fh, "} ~%") -)$ - -gk_neut_fluid_prim_vars_temp_get_sol(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, i], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - /* Function declaration with input/output variables. */ - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *xsol, - double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // xsol: Input solution vector. ~%"), - printf(fh, " // out: Output volume expansion of temperaure. ~%"), - printf(fh, " ~%"), - - printf(fh, " struct gkyl_mat x_temp = gkyl_nmat_get(xsol, count); ~%"), - printf(fh, "~%"), - - /* Fetch volume expansion solution from linear solve */ - for i : 1 thru NC do ( - printf(fh," out[~a] = gkyl_mat_get(&x_temp,~a,0); ~%", i-1, i-1) - ), - printf(fh, "~%"), - - printf(fh, "} ~%"), - printf(fh, " ~%") -)$ diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift.mac deleted file mode 100644 index 48046514..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift.mac +++ /dev/null @@ -1,187 +0,0 @@ -/* This script generates the kernels for calculating the flow velocity udrift_i - using weak division. */ - -load("modal-basis")$ -load("out-scripts")$ -load(stringproc)$ -load("scifac")$ -load("nodal_operations/nodal_functions")$ -fpprec : 24$ - -/* Special set of kernels which analytically invert the matrix for 1/rho - for p=1 using the basis_inv operator. Significantly faster than the bin_op operator, - but only works for p=1 */ -gk_neut_fluid_prim_vars_udrift_set_prob_p1(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, i], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, - const double *moms) ~%{ ~%", funcNm, polyOrder), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // A: preallocated LHS matrix. ~%"), - printf(fh, " // rhs: preallocated RHS vector. ~%"), - printf(fh, " // moms: moments (rho, rho ux, rho uy, rho uz, totalE).~%"), - printf(fh, "~%"), - - printf(fh, " // For poly_order = 1, we can analytically invert the matrix and just store the solution ~%"), - printf(fh, " struct gkyl_mat rhs_ux = gkyl_nmat_get(rhs, count); ~%"), - printf(fh, " struct gkyl_mat rhs_uy = gkyl_nmat_get(rhs, count+1); ~%"), - printf(fh, " struct gkyl_mat rhs_uz = gkyl_nmat_get(rhs, count+2); ~%"), - - printf(fh, " // Clear rhs for each component of flow velocity being solved for ~%"), - printf(fh, " gkyl_mat_clear(&rhs_ux, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&rhs_uy, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&rhs_uz, 0.0); ~%"), - - printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), - printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), - printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), - printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), - printf(fh, "~%"), - - /* Expand rho. */ - rho_e : doExpand1(rho, bC), - - /* Arrays for storing inverse of rho */ - printf(fh, " double rho_inv[~a] = {0.0}; ~%", NC), - printf(fh, " ~a_~ax_p~a_inv(rho, rho_inv); ~%", basisFun, cdim, polyOrder), - - printf(fh, " // Calculate expansions of flow velocity, which can be calculated free of aliasing errors. ~%"), - printf(fh, " double ux[~a] = {0.0}; ~%", NC), - printf(fh, " double uy[~a] = {0.0}; ~%", NC), - printf(fh, " double uz[~a] = {0.0}; ~%", NC), - printf(fh, " ~%"), - - printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhoux, ux); ~%", cdim, basisFun, polyOrder), - printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouy, uy); ~%", cdim, basisFun, polyOrder), - printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouz, uz); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - expr_ux : float(expand(makelist(ux[i],i,0,NC-1))), - expr_uy : float(expand(makelist(uy[i],i,0,NC-1))), - expr_uz : float(expand(makelist(uz[i],i,0,NC-1))), - - for i : 1 thru length(expr_ux) do ( - printf(fh," gkyl_mat_set(&rhs_ux,~a,0,~a); ~%", i-1, expr_ux[i]), - printf(fh," gkyl_mat_set(&rhs_uy,~a,0,~a); ~%", i-1, expr_uy[i]), - printf(fh," gkyl_mat_set(&rhs_uz,~a,0,~a); ~%", i-1, expr_uz[i]) - ), - printf(fh, " ~%"), - printf(fh, "} ~%") -)$ - -gk_neut_fluid_prim_vars_udrift_set_prob(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, i, ue, un, eq_rho, E_rho, j], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, - const double *moms) ~%{ ~%", funcNm, polyOrder), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // A: preallocated LHS matrix. ~%"), - printf(fh, " // rhs: preallocated RHS vector. ~%"), - printf(fh, " // moms: Moments [rho, rho ux, rho uy, rho uz, totalE].~%"), - printf(fh, "~%"), - - printf(fh, " struct gkyl_mat A_ux = gkyl_nmat_get(A, count); ~%"), - printf(fh, " struct gkyl_mat A_uy = gkyl_nmat_get(A, count+1); ~%"), - printf(fh, " struct gkyl_mat A_uz = gkyl_nmat_get(A, count+2); ~%"), - - printf(fh, " struct gkyl_mat rhs_ux = gkyl_nmat_get(rhs, count); ~%"), - printf(fh, " struct gkyl_mat rhs_uy = gkyl_nmat_get(rhs, count+1); ~%"), - printf(fh, " struct gkyl_mat rhs_uz = gkyl_nmat_get(rhs, count+2); ~%"), - - printf(fh, " // Clear matrix and rhs for each component of flow velocity being solved for ~%"), - printf(fh, " gkyl_mat_clear(&A_ux, 0.0); gkyl_mat_clear(&rhs_ux, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&A_uy, 0.0); gkyl_mat_clear(&rhs_uy, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&A_uz, 0.0); gkyl_mat_clear(&rhs_uz, 0.0); ~%"), - - printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), - printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), - printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), - printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), - printf(fh, "~%"), - - /* Expand rho. */ - rho_e : doExpand1(rho, bC), - - expr_ux : float(expand(makelist(rhoux[i],i,0,NC-1))), - expr_uy : float(expand(makelist(rhouy[i],i,0,NC-1))), - expr_uz : float(expand(makelist(rhouz[i],i,0,NC-1))), - - for i : 1 thru length(expr_ux) do ( - printf(fh," gkyl_mat_set(&rhs_ux,~a,0,~a); ~%", i-1, expr_ux[i]), - printf(fh," gkyl_mat_set(&rhs_uy,~a,0,~a); ~%", i-1, expr_uy[i]), - printf(fh," gkyl_mat_set(&rhs_uz,~a,0,~a); ~%", i-1, expr_uz[i]) - ), - printf(fh, " ~%"), - - /* Generate matrix of unknown coefficients */ - ue : doExpand1(u,bC), - un : makelist(u[i],i,0,NC-1), - eq_rho : calcInnerProdList(varsC,ue,bC,rho_e), - E_rho : fullratsimp(coefmatrix(eq_rho,un)), - - /* declare temp_rho and temp_p_perp since matrix entries in A are the same for all operations */ - printf(fh, " double temp_rho = 0.0; ~%"), - /* Matrix is dense so just do a simple write routine */ - for i : 1 thru NC do ( - for j : 1 thru NC do ( - printf(fh," temp_rho = ~a; ~%", float(expand(E_rho[i,j]))), - printf(fh," gkyl_mat_set(&A_ux,~a,~a,~a); ~%", i-1, j-1, temp_rho), - printf(fh," gkyl_mat_set(&A_uy,~a,~a,~a); ~%", i-1, j-1, temp_rho), - printf(fh," gkyl_mat_set(&A_uz,~a,~a,~a); ~%", i-1, j-1, temp_rho), - printf(fh, " ~%") - ) - ), - printf(fh, "} ~%") -)$ - -gk_neut_fluid_prim_vars_udrift_get_sol(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, ux_e, uy_e, uz_e], - - kill(varsC, basisC), - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - /* Function declaration with input/output variables. */ - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *xsol, - double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // xsol: Input solution vector. ~%"), - printf(fh, " // out: Output volume expansion of flow velocity;~%"), - printf(fh, " ~%"), - - printf(fh, " struct gkyl_mat x_ux = gkyl_nmat_get(xsol, count); ~%"), - printf(fh, " struct gkyl_mat x_uy = gkyl_nmat_get(xsol, count+1); ~%"), - printf(fh, " struct gkyl_mat x_uz = gkyl_nmat_get(xsol, count+2); ~%"), - - printf(fh, " double *ux = &out[~a]; ~%", 0*NC), - printf(fh, " double *uy = &out[~a]; ~%", 1*NC), - printf(fh, " double *uz = &out[~a]; ~%", 2*NC), - printf(fh, "~%"), - - /* Fetch volume expansion solution from linear solve */ - for i : 1 thru NC do ( - printf(fh," ux[~a] = gkyl_mat_get(&x_ux,~a,0); ~%", i-1, i-1), - printf(fh," uy[~a] = gkyl_mat_get(&x_uy,~a,0); ~%", i-1, i-1), - printf(fh," uz[~a] = gkyl_mat_get(&x_uz,~a,0); ~%", i-1, i-1) - ), - printf(fh, "~%"), - - printf(fh, "} ~%"), - printf(fh, " ~%") -)$ diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp.mac deleted file mode 100644 index b172d8a5..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp.mac +++ /dev/null @@ -1,279 +0,0 @@ -/* This script generates the kernels for calculating the flow velocity udrift_i - and the temperature using weak division. */ - -load("modal-basis")$ -load("out-scripts")$ -load(stringproc)$ -load("scifac")$ -load("nodal_operations/nodal_functions")$ -fpprec : 24$ - -/* Special set of kernels which analytically invert the matrix for 1/rho - for p=1 using the basis_inv operator. Significantly faster than the bin_op operator, - but only works for p=1 */ -gk_neut_fluid_prim_vars_udrift_temp_set_prob_p1(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, expr_temp, i], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, - const double *moms, double gas_gamma, double mass) ~%{ ~%", funcNm, polyOrder), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // A: preallocated LHS matrix. ~%"), - printf(fh, " // rhs: preallocated RHS vector. ~%"), - printf(fh, " // moms: moments (rho, rho ux, rho uy, rho uz, totalE).~%"), - printf(fh, " // gas_gamma: Adiabatic index. ~%"), - printf(fh, " // mass: Species mass. ~%"), - printf(fh, "~%"), - - printf(fh, " // For poly_order = 1, we can analytically invert the matrix and just store the solution ~%"), - printf(fh, " struct gkyl_mat rhs_ux = gkyl_nmat_get(rhs, count); ~%"), - printf(fh, " struct gkyl_mat rhs_uy = gkyl_nmat_get(rhs, count+1); ~%"), - printf(fh, " struct gkyl_mat rhs_uz = gkyl_nmat_get(rhs, count+2); ~%"), - printf(fh, " struct gkyl_mat rhs_temp = gkyl_nmat_get(rhs, count+3); ~%"), - - printf(fh, " // Clear rhs for each component of flow velocity being solved for ~%"), - printf(fh, " gkyl_mat_clear(&rhs_ux, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&rhs_uy, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&rhs_uz, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&rhs_temp, 0.0); ~%"), - - printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), - printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), - printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), - printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), - printf(fh, " const double *totE = &moms[~a]; ~%", 4*NC), - printf(fh, "~%"), - - /* Mass density squared. */ - printf(fh, " double rhoSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rho, rho, rhoSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Mass density times total kinetic energy. */ - printf(fh, " double rho_totE[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rho, totE, rho_totE); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Terms in sum rhou . rhou */ - printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Expand rho. */ - rho_e : doExpand1(rho, bC), - - /* Arrays for storing inverse of rho */ - printf(fh, " double rho_inv[~a] = {0.0}; ~%", NC), - printf(fh, " ~a_~ax_p~a_inv(rho, rho_inv); ~%", basisFun, cdim, polyOrder), - - printf(fh, " // Calculate expansions of flow velocity. ~%"), - printf(fh, " double ux[~a] = {0.0}; ~%", NC), - printf(fh, " double uy[~a] = {0.0}; ~%", NC), - printf(fh, " double uz[~a] = {0.0}; ~%", NC), - printf(fh, " ~%"), - - printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhoux, ux); ~%", cdim, basisFun, polyOrder), - printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouy, uy); ~%", cdim, basisFun, polyOrder), - printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouz, uz); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Compute mass density times temperature. */ - /* rho T = (gas_gamma - 1)*(mass * E - m/2 rho u^2) */ - /* rho^2 T = m (gas_gamma - 1)*(rho * E - 1/2 (rho u)^2) */ - printf(fh, " double rhoSq_temp[~a]; ~%", NC), - for i : 1 thru NC do ( - printf(fh, " rhoSq_temp[~a] = mass*(gas_gamma-1.0)*(rho_totE[~a] - 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a])); ~%", i-1, i-1, i-1, i-1, i-1) - ), - printf(fh, "~%"), - - /* Arrays for storing inverse of rho^2 */ - printf(fh, " double rhoSq_inv[~a] = {0.0}; ~%", NC), - printf(fh, " ~a_~ax_p~a_inv(rhoSq, rhoSq_inv); ~%", basisFun, cdim, polyOrder), - - printf(fh, " // Calculate expansions of temperature. ~%"), - printf(fh, " double temp[~a] = {0.0}; ~%", NC), - printf(fh, " ~%"), - - printf(fh, " binop_mul_~ad_~a_p~a(rhoSq_inv, rhoSq_temp, temp); ~%", cdim, basisFun, polyOrder), - - expr_ux : float(expand(makelist(ux[i],i,0,NC-1))), - expr_uy : float(expand(makelist(uy[i],i,0,NC-1))), - expr_uz : float(expand(makelist(uz[i],i,0,NC-1))), - expr_temp : float(expand(makelist(temp[i],i,0,NC-1))), - - for i : 1 thru length(expr_ux) do ( - printf(fh," gkyl_mat_set(&rhs_ux,~a,0,~a); ~%", i-1, expr_ux[i]), - printf(fh," gkyl_mat_set(&rhs_uy,~a,0,~a); ~%", i-1, expr_uy[i]), - printf(fh," gkyl_mat_set(&rhs_uz,~a,0,~a); ~%", i-1, expr_uz[i]), - printf(fh," gkyl_mat_set(&rhs_temp,~a,0,~a); ~%", i-1, expr_temp[i]) - ), - printf(fh, " ~%"), - printf(fh, "} ~%") -)$ - -gk_neut_fluid_prim_vars_udrift_temp_set_prob(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, expr_temp, i, u_e, u_c, eq_rho, E_rho, j], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, - const double *moms, double gas_gamma, double mass) ~%{ ~%", funcNm, polyOrder), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // A: preallocated LHS matrix. ~%"), - printf(fh, " // rhs: preallocated RHS vector. ~%"), - printf(fh, " // moms: Moments [rho, rho ux, rho uy, rho uz, totalE].~%"), - printf(fh, " // gas_gamma: Adiabatic index. ~%"), - printf(fh, " // mass: Species mass. ~%"), - printf(fh, "~%"), - - printf(fh, " struct gkyl_mat A_ux = gkyl_nmat_get(A, count); ~%"), - printf(fh, " struct gkyl_mat A_uy = gkyl_nmat_get(A, count+1); ~%"), - printf(fh, " struct gkyl_mat A_uz = gkyl_nmat_get(A, count+2); ~%"), - printf(fh, " struct gkyl_mat A_temp = gkyl_nmat_get(A, count+3); ~%"), - - printf(fh, " struct gkyl_mat rhs_ux = gkyl_nmat_get(rhs, count); ~%"), - printf(fh, " struct gkyl_mat rhs_uy = gkyl_nmat_get(rhs, count+1); ~%"), - printf(fh, " struct gkyl_mat rhs_uz = gkyl_nmat_get(rhs, count+2); ~%"), - printf(fh, " struct gkyl_mat rhs_temp = gkyl_nmat_get(rhs, count+3); ~%"), - - printf(fh, " // Clear matrix and rhs for each component of flow velocity being solved for ~%"), - printf(fh, " gkyl_mat_clear(&A_ux, 0.0); gkyl_mat_clear(&rhs_ux, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&A_uy, 0.0); gkyl_mat_clear(&rhs_uy, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&A_uz, 0.0); gkyl_mat_clear(&rhs_uz, 0.0); ~%"), - printf(fh, " gkyl_mat_clear(&A_temp, 0.0); gkyl_mat_clear(&rhs_temp, 0.0); ~%"), - - printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), - printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), - printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), - printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), - printf(fh, " const double *totE = &moms[~a]; ~%", 4*NC), - printf(fh, "~%"), - - /* Mass density squared. */ - printf(fh, " double rhoSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rho, rho, rhoSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Mass density times total kinetic energy. */ - printf(fh, " double rho_totE[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rho, totE, rho_totE); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Terms in sum rhou . rhou */ - printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), - printf(fh, " ~%"), - - /* Compute mass density times temperature. */ - /* rho T = (gas_gamma - 1)*(mass * E - m/2 rho u^2) */ - /* rho^2 T = m (gas_gamma - 1)*(rho * E - 1/2 (rho u)^2) */ - printf(fh, " double rhoSq_temp[~a]; ~%", NC), - for i : 1 thru NC do ( - printf(fh, " rhoSq_temp[~a] = mass*(gas_gamma-1.0)*(rho_totE[~a] - 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a])); ~%", i-1, i-1, i-1, i-1, i-1) - ), - printf(fh, "~%"), - - expr_ux : float(expand(makelist(rhoux[i],i,0,NC-1))), - expr_uy : float(expand(makelist(rhouy[i],i,0,NC-1))), - expr_uz : float(expand(makelist(rhouz[i],i,0,NC-1))), - expr_temp : float(expand(makelist(rhoSq_temp[i],i,0,NC-1))), - - for i : 1 thru length(expr_ux) do ( - printf(fh," gkyl_mat_set(&rhs_ux,~a,0,~a); ~%", i-1, expr_ux[i]), - printf(fh," gkyl_mat_set(&rhs_uy,~a,0,~a); ~%", i-1, expr_uy[i]), - printf(fh," gkyl_mat_set(&rhs_uz,~a,0,~a); ~%", i-1, expr_uz[i]), - printf(fh," gkyl_mat_set(&rhs_temp,~a,0,~a); ~%", i-1, expr_temp[i]) - ), - printf(fh, " ~%"), - - /* Generate matrix of unknown coefficients */ - rho_e : doExpand1(rho, bC), - u_e : doExpand1(u,bC), - u_c : makelist(u[i],i,0,NC-1), - eq_rho : calcInnerProdList(varsC,u_e,bC,rho_e), - E_rho : fullratsimp(coefmatrix(eq_rho,u_c)), - - rhoSq_e : doExpand1(rhoSq, bC), - temp_e : doExpand1(temp_e,bC), - temp_c : makelist(temp[i],i,0,NC-1), - eq_rhoSq : calcInnerProdList(varsC,temp_e,bC,rhoSq_e), - E_rhoSq : fullratsimp(coefmatrix(eq_rhoSq,temp_c)), - - /* declare tmp_rho since matrix entries in A are the same for all operations */ - printf(fh, " double tmp_rho = 0.0; ~%"), - /* Matrix is dense so just do a simple write routine */ - for i : 1 thru NC do ( - for j : 1 thru NC do ( - printf(fh," tmp_rho = ~a; ~%", float(expand(E_rho[i,j]))), - printf(fh," gkyl_mat_set(&A_ux,~a,~a,~a); ~%", i-1, j-1, tmp_rho), - printf(fh," gkyl_mat_set(&A_uy,~a,~a,~a); ~%", i-1, j-1, tmp_rho), - printf(fh," gkyl_mat_set(&A_uz,~a,~a,~a); ~%", i-1, j-1, tmp_rho), - printf(fh," gkyl_mat_set(&A_temp,~a,~a,~a); ~%", i-1, j-1, float(expand(E_rhoSq[i,j]))), - printf(fh, " ~%") - ) - ), - printf(fh, "} ~%") -)$ - -gk_neut_fluid_prim_vars_udrift_temp_get_sol(fh, funcNm, cdim, basisFun, polyOrder) := block( - [varsC, bC, NC, i], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - /* Function declaration with input/output variables. */ - printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *xsol, - double* GKYL_RESTRICT out) ~%{ ~%", funcNm), - printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), - printf(fh, " // xsol: Input solution vector. ~%"), - printf(fh, " // out: Output volume expansion of flow velocity and temperature;~%"), - printf(fh, " ~%"), - - printf(fh, " struct gkyl_mat x_ux = gkyl_nmat_get(xsol, count); ~%"), - printf(fh, " struct gkyl_mat x_uy = gkyl_nmat_get(xsol, count+1); ~%"), - printf(fh, " struct gkyl_mat x_uz = gkyl_nmat_get(xsol, count+2); ~%"), - printf(fh, " struct gkyl_mat x_temp = gkyl_nmat_get(xsol, count+3); ~%"), - - printf(fh, " double *ux = &out[~a]; ~%", 0*NC), - printf(fh, " double *uy = &out[~a]; ~%", 1*NC), - printf(fh, " double *uz = &out[~a]; ~%", 2*NC), - printf(fh, " double *temp = &out[~a]; ~%", 3*NC), - printf(fh, "~%"), - - /* Fetch volume expansion solution from linear solve */ - for i : 1 thru NC do ( - printf(fh," ux[~a] = gkyl_mat_get(&x_ux,~a,0); ~%", i-1, i-1), - printf(fh," uy[~a] = gkyl_mat_get(&x_uy,~a,0); ~%", i-1, i-1), - printf(fh," uz[~a] = gkyl_mat_get(&x_uz,~a,0); ~%", i-1, i-1), - printf(fh," temp[~a] = gkyl_mat_get(&x_temp,~a,0); ~%", i-1, i-1) - ), - printf(fh, "~%"), - - printf(fh, "} ~%"), - printf(fh, " ~%") -)$ - diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-flowE.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-flowE.mac deleted file mode 100644 index cd02689e..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-flowE.mac +++ /dev/null @@ -1,61 +0,0 @@ -load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE")$ -load(stringproc)$ -/* This script calls the functions which generate the kernels for calculating the flow - energy using weak division. */ - - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 2$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor product basis. */ -/* Note that Serendipity, p = 1, is equivalent to Tensor */ -/* Thus no need to calculate p = 1 Tensor basis */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 2$ -maxCdim_Tensor : 0$ - -/* ...... END OF USER INPUTS........ */ - -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -for bInd : 1 thru length(bName) do ( - for d : minCdim[bInd] thru maxCdim[bInd] do ( - minPolyOrderB : minPolyOrder[bInd], - maxPolyOrderB : maxPolyOrder[bInd], - if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, - - for polyOrder : minPolyOrderB thru maxPolyOrderB do ( - disp(printf(false,sconcat("Creating prim vars flow energy funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), - - fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_flowE_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), - fh : openw(fname), - - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - printf(fh, "#include ~%", bName[bInd], d, polyOrder), - - funcName : sconcat("gk_neut_fluid_prim_vars_flowE_set_prob_", d, "x_", bName[bInd], "_p", polyOrder), - if (polyOrder = 1) then ( - gk_neut_fluid_prim_vars_flowE_set_prob_p1(fh, funcName, d, bName[bInd], polyOrder) - ) - else ( - gk_neut_fluid_prim_vars_flowE_set_prob(fh, funcName, d, bName[bInd], polyOrder) - ), - - funcName : sconcat("gk_neut_fluid_prim_vars_flowE_get_sol_", d, "x_", bName[bInd], "_p", polyOrder), - gk_neut_fluid_prim_vars_flowE_get_sol(fh, funcName, d, bName[bInd], polyOrder), - close(fh) - ) - ) -); diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-header.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-header.mac deleted file mode 100644 index d8b1ab73..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-header.mac +++ /dev/null @@ -1,70 +0,0 @@ -/* Generate the header file for gk neutral fluid prim vars kernels. */ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 2$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor product basis. */ -/* Note that Serendipity, p = 1, is equivalent to Tensor */ -/* Thus no need to calculate p = 1 Tensor basis */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 2$ -maxCdim_Tensor : 0$ - -/* ...... END OF USER INPUTS........ */ - -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -printPrototype(deco, ci, bStr, pi) := block([si], - - printf(fh, "~avoid gk_neut_fluid_prim_vars_udrift_set_prob_~ax_~a_p~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, const double *moms); ~%", deco, ci, bStr, pi), - printf(fh, "~avoid gk_neut_fluid_prim_vars_udrift_get_sol_~ax_~a_p~a(int count, struct gkyl_nmat *xsol, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), - - printf(fh, "~avoid gk_neut_fluid_prim_vars_pressure_~ax_~a_p~a(double gas_gamma, const double *moms, const double *udrift, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), - - printf(fh, "~avoid gk_neut_fluid_prim_vars_temp_set_prob_~ax_~a_p~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, const double *moms, double gas_gamma, double mass); ~%", deco, ci, bStr, pi), - printf(fh, "~avoid gk_neut_fluid_prim_vars_temp_get_sol_~ax_~a_p~a(int count, struct gkyl_nmat *xsol, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), - - printf(fh, "~avoid gk_neut_fluid_prim_vars_udrift_temp_set_prob_~ax_~a_p~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, const double *moms, double gas_gamma, double mass); ~%", deco, ci, bStr, pi), - printf(fh, "~avoid gk_neut_fluid_prim_vars_udrift_temp_get_sol_~ax_~a_p~a(int count, struct gkyl_nmat *xsol, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), - - printf(fh, "~avoid gk_neut_fluid_prim_vars_flowE_set_prob_~ax_~a_p~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, const double *moms); ~%", deco, ci, bStr, pi), - printf(fh, "~avoid gk_neut_fluid_prim_vars_flowE_get_sol_~ax_~a_p~a(int count, struct gkyl_nmat *xsol, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), - - printf(fh, "~%") -)$ - -/* ............ Write out the C header file ............ */ -fh : openw("~/max-out/gkyl_gk_neut_fluid_prim_vars_kernels.h")$ - -printf(fh, "#pragma once ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "EXTERN_C_BEG ~%")$ -printf(fh, "~%")$ - -decorator : "GKYL_CU_DH "$ -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - - minPolyOrderB : minPolyOrder[bInd], - maxPolyOrderB : maxPolyOrder[bInd], - if (c>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, - for polyOrder : minPolyOrderB thru maxPolyOrderB do ( - printPrototype(decorator, c, bName[bInd], polyOrder) - ) - ) -); -printf(fh, "EXTERN_C_END ~%")$ -close(fh)$ -/* ............ Finished writing out the C header file ............ */ diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-pressure.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-pressure.mac deleted file mode 100644 index 7f349108..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-pressure.mac +++ /dev/null @@ -1,53 +0,0 @@ -load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac")$ -load(stringproc)$ -/* This script calls the functions which generate the kernels for calculating the - pressure via weak multiplication. Pressure different for each equation system: - Euler -> p = (gas_gamma - 1)*(E - 1/2 rho u^2) - Computes both the volume expansion and the necessary surface expansions of p at - the corresponding surfaces */ - - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 2$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor product basis. */ -/* Note that Serendipity, p = 1, is equivalent to Tensor */ -/* Thus no need to calculate p = 1 Tensor basis */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 2$ -maxCdim_Tensor : 0$ - -/* ...... END OF USER INPUTS........ */ - -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -for bInd : 1 thru length(bName) do ( - for d : minCdim[bInd] thru maxCdim[bInd] do ( - minPolyOrderB : minPolyOrder[bInd], - maxPolyOrderB : maxPolyOrder[bInd], - if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, - - for polyOrder : minPolyOrderB thru maxPolyOrderB do ( - disp(printf(false,sconcat("Creating prim var pressure funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), - fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_pressure_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), - fh : openw(fname), - - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - - funcName : sconcat("gk_neut_fluid_prim_vars_pressure_", d, "x_", bName[bInd], "_p", polyOrder), - gk_neut_fluid_prim_vars_pressure(fh, funcName, d, bName[bInd], polyOrder), - close(fh) - ) - ) -); diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-temp.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-temp.mac deleted file mode 100644 index 992eb21f..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-temp.mac +++ /dev/null @@ -1,61 +0,0 @@ -load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp")$ -load(stringproc)$ -/* This script calls the functions which generate the kernels for calculating the - temperature using weak division. */ - - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 2$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor product basis. */ -/* Note that Serendipity, p = 1, is equivalent to Tensor */ -/* Thus no need to calculate p = 1 Tensor basis */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 2$ -maxCdim_Tensor : 0$ - -/* ...... END OF USER INPUTS........ */ - -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -for bInd : 1 thru length(bName) do ( - for d : minCdim[bInd] thru maxCdim[bInd] do ( - minPolyOrderB : minPolyOrder[bInd], - maxPolyOrderB : maxPolyOrder[bInd], - if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, - - for polyOrder : minPolyOrderB thru maxPolyOrderB do ( - disp(printf(false,sconcat("Creating prim vars temp funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), - - fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_temp_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), - fh : openw(fname), - - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - printf(fh, "#include ~%", bName[bInd], d, polyOrder), - - funcName : sconcat("gk_neut_fluid_prim_vars_temp_set_prob_", d, "x_", bName[bInd], "_p", polyOrder), - if (polyOrder = 1) then ( - gk_neut_fluid_prim_vars_temp_set_prob_p1(fh, funcName, d, bName[bInd], polyOrder) - ) - else ( - gk_neut_fluid_prim_vars_temp_set_prob(fh, funcName, d, bName[bInd], polyOrder) - ), - - funcName : sconcat("gk_neut_fluid_prim_vars_temp_get_sol_", d, "x_", bName[bInd], "_p", polyOrder), - gk_neut_fluid_prim_vars_temp_get_sol(fh, funcName, d, bName[bInd], polyOrder), - close(fh) - ) - ) -); diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift.mac deleted file mode 100644 index eda17370..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift.mac +++ /dev/null @@ -1,61 +0,0 @@ -load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift")$ -load(stringproc)$ -/* This script calls the functions which generate the kernels for calculating the flow - velocity using weak division. */ - - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 2$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor product basis. */ -/* Note that Serendipity, p = 1, is equivalent to Tensor */ -/* Thus no need to calculate p = 1 Tensor basis */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 2$ -maxCdim_Tensor : 0$ - -/* ...... END OF USER INPUTS........ */ - -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -for bInd : 1 thru length(bName) do ( - for d : minCdim[bInd] thru maxCdim[bInd] do ( - minPolyOrderB : minPolyOrder[bInd], - maxPolyOrderB : maxPolyOrder[bInd], - if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, - - for polyOrder : minPolyOrderB thru maxPolyOrderB do ( - disp(printf(false,sconcat("Creating prim vars udrift funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), - - fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_udrift_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), - fh : openw(fname), - - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - printf(fh, "#include ~%", bName[bInd], d, polyOrder), - - funcName : sconcat("gk_neut_fluid_prim_vars_udrift_set_prob_", d, "x_", bName[bInd], "_p", polyOrder), - if (polyOrder = 1) then ( - gk_neut_fluid_prim_vars_udrift_set_prob_p1(fh, funcName, d, bName[bInd], polyOrder) - ) - else ( - gk_neut_fluid_prim_vars_udrift_set_prob(fh, funcName, d, bName[bInd], polyOrder) - ), - - funcName : sconcat("gk_neut_fluid_prim_vars_udrift_get_sol_", d, "x_", bName[bInd], "_p", polyOrder), - gk_neut_fluid_prim_vars_udrift_get_sol(fh, funcName, d, bName[bInd], polyOrder), - close(fh) - ) - ) -); diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift_temp.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift_temp.mac deleted file mode 100644 index 4e07293c..00000000 --- a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift_temp.mac +++ /dev/null @@ -1,61 +0,0 @@ -load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp")$ -load(stringproc)$ -/* This script calls the functions which generate the kernels for calculating the flow - velocity and temperature using weak division. */ - - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 2$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor product basis. */ -/* Note that Serendipity, p = 1, is equivalent to Tensor */ -/* Thus no need to calculate p = 1 Tensor basis */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 2$ -maxCdim_Tensor : 0$ - -/* ...... END OF USER INPUTS........ */ - -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -for bInd : 1 thru length(bName) do ( - for d : minCdim[bInd] thru maxCdim[bInd] do ( - minPolyOrderB : minPolyOrder[bInd], - maxPolyOrderB : maxPolyOrder[bInd], - if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, - - for polyOrder : minPolyOrderB thru maxPolyOrderB do ( - disp(printf(false,sconcat("Creating prim vars udrift funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), - - fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_udrift_temp_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), - fh : openw(fname), - - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - printf(fh, "#include ~%", bName[bInd], d, polyOrder), - - funcName : sconcat("gk_neut_fluid_prim_vars_udrift_temp_set_prob_", d, "x_", bName[bInd], "_p", polyOrder), - if (polyOrder = 1) then ( - gk_neut_fluid_prim_vars_udrift_temp_set_prob_p1(fh, funcName, d, bName[bInd], polyOrder) - ) - else ( - gk_neut_fluid_prim_vars_udrift_temp_set_prob(fh, funcName, d, bName[bInd], polyOrder) - ), - - funcName : sconcat("gk_neut_fluid_prim_vars_udrift_temp_get_sol_", d, "x_", bName[bInd], "_p", polyOrder), - gk_neut_fluid_prim_vars_udrift_temp_get_sol(fh, funcName, d, bName[bInd], polyOrder), - close(fh) - ) - ) -); diff --git a/maxima/g0/gk_pol_den/ms-pol_density-header.mac b/maxima/g0/gk_pol_den/ms-pol_density-header.mac index 4264549a..eaf5a722 100644 --- a/maxima/g0/gk_pol_den/ms-pol_density-header.mac +++ b/maxima/g0/gk_pol_den/ms-pol_density-header.mac @@ -40,13 +40,7 @@ for bInd : 1 thru length(bName) do ( for cd : minCdim[bInd] thru maxCdim[bInd] do ( for polyOrder : minPolyOrder[bInd] thru maxPolyOrder[bInd] do ( - funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_",bName[bInd],"_p",polyOrder), - printf(fh, "GKYL_CU_DH void ~a(const double *dx, const double *epsilon, const double *phi, double *out);~%", funcName), - - funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_",bName[bInd],"_p",polyOrder+1), - printf(fh, "GKYL_CU_DH void ~a(const double *dx, const double *epsilon, const double *phi, double *out);~%", funcName), - - funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_","tensor","_p",polyOrder+1), + funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder), printf(fh, "GKYL_CU_DH void ~a(const double *dx, const double *epsilon, const double *phi, double *out);~%", funcName) ) ), diff --git a/maxima/g0/gk_pol_den/ms-pol_density.mac b/maxima/g0/gk_pol_den/ms-pol_density.mac index 60ba36eb..9709f329 100644 --- a/maxima/g0/gk_pol_den/ms-pol_density.mac +++ b/maxima/g0/gk_pol_den/ms-pol_density.mac @@ -42,18 +42,8 @@ for bInd : 1 thru length(bName) do ( for cd : minCdim[bInd] thru maxCdim[bInd] do ( for polyOrder : minPolyOrder[bInd] thru maxPolyOrder[bInd] do ( disp(printf(false,sconcat("Creating gkyl_gyrokinetic_pol_density ~ax p~a ", bName[bInd]),cd,polyOrder)), - - /* Represent phi with same basis and poly_order. */ - funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_",bName[bInd],"_p",polyOrder), - gen_pol_den_kernel(fh, funcName, cd, bName[bInd], polyOrder, bName[bInd], polyOrder), - - /* Represent phi with same basis and poly_order+1. */ - funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_",bName[bInd],"_p",polyOrder+1), - gen_pol_den_kernel(fh, funcName, cd, bName[bInd], polyOrder, bName[bInd], polyOrder+1), - - /* Represent phi with tensor basis and poly_order+1. */ - funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_","tensor","_p",polyOrder+1), - gen_pol_den_kernel(fh, funcName, cd, bName[bInd], polyOrder, "tensor", polyOrder+1) + funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder), + gen_pol_den_kernel(fh, funcName, cd, bName[bInd], polyOrder) ) ), diff --git a/maxima/g0/gk_pol_den/pol_density.mac b/maxima/g0/gk_pol_den/pol_density.mac index 43897a9b..6ff5b4c2 100644 --- a/maxima/g0/gk_pol_den/pol_density.mac +++ b/maxima/g0/gk_pol_den/pol_density.mac @@ -6,12 +6,12 @@ load("modal-basis"); load("out-scripts"); fpprec : 24$ -gen_pol_den_kernel(fh, funcNm, dim, basisFun, polyOrder, basisFunPhi, polyOrderPhi) := block( +gen_pol_den_kernel(fh, funcNm, dim, basisFun, polyOrder) := block( [vars,basis_p,numB_p,basis,numB,phi_e,dimPerp,varsPerp,varCombos,epsSup_l, eps,eps_e,i,j,varsSorted,epsNew,isNew,k,rdx_ij,ijSorted,pol_den_c], - /* Load a basis to represent phi. */ - [vars, basis_p] : loadBasis(basisFunPhi, dim, polyOrderPhi), + /* Load a higher order tensor basis to represent phi. */ + [vars, basis_p] : loadBasis("tensor", dim, polyOrder+1), numB_p : length(basis_p), /* Load basis to represent other quantities. */ diff --git a/maxima/g0/neutrals/sigma-cx-calc.mac b/maxima/g0/neutrals/sigma-cx-calc.mac new file mode 100644 index 00000000..e54cc6d1 --- /dev/null +++ b/maxima/g0/neutrals/sigma-cx-calc.mac @@ -0,0 +1,139 @@ +/* Generate CX cross section (vSigmaCX) kernels for charge + exchange operator */ + +load("modal-basis"); +load("out-scripts"); +load(stringproc)$ +fpprec : 24$ + +/* Serendipity basis. */ +maxPolyOrder_Ser : 2$ + +declareWriteCExprsC(lhs, rhs) := block([expr], + expr : float(expand(rhs)), + if expr # 0.0 then ( + ep : string(expr), + for i : 0 thru 60 do ( + ep : ssubst(string(pow(u_ion[i],2.)),string(u_ion[i]^2),ep), + ep : ssubst(string(pow(u_neut[i],2.)),string(u_neut[i]^2),ep) + ), + printf(fh, " double ~a = ~a; ~%", lhs, ep) + ) +)$ + +writeCExprsCs(lhs, rhs) := block([expr], + expr : float(expand(rhs)), + for i : 1 thru length(expr) do ( + if expr[i] # 0.0 then ( + ep : string(expr[i]), + ep : ssubst("log(","ln(",ep), + printf(fh, " ~a = ~a; ~%", lhs[i-1], ep) + ) + ) +)$ + +writeCExprsC(lhs, rhs) := block([expr], + expr : float(expand(rhs)), + if expr # 0.0 then ( + ep : string(expr), + printf(fh, " ~a = ~a; ~%", lhs, ep) + ) +)$ + +/* vSigmaCX for charge exchange cross section */ +calcSigmaCXcellAv(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block([], + kill(varsC, varsP, basisC, basisP), + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + NC : length(bC), + + printf(fh, " ~%"), + printf(fh, "GKYL_CU_DH static inline ~%"), + printf(fh, "double ~a_p~a(const double a, const double b, double vt_sq_ion_min, double vt_sq_neut_min, const double *m0, const double *prim_vars_ion, const double *prim_vars_neut, double* GKYL_RESTRICT v_sigma_cx) ~%{ ~%", funcNm, p), + printf(fh, " // a constant in fitting function. ~%"), + printf(fh, " // b constant in fitting function. ~%"), + printf(fh, " // m0[~a]: neutral particle density. ~%", NC), + printf(fh, " // prim_vars_ion[~a]: ion prim vars. ~%", NC*(vdim+1)), + printf(fh, " // prim_vars_neut[~a]: neut prim vars. ~%", NC*(vdim+1)), + printf(fh, " // v_sigma_cx: cell ave cross section fitting eqn. ~%"), + printf(fh, " ~%"), + + m0_e : doExpand1(m0,bC), + m0_av : innerProd(varsC,1.0,1.0,m0_e)/innerProd(varsC,1.0,1.0,1.0), + declareWriteCExprsC(m0_neut_av, m0_av), + + printf(fh, " const double *u_ion = &prim_vars_ion[~a]; ~%", 0), + printf(fh, " const double *vt_sq_ion = &prim_vars_ion[~a]; ~%", NC*vdim), + printf(fh, " const double *u_neut = &prim_vars_neut[~a]; ~%", 0), + printf(fh, " const double *vt_sq_neut = &prim_vars_neut[~a]; ~%", NC*vdim), + printf(fh, " ~%"), + + u_ion_av_c : subst(makelist(u_ion[i]=u_ion[i+a0],i,0,NC-1),innerProd(varsC,1.0,1.0,doExpand1(u_ion,bC))/innerProd(varsC,1.0,1.0,1.0)), + u_neut_av_c : subst(makelist(u_neut[i]=u_neut[i+a0],i,0,NC-1),innerProd(varsC,1.0,1.0,doExpand1(u_neut,bC))/innerProd(varsC,1.0,1.0,1.0)), + + u_ion_av : makelist(0,i,1,vdim), + u_neut_av : makelist(0,i,1,vdim), + for vi : 1 thru vdim do ( + u_ion_av[vi] : fullratsimp(subst(a0=(vi-1)*NC,u_ion_av_c)), + u_neut_av[vi] : fullratsimp(subst(a0=(vi-1)*NC,u_neut_av_c)) + ), + + vt_sq_ion_av_c : innerProd(varsC,1.0,1.0, doExpand1(vt_sq_ion,bC))/innerProd(varsC,1.0,1.0,1.0), + vt_sq_neut_av_c : innerProd(varsC,1.0,1.0, doExpand1(vt_sq_neut,bC))/innerProd(varsC,1.0,1.0,1.0), + + declareWriteCExprsC(vt_sq_ion_av, vt_sq_ion_av_c), + declareWriteCExprsC(vt_sq_neut_av, vt_sq_neut_av_c), + + /* Limit how low the temperature can get (set by the velocity grid). */ + printf(fh, " if ((vt_sq_ion_av > 0.) && (vt_sq_ion_av < vt_sq_ion_min)) vt_sq_ion_av = vt_sq_ion_min;~%"), + printf(fh, " if ((vt_sq_neut_av > 0.) && (vt_sq_neut_av < vt_sq_neut_min)) vt_sq_neut_av = vt_sq_neut_min;~%"), + printf(fh, " ~%"), + + /* Define and write v_sigma_cx */ + printf(fh, " if (m0_neut_av <= 0 || vt_sq_neut_av <= 0 || vt_sq_ion_av <= 0) { ~%"), + printf(fh, " v_sigma_cx[0] = 0.0;~%"), + printf(fh, " return 0.0; ~%"), + printf(fh, " } else {~%"), + + /* Define v_in variable: v_in_sq = |u_ion - u_neut|^2 */ + v_in_sq_c : innerProd(varsC,1.0,1.0,sum((u_ion_av[d] - u_neut_av[d])^2,d,1,vdim))/innerProd(varsC,1.0,1.0,1.0), + declareWriteCExprsC(v_in_sq_av, v_in_sq_c), + printf(fh, " ~%"), + + printf(fh, " double v_cx = ~a;~%",float(sqrt(4/%pi*vt_sq_ion_av + 4/%pi*vt_sq_neut_av + v_in_sq_av))), + v_sigma_cx_c : calcInnerProdList(varsC,1.0,bC,v_cx*(a - b*ln(v_cx))), + writeCExprsCs(v_sigma_cx, v_sigma_cx_c), + printf(fh, " ~%"), + + v_sigma_cx_e : doExpand1(v_sigma_cx,bC), + v_sigma_cx_av : innerProd(varsC,1.0,1.0,v_sigma_cx_e)/innerProd(varsC,1.0,1.0,1.0), + cflRate : float(expand(fullratsimp(m0_av*v_sigma_cx_av/(2*p+1)))), + printf(fh, " return ~a; ~%",cflRate), + printf(fh, " }~%"), + printf(fh, "} ~%") +)$ + +bName : ["ser"]$ +maxPolyOrder : [maxPolyOrder_Ser]$ + +fh : openw("~/max-out/gkyl_dg_cx_kernels.h")$ +printf(fh, "#pragma once ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ + +for bInd : 1 thru length(bName) do ( + for c : 1 thru 3 do ( + for v : c thru 3 do ( + for p : 1 thru maxPolyOrder[bInd] do ( + print(p), + disp(printf(false,sconcat("Creating v_sigma_cx ", bName[bInd]," ~ax~av"),c,v)), + + print("attempting to print",c,"x",v,"v",p,"p functions..."), + /*. Calculate CX cross section. */ + funcNm : sconcat("sigma_cx_", c, "x", v, "v_", bName[bInd]), + + calcSigmaCXcellAv(fh, funcNm, c, v, bName[bInd], p) + ) + ) + ) +); +close(fh)$ diff --git a/maxima/g0/prim_moments/CrossPrimMomsLBO.mac b/maxima/g0/prim_moments/CrossPrimMomsLBO.mac index 54008836..a50045ae 100644 --- a/maxima/g0/prim_moments/CrossPrimMomsLBO.mac +++ b/maxima/g0/prim_moments/CrossPrimMomsLBO.mac @@ -37,13 +37,11 @@ writeCExprs1s(lhs, rhs) := block([expr], )$ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( - [udim,vDegFreedom,vars,basis,numB,nodes,momsin,vtsqin,m0in_e,m0Corners,m2in_e, - m2Corners,vtsqin_e,vtsqCorners,alphaE_c,alphaE_e,alphaECorners,expr,m0_e,m0_c,m2_e,m2_c, - vtsq_self_e,vtsq_self_c,vtsq_other_e,vtsq_other_c,vtSqCross_e,vtSqCross_c,cE_e, - cE_c,N,u_self_e,u_self_c,u_other_e,u_other_c,m1_e,m1_c,cM_e,cM_c,uCross_e,uCross_c, - eq,E,Eflat,Elhs,momRHS_c,ucMSelf_c,ucMSelf_e,ucMOther_c,ucMOther_e,uM1Self_c, - uM1Self_e,uM1Other_c,uM1Other_e,uSumSq_c,uSumSq_e,enRHS1_c,enRHS2_c,enRHS_c, - tempVars,sqCoeffs], + [udim,vDegFreedom,basis,numB,expr,m0_e,m0_c,m2_e,m2_c,vtsq_self_e,vtsq_self_c, + vtsq_other_e,vtsq_other_c,vtSqCross_e,vtSqCross_c,cE_e,cE_c,N,u_self_e,u_self_c, + u_other_e,u_other_c,m1_e,m1_c,cM_e,cM_c,uCross_e,uCross_c,eq,E,Eflat,Elhs,momRHS_c, + ucMSelf_c,ucMSelf_e,ucMOther_c,ucMOther_e,uM1Self_c,uM1Self_e,uM1Other_c,uM1Other_e, + uSumSq_c,uSumSq_e,enRHS1_c,enRHS2_c,enRHS_c,tempVars,sqCoeffs], if (sequal(substring(funcNm,1,7),"vlasov")) then ( udim : vdim, @@ -60,22 +58,15 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( numB : length(basis), /* Function declaration with input/output variables. */ - printf(fh, "GKYL_CU_DH void ~a(struct gkyl_mat *A, struct gkyl_mat *rhs, const double *alphaE, const double m_self, const double *moms_self, const double *prim_mom_self, const double m_other, const double *moms_other, const double *prim_mom_other, const double *boundary_corrections, const double *nu) ~%{ ~%", funcNm), - printf(fh, " // A: Left-side matrix. ~%"), - printf(fh, " // rhs: Right-side vector. ~%"), - printf(fh, " // alphaE: Morse's alpha_E factor. ~%"), - printf(fh, " // m_self: self mass. ~%"), - printf(fh, " // moms_self: self moments of the distribution function. ~%"), - printf(fh, " // prim_mom_self: self primitive moments: mean flow velocity and thermal speed squared. ~%"), - printf(fh, " // m_other: mass of other species. ~%"), - printf(fh, " // moms_other: moments of the other distribution function. ~%"), - printf(fh, " // prim_mom_other: cross primitive moments: mean flow velocity and thermal speed squared. ~%"), + printf(fh, "GKYL_CU_DH void ~a(struct gkyl_mat *A, struct gkyl_mat *rhs, const double *greene, const double m_self, const double *moms_self, const double *prim_mom_self, const double m_other, const double *moms_other, const double *prim_mom_other, const double *boundary_corrections, const double *nu) ~%{ ~%", funcNm), + printf(fh, " // greene: Greene's factor. ~%"), + printf(fh, " // m_: mass. ~%"), + printf(fh, " // moms: moments of the distribution function. ~%"), + printf(fh, " // prim_mom self primitive moments: mean flow velocity and thermal speed squared. ~%"), printf(fh, " // boundary_corrections: corrections to momentum and energy conservation due to finite velocity space. ~%"), - printf(fh, " // nu: Cross-species collision frequency. ~%"), + printf(fh, " // nu: Collision frequency. ~%"), printf(fh, " ~%"), - printf(fh, " const double m_sumDms = (m_self+m_other)/m_self;~%"), - /* Create pointers to u and vtsq of each species. */ printf(fh, " const double *u_self = &prim_mom_self[~a];~%", 0*numB), printf(fh, " const double *vtsq_self = &prim_mom_self[~a];~%", udim*numB), @@ -124,13 +115,6 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( ), printf(fh, " ~%") ), - /* Also check alpha_E. */ - alphaE_c : makelist(alphaE[i-1],i,1,numB), - alphaE_e : doExpand(alphaE_c, basis), - alphaECorners : gcfac(float(fullratsimp(evAtNodes(alphaE_e,nodes,vars)))), - for i : 1 thru length(nodes) do ( - printf(fh, " if (notCellAvg && (~a < 0)) notCellAvg = false; ~%", alphaECorners[i]) - ), printf(fh, " if (notCellAvg) { ~%"), /* Use the original expansion polynomial. */ @@ -185,11 +169,13 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( printf(fh, " ~%"), /* Expansion in configuration space basis and coefficients - of m0 and m2. */ - m0_c : makelist(m0r[i-1],i,1,numB), - m2_c : makelist(m2r[i-1],i,1,numB), - m0_e : doExpand(m0_c, basis), - m2_e : doExpand(m2_c, basis), + of m0, m2 and the Greene factor. */ + m0_c : makelist(m0r[i-1],i,1,numB), + m2_c : makelist(m2r[i-1],i,1,numB), + m0_e : doExpand(m0_c, basis), + m2_e : doExpand(m2_c, basis), + greene_c : makelist(greene[i-1],i,1,numB), + greene_e : doExpand(greene_c, basis), /* Equivalently for vtSq .*/ vtsq_self_c : makelist(vtsq_self[i-1],i,1,numB), vtsq_other_c : makelist(vtsq_other[i-1],i,1,numB), @@ -270,7 +256,7 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( printf(fh, " ~%"), /*....... Matrix block corresponding to RHS of momentum equation .......*/ - expr : calcInnerProdList(vars,1,basis,2*m1_e - alphaE_e*m_sumDms*(u_self_e - u_other_e)), + expr : calcInnerProdList(vars,1,basis,2*m1_e - greene_e*(u_self_e - u_other_e)), for i : 1 thru numB do ( printf(fh, " ~a += ~a; ~%", momRHS[(vd-1)*numB+i-1], float(expr[i])) ), @@ -350,8 +336,9 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( printf(fh, " } ~%"), printf(fh, " ~%"), + printf(fh, " double m_sum = ~a;~%",m_self + m_other), printf(fh, " double m_diff = ~a;~%",m_other - m_self), - enRHS1_c : calcInnerProdList(vars,alphaE_e/m_self,basis, + enRHS1_c : calcInnerProdList(vars,greene_e/m_sum,basis, vDegFreedom*(m_other*vtsq_other_e - m_self*vtsq_self_e) + 0.5*m_diff*uSumSq_e), enRHS2_c : calcInnerProdList(vars,1,basis,2*m2_e - uM1Self_e - uM1Other_e), enRHS_c : enRHS1_c + enRHS2_c, diff --git a/maxima/g0/prim_moments/ms-gkCrossPrimMomsLBO.mac b/maxima/g0/prim_moments/ms-gkCrossPrimMomsLBO.mac index 077212c1..a95245d4 100644 --- a/maxima/g0/prim_moments/ms-gkCrossPrimMomsLBO.mac +++ b/maxima/g0/prim_moments/ms-gkCrossPrimMomsLBO.mac @@ -14,9 +14,9 @@ maxCdim_Ser : 3$ /* Note that Serendipity, p = 1, is equivalent to Tensor */ /* Thus no need to calculate p = 1 Tensor basis */ minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ +maxPolyOrder_Tensor : 2$ minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ +maxCdim_Tensor : 2$ /* Vdim possibilities for each of Cdim=[1,2,3]. */ gkVdims : [[1,2], [2], [2]]$ diff --git a/maxima/g0/prim_moments/ms-gkPrimMoments-header.mac b/maxima/g0/prim_moments/ms-gkPrimMoments-header.mac index ecb89234..1db923fb 100644 --- a/maxima/g0/prim_moments/ms-gkPrimMoments-header.mac +++ b/maxima/g0/prim_moments/ms-gkPrimMoments-header.mac @@ -56,7 +56,7 @@ for bInd : 1 thru length(bName) do ( printf(fh, "GKYL_CU_DH void gyrokinetic_self_prim_moments_~ax~av_~a_p~a(struct gkyl_mat *A, struct gkyl_mat *rhs,~% const double *moms, const double *boundary_corrections, const double *nu); ~%", ci, vi, bName[bInd], pi), /* Primitive moments for cross-collision GkLBO terms. */ - printf(fh, "GKYL_CU_DH void gyrokinetic_cross_prim_moments_~ax~av_~a_p~a(struct gkyl_mat *A, struct gkyl_mat *rhs,~% const double *alphaE, const double m_self, const double *moms_self, const double *prim_mom_self,~% const double m_other, const double *moms_other, const double *prim_mom_other,~% const double *boundary_corrections, const double *nu); ~%", ci, vi, bName[bInd], pi), + printf(fh, "GKYL_CU_DH void gyrokinetic_cross_prim_moments_~ax~av_~a_p~a(struct gkyl_mat *A, struct gkyl_mat *rhs,~% const double *greene, const double m_self, const double *moms_self, const double *prim_mom_self,~% const double m_other, const double *moms_other, const double *prim_mom_other,~% const double *boundary_corrections, const double *nu); ~%", ci, vi, bName[bInd], pi), printf(fh, "~%") ) diff --git a/provable-algorithms/finite_volume/code_generator_core.rkt b/provable-algorithms/code_generator_core.rkt similarity index 92% rename from provable-algorithms/finite_volume/code_generator_core.rkt rename to provable-algorithms/code_generator_core.rkt index d9ba7978..19608fa7 100644 --- a/provable-algorithms/finite_volume/code_generator_core.rkt +++ b/provable-algorithms/code_generator_core.rkt @@ -184,11 +184,9 @@ int main() { double x = x0 + (i - 0.5) * dx; u[i] = ~a; // init-func in C. - un[i] = ~a; // init-func in C. } double t = 0.0; - int n = 0; while (t < t_final) { // Determine global maximum wave-speed alpha (for stable dt). // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. @@ -245,25 +243,14 @@ int main() { u[0] = u[1]; u[nx + 1] = u[nx]; - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - - fclose(fptr); - } - // Increment time. t += dt; - n += 1; + } + + // Output solution to stdout. + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + printf(\"%g %g\\n\", x, u[i]); } free(u); @@ -286,8 +273,7 @@ int main() { cfl ;; Final time. t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). init-func-code ;; Expression for local wave-speed estimate. max-speed-local @@ -297,9 +283,6 @@ int main() { flux-ui ;; Right flux f(u_{i + 1}). flux-up - ;; PDE name for file output. - name - name )) code) @@ -398,11 +381,9 @@ int main() { double x = x0 + (i - 1.5) * dx; u[i] = ~a; // init-func in C. - un[i] = ~a; // init-func in C. } double t = 0.0; - int n = 0; while (t < t_final) { // Determine global maximum wave-speed alpha (for stable dt). // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. @@ -495,25 +476,14 @@ int main() { u[nx + 2] = u[nx + 1]; u[nx + 3] = u[nx + 1]; - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - - fclose(fptr); - } - // Increment time. t += dt; - n += 1; + } + + // Output solution to stdout. + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + printf(\"%g %g\\n\", x, u[i]); } free(u); @@ -539,8 +509,7 @@ int main() { cfl ;; Final time. t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). init-func-code ;; Expression for local wave-speed estimate. max-speed-local @@ -566,9 +535,6 @@ int main() { flux-uiR-evol ;; Evolved left positive flux f(u_{i + 1, L+}). flux-upL-evol - ;; PDE name for file output. - name - name )) code) @@ -653,11 +619,9 @@ int main() { double x = x0 + (i - 0.5) * dx; u[i] = ~a; // init-func in C. - un[i] = ~a; // init-func in C. } double t = 0.0; - int n = 0; while (t < t_final) { // Determine global maximum wave-speed alpha (for stable dt). // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. @@ -721,25 +685,14 @@ int main() { u[0] = u[1]; u[nx + 1] = u[nx]; - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - - fclose(fptr); - } - // Increment time. t += dt; - n += 1; + } + + // Output solution to stdout. + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + printf(\"%g %g\\n\", x, u[i]); } free(u); @@ -762,8 +715,7 @@ int main() { cfl ;; Final time. t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). init-func-code ;; Expression for local wave-speed estimate. max-speed-local @@ -779,9 +731,6 @@ int main() { flux-deriv-ui ;; Right flux derivative f'(u_{i + 1}). flux-deriv-up - ;; PDE name for file output. - name - name )) code) @@ -888,11 +837,9 @@ int main() { double x = x0 + (i - 1.5) * dx; u[i] = ~a; // init-func in C. - un[i] = ~a; // init-func in C. } double t = 0.0; - int n = 0; while (t < t_final) { // Determine global maximum wave-speed alpha (for stable dt). // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. @@ -927,7 +874,7 @@ int main() { slope[i] = limiter * (0.5 * ((u[i] - u[i - 1]) + (u[i + 1] - u[i]))); } - // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable. + // Compute fluxes with Roe approximation and update the conserved variable. for (int i = 2; i <= nx + 1; i++) { // Extrapolate boundary states. double umL = u[i - 1] - (0.5 * slope[i - 1]); @@ -994,25 +941,14 @@ int main() { u[nx + 2] = u[nx + 1]; u[nx + 3] = u[nx + 1]; - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - - fclose(fptr); - } - // Increment time. t += dt; - n += 1; + } + + // Output solution to stdout. + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + printf(\"%g %g\\n\", x, u[i]); } free(u); @@ -1038,8 +974,7 @@ int main() { cfl ;; Final time. t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). init-func-code ;; Expression for local wave-speed estimate. max-speed-local @@ -1073,8 +1008,5 @@ int main() { flux-deriv-uiR-evol ;; Evolved left positive flux derivative f'(u_{i + 1, L+}). flux-deriv-upL-evol - ;; PDE name for file output. - name - name )) code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/code_generator_vector.rkt b/provable-algorithms/code_generator_vector.rkt similarity index 94% rename from provable-algorithms/finite_volume/code_generator_vector.rkt rename to provable-algorithms/code_generator_vector.rkt index dc9af122..d7fff704 100644 --- a/provable-algorithms/finite_volume/code_generator_vector.rkt +++ b/provable-algorithms/code_generator_vector.rkt @@ -113,12 +113,9 @@ int main() { u[(i * 2) + 0] = ~a; // init-funcs[0] in C. u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - un[(i * 2) + 0] = ~a; // init-funcs[0] in C. - un[(i * 2) + 1] = ~a; // init-funcs[1] in C. } double t = 0.0; - int n = 0; while (t < t_final) { // Determine global maximum wave-speed alpha (for stable dt). // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. @@ -195,27 +192,14 @@ int main() { u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; } - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - - fclose(fptr); - } - } - // Increment time. t += dt; - n += 1; + } + + // Output solution to stdout. + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + printf(\"%g %g %g\\n\", x, u[(i * 2) + 0], u[(i * 2) + 1]); } free(u); @@ -254,8 +238,6 @@ int main() { ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). (list-ref init-func-codes 0) (list-ref init-func-codes 1) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) ;; Expressions for local wave-speed estimates. (list-ref max-speed-locals 0) (list-ref max-speed-locals 1) @@ -268,9 +250,6 @@ int main() { ;; Right flux vector F(u_{i + 1}). (list-ref flux-ups 0) (list-ref flux-ups 1) - ;; PDE name for file output. - name - name )) code) @@ -431,12 +410,9 @@ int main() { u[(i * 2) + 0] = ~a; // init-funcs[0] in C. u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - un[(i * 2) + 0] = ~a; // init-funcs[0] in C. - un[(i * 2) + 1] = ~a; // init-funcs[1] in C. } double t = 0.0; - int n = 0; while (t < t_final) { // Determine global maximum wave-speed alpha (for stable dt). // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. @@ -558,27 +534,14 @@ int main() { u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; } - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - - fclose(fptr); - } - } - // Increment time. t += dt; - n += 1; + } + + // Output solution to stdout. + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + printf(\"%g %g %g\\n\", x, u[(i * 2) + 0], u[(i * 2) + 1]); } free(u); @@ -636,8 +599,6 @@ int main() { ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). (list-ref init-func-codes 0) (list-ref init-func-codes 1) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) ;; Expressions for local wave-speed estimates. (list-ref max-speed-locals 0) (list-ref max-speed-locals 1) @@ -673,9 +634,6 @@ int main() { ;; Evolved left positive flux vector F(U_{i + 1, L+}). (list-ref flux-upL-evols 0) (list-ref flux-upL-evols 1) - ;; PDE name for file output. - name - name )) code) @@ -807,12 +765,9 @@ int main() { u[(i * 2) + 0] = ~a; // init-funcs[0] in C. u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - un[(i * 2) + 0] = ~a; // init-funcs[0] in C. - un[(i * 2) + 1] = ~a; // init-funcs[1] in C. } double t = 0.0; - int n = 0; while (t < t_final) { // Determine global maximum wave-speed alpha (for stable dt). // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. @@ -905,27 +860,14 @@ int main() { u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; } - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - - fclose(fptr); - } - } - // Increment time. t += dt; - n += 1; + } + + // Output solution to stdout. + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + printf(\"%g %g %g\\n\", x, u[(i * 2) + 0], u[(i * 2) + 1]); } free(u); @@ -971,8 +913,6 @@ int main() { ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). (list-ref init-func-codes 0) (list-ref init-func-codes 1) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) ;; Expressions for local wave-speed estimates. (list-ref max-speed-locals 0) (list-ref max-speed-locals 1) @@ -994,9 +934,6 @@ int main() { ;; Eigenvalues of right flux Jacobian F'(u_{i + 1}). (list-ref flux-deriv-ups 0) (list-ref flux-deriv-ups 1) - ;; PDE name for file output. - name - name )) code) @@ -1184,12 +1121,9 @@ int main() { u[(i * 2) + 0] = ~a; // init-funcs[0] in C. u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - un[(i * 2) + 0] = ~a; // init-funcs[0] in C. - un[(i * 2) + 1] = ~a; // init-funcs[1] in C. } double t = 0.0; - int n = 0; while (t < t_final) { // Determine global maximum wave-speed alpha (for stable dt). // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. @@ -1327,28 +1261,15 @@ int main() { u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; } - - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - - fclose(fptr); - } - } // Increment time. t += dt; - n += 1; + } + + // Output solution to stdout. + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + printf(\"%g %g %g\\n\", x, u[(i * 2) + 0], u[(i * 2) + 1]); } free(u); @@ -1411,8 +1332,6 @@ int main() { ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). (list-ref init-func-codes 0) (list-ref init-func-codes 1) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) ;; Expressions for local wave-speed estimates. (list-ref max-speed-locals 0) (list-ref max-speed-locals 1) @@ -1460,8 +1379,5 @@ int main() { ;; Eigenvalues of evolved left positive flux Jacobian F'(U_{i + 1, L+}). (list-ref flux-deriv-upL-evols 0) (list-ref flux-deriv-upL-evols 1) - ;; PDE name for file output. - name - name )) code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/code_generator_core_2d.rkt b/provable-algorithms/finite_volume/code_generator_core_2d.rkt deleted file mode 100644 index c4fa8361..00000000 --- a/provable-algorithms/finite_volume/code_generator_core_2d.rkt +++ /dev/null @@ -1,1977 +0,0 @@ -#lang racket - -(require "prover_core.rkt") -(require "code_generator_core.rkt") -(provide generate-lax-friedrichs-scalar-2d - generate-lax-friedrichs-scalar-2d-second-order - generate-roe-scalar-2d - generate-roe-scalar-2d-second-order) - -;; ------------------------------------------------------------- -;; Lax–Friedrichs (Finite-Difference) Solver for a 2D Scalar PDE -;; ------------------------------------------------------------- -(define (generate-lax-friedrichs-scalar-2d pde - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that solves the 2D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define cons-code (convert-expr cons-expr)) - (define flux-code-x (convert-expr flux-expr-x)) - (define flux-code-y (convert-expr flux-expr-y)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define flux-um-x (flux-substitute flux-code-x cons-code "um_x")) - (define flux-ui-x (flux-substitute flux-code-x cons-code "ui_x")) - (define flux-up-x (flux-substitute flux-code-x cons-code "up_x")) - - (define flux-um-y (flux-substitute flux-code-y cons-code "um_y")) - (define flux-ui-y (flux-substitute flux-code-y cons-code "ui_y")) - (define flux-up-y (flux-substitute flux-code-y cons-code "up_y")) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR SCALAR PDE: ~a -// Lax–Friedrichs first-order finite-difference solver for a scalar PDE in 2D. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - double **un = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * sizeof(double)); - un[i] = (double*) malloc((ny + 2) * sizeof(double)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][j] = ~a; // init-func in C. - un[i][j] = ~a; // init-func in C. - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_y = u[i][j - 1]; - double ui_y = u[i][j]; - double up_y = u[i][j + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um_y = ~a; // f(u_{j - 1}). - double f_ui_y = ~a; // f(u_j). - double f_up_y = ~a; // f(u_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * alpha_y * (u_j - u_{j - 1}). - double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * alpha_y * (ui_y - um_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * alpha_y * (u_{j + 1} - u_j). - double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * alpha_y * (up_y - ui_y); - - // Update the conserved variable. - un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the x-direction. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_x = u[i - 1][j]; - double ui_x = u[i][j]; - double up_x = u[i + 1][j]; - - // Evaluate flux for each value of the conserved variable. - double f_um_x = ~a; // f(u_{i - 1}). - double f_ui_x = ~a; // f(u_i). - double f_up_x = ~a; // f(u_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * alpha_x * (u_i - u_{i - 1}). - double fluxL_x = 0.5 * (f_um_x + f_ui_x) - 0.5 * alpha_x * (ui_x - um_x); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * alpha_x * (u_{i + 1} - u_i). - double fluxR_x = 0.5 * (f_ui_x + f_up_x) - 0.5 * alpha_x * (up_x - ui_x); - - // Update the conserved variable. - un[i][j] = ui_x - (dt / dx) * (fluxR_x - fluxL_x); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_y = u[i][j - 1]; - double ui_y = u[i][j]; - double up_y = u[i][j + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um_y = ~a; // f(u_{j - 1}). - double f_ui_y = ~a; // f(u_j). - double f_up_y = ~a; // f(u_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * alpha_y * (u_j - u_{j - 1}). - double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * alpha_y * (ui_y - um_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * alpha_y * (u_{j + 1} - u_j). - double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * alpha_y * (up_y - ui_y); - - // Update the conserved variable. - un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - free(un[i]); - } - free(u); - free(un); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). - flux-um-y - flux-ui-y - flux-up-y - ;; Left, middle, right fluxes in x-direction f(u_{i - 1}), f(u_i), f(u_{i + 1}). - flux-um-x - flux-ui-x - flux-up-x - ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). - flux-um-y - flux-ui-y - flux-up-y - ;; PDE name for file output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------------- -;; Lax–Friedrichs (Finite-Difference) Solver for a 2D Scalar PDE with a Second-Order Flux Extrapolation -;; ---------------------------------------------------------------------------------------------------- -(define (generate-lax-friedrichs-scalar-2d-second-order pde limiter - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that solves the 2D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method with a second-order flux extrapolation using flux limiter `limiter`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define cons-code (convert-expr cons-expr)) - (define flux-code-x (convert-expr flux-expr-x)) - (define flux-code-y (convert-expr flux-expr-y)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umL-x (flux-substitute flux-code-x cons-code "umL_x")) - (define flux-umR-x (flux-substitute flux-code-x cons-code "umR_x")) - (define flux-uiL-x (flux-substitute flux-code-x cons-code "uiL_x")) - (define flux-uiR-x (flux-substitute flux-code-x cons-code "uiR_x")) - (define flux-upL-x (flux-substitute flux-code-x cons-code "upL_x")) - (define flux-upR-x (flux-substitute flux-code-x cons-code "upR_x")) - - (define flux-umR-evol-x (flux-substitute flux-code-x cons-code "umR_evol_x")) - (define flux-uiL-evol-x (flux-substitute flux-code-x cons-code "uiL_evol_x")) - (define flux-uiR-evol-x (flux-substitute flux-code-x cons-code "uiR_evol_x")) - (define flux-upL-evol-x (flux-substitute flux-code-x cons-code "upL_evol_x")) - - (define flux-umL-y (flux-substitute flux-code-y cons-code "umL_y")) - (define flux-umR-y (flux-substitute flux-code-y cons-code "umR_y")) - (define flux-uiL-y (flux-substitute flux-code-y cons-code "uiL_y")) - (define flux-uiR-y (flux-substitute flux-code-y cons-code "uiR_y")) - (define flux-upL-y (flux-substitute flux-code-y cons-code "upL_y")) - (define flux-upR-y (flux-substitute flux-code-y cons-code "upR_y")) - - (define flux-umR-evol-y (flux-substitute flux-code-y cons-code "umR_evol_y")) - (define flux-uiL-evol-y (flux-substitute flux-code-y cons-code "uiL_evol_y")) - (define flux-uiR-evol-y (flux-substitute flux-code-y cons-code "uiR_evol_y")) - (define flux-upL-evol-y (flux-substitute flux-code-y cons-code "upL_evol_y")) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Lax–Friedrichs first-order finite-difference solver for a scalar PDE in 2D, with a second-order flux extrapolation. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing slopes. - double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); - double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - slope_x[i] = (double*) malloc((ny + 4) * sizeof(double)); - slope_y[i] = (double*) malloc((ny + 4) * sizeof(double)); - } - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - double **un = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * sizeof(double)); - un[i] = (double*) malloc((ny + 4) * sizeof(double)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][j] = ~a; // init-func in C. - un[i][j] = ~a; // init-func in C. - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); - } - } - - // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); - double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); - - double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); - double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); - - double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); - double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_y = ~a; - double f_umR_y = ~a; - - double f_uiL_y = ~a; - double f_uiR_y = ~a; - - double f_upL_y = ~a; - double f_upR_y = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); - - double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - - double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_y = ~a; - double f_uiL_evol_y = ~a; - - double f_uiR_evol_y = ~a; - double f_upL_evol_y = ~a; - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * alpha * (u_{j, L+} - u_{j - 1, R+}). - double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * alpha_y * (uiL_evol_y - umR_evol_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * alpha * (u_{j + 1, L+} - u_{j, R+}). - double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * alpha_y * (upL_evol_y - uiR_evol_y); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i - 1][j]) / (u[i + 1][j] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_x[i][j] = limiter * (0.5 * ((u[i][j] - u[i - 1][j]) + (u[i + 1][j] - u[i][j]))); - } - } - - // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the x-direction. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_x = u[i - 1][j] - (0.5 * slope_x[i - 1][j]); - double umR_x = u[i - 1][j] + (0.5 * slope_x[i - 1][j]); - - double uiL_x = u[i][j] - (0.5 * slope_x[i][j]); - double uiR_x = u[i][j] + (0.5 * slope_x[i][j]); - - double upL_x = u[i + 1][j] - (0.5 * slope_x[i + 1][j]); - double upR_x = u[i + 1][j] + (0.5 * slope_x[i + 1][j]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_x = ~a; - double f_umR_x = ~a; - - double f_uiL_x = ~a; - double f_uiR_x = ~a; - - double f_upL_x = ~a; - double f_upR_x = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_x = umR_x + ((dt / (2.0 * dx)) * (f_umL_x - f_umR_x)); - - double uiL_evol_x = uiL_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); - double uiR_evol_x = uiR_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); - - double upL_evol_x = upL_x + ((dt / (2.0 * dx)) * (f_upL_x - f_upR_x)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_x = ~a; - double f_uiL_evol_x = ~a; - - double f_uiR_evol_x = ~a; - double f_upL_evol_x = ~a; - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * alpha * (u_{i, L+} - u_{i - 1, R+}). - double fluxL_x = 0.5 * (f_umR_evol_x + f_uiL_evol_x) - 0.5 * alpha_x * (uiL_evol_x - umR_evol_x); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * alpha * (u_{i + 1, L+} - u_{i, R+}). - double fluxR_x = 0.5 * (f_uiR_evol_x + f_upL_evol_x) - 0.5 * alpha_x * (upL_evol_x - uiR_evol_x); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / dx) * (fluxR_x - fluxL_x); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); - } - } - - // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); - double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); - - double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); - double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); - - double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); - double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_y = ~a; - double f_umR_y = ~a; - - double f_uiL_y = ~a; - double f_uiR_y = ~a; - - double f_upL_y = ~a; - double f_upR_y = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); - - double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - - double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_y = ~a; - double f_uiL_evol_y = ~a; - - double f_uiR_evol_y = ~a; - double f_upL_evol_y = ~a; - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * alpha * (u_{j, L+} - u_{j - 1, R+}). - double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * alpha_y * (uiL_evol_y - umR_evol_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * alpha * (u_{j + 1, L+} - u_{j, R+}). - double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * alpha_y * (upL_evol_y - uiR_evol_y); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - free(un[i]); - free(slope_x[i]); - free(slope_y[i]); - } - free(u); - free(un); - free(slope_x); - free(slope_y); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). - flux-umL-y - flux-umR-y - ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). - flux-uiL-y - flux-uiR-y - ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). - flux-upL-y - flux-upR-y - ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). - flux-umR-evol-y - ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). - flux-uiL-evol-y - flux-uiR-evol-y - ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). - flux-upL-evol-y - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in x-direction f(u_{i - 1, L}), f(u_{i - 1, R}). - flux-umL-x - flux-umR-x - ;; Left/right central fluxes in x-direction f(u_{i, L}), f(u_{i, R}). - flux-uiL-x - flux-uiR-x - ;; Left/right positive fluxes in x-direction f(u_{i + 1, L}), f(u_{i + 1, R}). - flux-upL-x - flux-upR-x - ;; Evolved right negative flux in x-direction f(u_{i - 1, R+}). - flux-umR-evol-x - ;; Evolved left/right central fluxes in x-direction f(u_{i, L+}), f(u_{i, R+}). - flux-uiL-evol-x - flux-uiR-evol-x - ;; Evolved left positive flux in x-direction f(u_{i + 1, L+}). - flux-upL-evol-x - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). - flux-umL-y - flux-umR-y - ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). - flux-uiL-y - flux-uiR-y - ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). - flux-upL-y - flux-upR-y - ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). - flux-umR-evol-y - ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). - flux-uiL-evol-y - flux-uiR-evol-y - ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). - flux-upL-evol-y - ;; PDE name for file output. - name - name - )) - code) - -;; ---------------------------------------------- -;; Roe (Finite-Volume) Solver for a 2D Scalar PDE -;; ---------------------------------------------- -(define (generate-roe-scalar-2d pde - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that solves the 2D scalar PDE specified by `pde` using the Roe finite-volume method. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) - (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) - - (define cons-code (convert-expr cons-expr)) - (define flux-code-x (convert-expr flux-expr-x)) - (define flux-code-y (convert-expr flux-expr-y)) - (define flux-deriv-code-x (convert-expr flux-deriv-x)) - (define flux-deriv-code-y (convert-expr flux-deriv-y)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define flux-um-x (flux-substitute flux-code-x cons-code "um_x")) - (define flux-ui-x (flux-substitute flux-code-x cons-code "ui_x")) - (define flux-up-x (flux-substitute flux-code-x cons-code "up_x")) - - (define flux-um-y (flux-substitute flux-code-y cons-code "um_y")) - (define flux-ui-y (flux-substitute flux-code-y cons-code "ui_y")) - (define flux-up-y (flux-substitute flux-code-y cons-code "up_y")) - - (define flux-deriv-um-x (flux-substitute flux-deriv-code-x cons-code "um_x")) - (define flux-deriv-ui-x (flux-substitute flux-deriv-code-x cons-code "ui_x")) - (define flux-deriv-up-x (flux-substitute flux-deriv-code-x cons-code "up_x")) - - (define flux-deriv-um-y (flux-substitute flux-deriv-code-y cons-code "um_y")) - (define flux-deriv-ui-y (flux-substitute flux-deriv-code-y cons-code "ui_y")) - (define flux-deriv-up-y (flux-substitute flux-deriv-code-y cons-code "up_y")) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR SCALAR PDE: ~a -// Roe higher-order finite-volume solver for a scalar PDE in 2D. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - double **un = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * sizeof(double)); - un[i] = (double*) malloc((ny + 2) * sizeof(double)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][j] = ~a; // init-func in C. - un[i][j] = ~a; // init-func in C. - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Roe approximation and update the conserved variable in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_y = u[i][j - 1]; - double ui_y = u[i][j]; - double up_y = u[i][j + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um_y = ~a; // f(u_{j - 1}). - double f_ui_y = ~a; // f(u_j). - double f_up_y = ~a; // f(u_{j + 1}). - - // Evaluate flux derivative for each value of the conserved variable. - double f_deriv_um_y = ~a; // f'(u_{j - 1}). - double f_deriv_ui_y = ~a; // f'(u_j). - double f_deriv_up_y = ~a; // f'(u_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * |aL_roe_y| * (u_j - u_{j - 1}). - double aL_roe_y = 0.5 * (f_deriv_um_y + f_deriv_ui_y); - double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * fabs(aL_roe_y) * (ui_y - um_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * |aR_roe_y| * (u_{j + 1} - u_j). - double aR_roe_y = 0.5 * (f_deriv_ui_y + f_deriv_up_y); - double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * fabs(aR_roe_y) * (up_y - ui_y); - - // Update the conserved variable. - un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Compute fluxes with Roe approximation and update the conserved variable in the x-direction. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_x = u[i - 1][j]; - double ui_x = u[i][j]; - double up_x = u[i + 1][j]; - - // Evaluate flux for each value of the conserved variable. - double f_um_x = ~a; // f(u_{i - 1}). - double f_ui_x = ~a; // f(u_i). - double f_up_x = ~a; // f(u_{i + 1}). - - // Evaluate flux derivative for each value of the conserved variable. - double f_deriv_um_x = ~a; // f'(u_{i - 1}). - double f_deriv_ui_x = ~a; // f'(u_i). - double f_deriv_up_x = ~a; // f'(u_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * |aL_roe_x| * (u_i - u_{i - 1}). - double aL_roe_x = 0.5 * (f_deriv_um_x + f_deriv_ui_x); - double fluxL_x = 0.5 * (f_um_x + f_ui_x) - 0.5 * fabs(aL_roe_x) * (ui_x - um_x); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * |aR_roe_x| * (u_{i + 1} - u_i). - double aR_roe_x = 0.5 * (f_deriv_ui_x + f_deriv_up_x); - double fluxR_x = 0.5 * (f_ui_x + f_up_x) - 0.5 * fabs(aR_roe_x) * (up_x - ui_x); - - // Update the conserved variable. - un[i][j] = ui_x - (dt / dx) * (fluxR_x - fluxL_x); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Compute fluxes with Roe approximation and update the conserved variable in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_y = u[i][j - 1]; - double ui_y = u[i][j]; - double up_y = u[i][j + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um_y = ~a; // f(u_{j - 1}). - double f_ui_y = ~a; // f(u_j). - double f_up_y = ~a; // f(u_{j + 1}). - - // Evaluate flux derivative for each value of the conserved variable. - double f_deriv_um_y = ~a; // f'(u_{j - 1}). - double f_deriv_ui_y = ~a; // f'(u_j). - double f_deriv_up_y = ~a; // f'(u_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * |aL_roe_y| * (u_j - u_{j - 1}). - double aL_roe_y = 0.5 * (f_deriv_um_y + f_deriv_ui_y); - double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * fabs(aL_roe_y) * (ui_y - um_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * |aR_roe_y| * (u_{j + 1} - u_j). - double aR_roe_y = 0.5 * (f_deriv_ui_y + f_deriv_up_y); - double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * fabs(aR_roe_y) * (up_y - ui_y); - - // Update the conserved variable. - un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - free(un[i]); - } - free(u); - free(un); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). - flux-um-y - flux-ui-y - flux-up-y - ;; Left, middle, right flux derivatives in y-direction f'(u_{j - 1}), f'(u_j), f'(u_{j + 1}). - flux-deriv-um-y - flux-deriv-ui-y - flux-deriv-up-y - ;; Left, middle, right fluxes in x-direction f(u_{i - 1}), f(u_i), f(u_{i + 1}). - flux-um-x - flux-ui-x - flux-up-x - ;; Left, middle, right flux derivatives in x-direction f'(u_{i - 1}), f'(u_i), f'(u_{i + 1}). - flux-deriv-um-x - flux-deriv-ui-x - flux-deriv-up-x - ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). - flux-um-y - flux-ui-y - flux-up-y - ;; Left, middle, right flux derivatives in y-direction f'(u_{j - 1}), f'(u_j), f'(u_{j + 1}). - flux-deriv-um-y - flux-deriv-ui-y - flux-deriv-up-y - ;; PDE name for file output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------- -;; Roe (Finite-Volume) Solver for a 2D Scalar PDE with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------- -(define (generate-roe-scalar-2d-second-order pde limiter - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that solves the 2D scalar PDE specified by `pde` using the Roe finite-volume method with a second-order flux extrapolation using flux limiter `limiter`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) - (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) - - (define cons-code (convert-expr cons-expr)) - (define flux-code-x (convert-expr flux-expr-x)) - (define flux-code-y (convert-expr flux-expr-y)) - (define flux-deriv-code-x (convert-expr flux-deriv-x)) - (define flux-deriv-code-y (convert-expr flux-deriv-y)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umL-x (flux-substitute flux-code-x cons-code "umL_x")) - (define flux-umR-x (flux-substitute flux-code-x cons-code "umR_x")) - (define flux-uiL-x (flux-substitute flux-code-x cons-code "uiL_x")) - (define flux-uiR-x (flux-substitute flux-code-x cons-code "uiR_x")) - (define flux-upL-x (flux-substitute flux-code-x cons-code "upL_x")) - (define flux-upR-x (flux-substitute flux-code-x cons-code "upR_x")) - - (define flux-umR-evol-x (flux-substitute flux-code-x cons-code "umR_evol_x")) - (define flux-uiL-evol-x (flux-substitute flux-code-x cons-code "uiL_evol_x")) - (define flux-uiR-evol-x (flux-substitute flux-code-x cons-code "uiR_evol_x")) - (define flux-upL-evol-x (flux-substitute flux-code-x cons-code "upL_evol_x")) - - (define flux-deriv-umR-evol-x (flux-substitute flux-deriv-code-x cons-code "umR_evol_x")) - (define flux-deriv-uiL-evol-x (flux-substitute flux-deriv-code-x cons-code "uiL_evol_x")) - (define flux-deriv-uiR-evol-x (flux-substitute flux-deriv-code-x cons-code "uiR_evol_x")) - (define flux-deriv-upL-evol-x (flux-substitute flux-deriv-code-x cons-code "upL_evol_x")) - - (define flux-umL-y (flux-substitute flux-code-y cons-code "umL_y")) - (define flux-umR-y (flux-substitute flux-code-y cons-code "umR_y")) - (define flux-uiL-y (flux-substitute flux-code-y cons-code "uiL_y")) - (define flux-uiR-y (flux-substitute flux-code-y cons-code "uiR_y")) - (define flux-upL-y (flux-substitute flux-code-y cons-code "upL_y")) - (define flux-upR-y (flux-substitute flux-code-y cons-code "upR_y")) - - (define flux-umR-evol-y (flux-substitute flux-code-y cons-code "umR_evol_y")) - (define flux-uiL-evol-y (flux-substitute flux-code-y cons-code "uiL_evol_y")) - (define flux-uiR-evol-y (flux-substitute flux-code-y cons-code "uiR_evol_y")) - (define flux-upL-evol-y (flux-substitute flux-code-y cons-code "upL_evol_y")) - - (define flux-deriv-umR-evol-y (flux-substitute flux-deriv-code-y cons-code "umR_evol_y")) - (define flux-deriv-uiL-evol-y (flux-substitute flux-deriv-code-y cons-code "uiL_evol_y")) - (define flux-deriv-uiR-evol-y (flux-substitute flux-deriv-code-y cons-code "uiR_evol_y")) - (define flux-deriv-upL-evol-y (flux-substitute flux-deriv-code-y cons-code "upL_evol_y")) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Roe higher-order finite-volume solver for a scalar PDE in 2D, with a second-order flux extrapolation. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing slopes. - double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); - double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - slope_x[i] = (double*) malloc((ny + 4) * sizeof(double)); - slope_y[i] = (double*) malloc((ny + 4) * sizeof(double)); - } - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - double **un = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * sizeof(double)); - un[i] = (double*) malloc((ny + 4) * sizeof(double)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][j] = ~a; // init-func in C. - un[i][j] = ~a; // init-func in C. - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); - } - } - - // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); - double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); - - double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); - double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); - - double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); - double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_y = ~a; - double f_umR_y = ~a; - - double f_uiL_y = ~a; - double f_uiR_y = ~a; - - double f_upL_y = ~a; - double f_upR_y = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); - - double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - - double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_y = ~a; - double f_uiL_evol_y = ~a; - - double f_uiR_evol_y = ~a; - double f_upL_evol_y = ~a; - - // Evaluate flux derivative for each value of the (evolved) conserved variable. - double f_deriv_umR_evol_y = ~a; - double f_deriv_uiL_evol_y = ~a; - - double f_deriv_uiR_evol_y = ~a; - double f_deriv_upL_evol_y = ~a; - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * |aL_roe_y| * (u_{j, L+} - u_{j - 1, R+}). - double aL_roe_y = 0.5 * (f_deriv_umR_evol_y + f_deriv_uiL_evol_y); - double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * fabs(aL_roe_y) * (uiL_evol_y - umR_evol_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * |aR_roe_y| * (u_{j + 1, L+} - u_{j, R+}). - double aR_roe_y = 0.5 * (f_deriv_uiR_evol_y + f_deriv_upL_evol_y); - double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * fabs(aR_roe_y) * (upL_evol_y - uiR_evol_y); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i - 1][j]) / (u[i + 1][j] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_x[i][j] = limiter * (0.5 * ((u[i][j] - u[i - 1][j]) + (u[i + 1][j] - u[i][j]))); - } - } - - // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the x-direction. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_x = u[i - 1][j] - (0.5 * slope_x[i - 1][j]); - double umR_x = u[i - 1][j] + (0.5 * slope_x[i - 1][j]); - - double uiL_x = u[i][j] - (0.5 * slope_x[i][j]); - double uiR_x = u[i][j] + (0.5 * slope_x[i][j]); - - double upL_x = u[i + 1][j] - (0.5 * slope_x[i + 1][j]); - double upR_x = u[i + 1][j] + (0.5 * slope_x[i + 1][j]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_x = ~a; - double f_umR_x = ~a; - - double f_uiL_x = ~a; - double f_uiR_x = ~a; - - double f_upL_x = ~a; - double f_upR_x = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_x = umR_x + ((dt / (2.0 * dx)) * (f_umL_x - f_umR_x)); - - double uiL_evol_x = uiL_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); - double uiR_evol_x = uiR_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); - - double upL_evol_x = upL_x + ((dt / (2.0 * dx)) * (f_upL_x - f_upR_x)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_x = ~a; - double f_uiL_evol_x = ~a; - - double f_uiR_evol_x = ~a; - double f_upL_evol_x = ~a; - - // Evaluate flux derivative for each value of the (evolved) conserved variable. - double f_deriv_umR_evol_x = ~a; - double f_deriv_uiL_evol_x = ~a; - - double f_deriv_uiR_evol_x = ~a; - double f_deriv_upL_evol_x = ~a; - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * |aL_roe_x| * (u_{i, L+} - u_{i - 1, R+}). - double aL_roe_x = 0.5 * (f_deriv_umR_evol_x + f_deriv_uiL_evol_x); - double fluxL_x = 0.5 * (f_umR_evol_x + f_uiL_evol_x) - 0.5 * fabs(aL_roe_x) * (uiL_evol_x - umR_evol_x); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * |aR_roe_x| * (u_{i + 1, L+} - u_{i, R+}). - double aR_roe_x = 0.5 * (f_deriv_uiR_evol_x + f_deriv_upL_evol_x); - double fluxR_x = 0.5 * (f_uiR_evol_x + f_upL_evol_x) - 0.5 * fabs(aR_roe_x) * (upL_evol_x - uiR_evol_x); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / dx) * (fluxR_x - fluxL_x); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); - } - } - - // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); - double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); - - double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); - double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); - - double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); - double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_y = ~a; - double f_umR_y = ~a; - - double f_uiL_y = ~a; - double f_uiR_y = ~a; - - double f_upL_y = ~a; - double f_upR_y = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); - - double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - - double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_y = ~a; - double f_uiL_evol_y = ~a; - - double f_uiR_evol_y = ~a; - double f_upL_evol_y = ~a; - - // Evaluate flux derivative for each value of the (evolved) conserved variable. - double f_deriv_umR_evol_y = ~a; - double f_deriv_uiL_evol_y = ~a; - - double f_deriv_uiR_evol_y = ~a; - double f_deriv_upL_evol_y = ~a; - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * |aL_roe_y| * (u_{j, L+} - u_{j - 1, R+}). - double aL_roe_y = 0.5 * (f_deriv_umR_evol_y + f_deriv_uiL_evol_y); - double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * fabs(aL_roe_y) * (uiL_evol_y - umR_evol_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * |aR_roe_y| * (u_{j + 1, L+} - u_{j, R+}). - double aR_roe_y = 0.5 * (f_deriv_uiR_evol_y + f_deriv_upL_evol_y); - double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * fabs(aR_roe_y) * (upL_evol_y - uiR_evol_y); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - free(un[i]); - free(slope_x[i]); - free(slope_y[i]); - } - free(u); - free(un); - free(slope_x); - free(slope_y); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). - flux-umL-y - flux-umR-y - ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). - flux-uiL-y - flux-uiR-y - ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). - flux-upL-y - flux-upR-y - ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). - flux-umR-evol-y - ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). - flux-uiL-evol-y - flux-uiR-evol-y - ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). - flux-upL-evol-y - ;; Evolved right negative flux derivative in y-direction f'(u_{j - 1, R+}). - flux-deriv-umR-evol-y - ;; Evolved left/right central flux derivatives in y-direction f'(u_{j, L+}), f(u_{j, R+}). - flux-deriv-uiL-evol-y - flux-deriv-uiR-evol-y - ;; Evolved left positive flux derivative in y-direction f'(u_{j + 1, L+}). - flux-deriv-upL-evol-y - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in x-direction f(u_{i - 1, L}), f(u_{i - 1, R}). - flux-umL-x - flux-umR-x - ;; Left/right central fluxes in x-direction f(u_{i, L}), f(u_{i, R}). - flux-uiL-x - flux-uiR-x - ;; Left/right positive fluxes in x-direction f(u_{i + 1, L}), f(u_{i + 1, R}). - flux-upL-x - flux-upR-x - ;; Evolved right negative flux in x-direction f(u_{i - 1, R+}). - flux-umR-evol-x - ;; Evolved left/right central fluxes in x-direction f(u_{i, L+}), f(u_{i, R+}). - flux-uiL-evol-x - flux-uiR-evol-x - ;; Evolved left positive flux in x-direction f(u_{i + 1, L+}). - flux-upL-evol-x - ;; Evolved right negative flux derivative in x-direction f'(u_{i - 1, R+}). - flux-deriv-umR-evol-x - ;; Evolved left/right central flux derivatives in x-direction f'(u_{i, L+}), f(u_{i, R+}). - flux-deriv-uiL-evol-x - flux-deriv-uiR-evol-x - ;; Evolved left positive flux derivative in x-direction f'(u_{i + 1, L+}). - flux-deriv-upL-evol-x - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). - flux-umL-y - flux-umR-y - ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). - flux-uiL-y - flux-uiR-y - ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). - flux-upL-y - flux-upR-y - ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). - flux-umR-evol-y - ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). - flux-uiL-evol-y - flux-uiR-evol-y - ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). - flux-upL-evol-y - ;; Evolved right negative flux derivative in y-direction f'(u_{j - 1, R+}). - flux-deriv-umR-evol-y - ;; Evolved left/right central flux derivatives in y-direction f'(u_{j, L+}), f(u_{j, R+}). - flux-deriv-uiL-evol-y - flux-deriv-uiR-evol-y - ;; Evolved left positive flux derivative in y-direction f'(u_{j + 1, L+}). - flux-deriv-upL-evol-y - ;; PDE name for file output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/code_generator_vector_2d.rkt b/provable-algorithms/finite_volume/code_generator_vector_2d.rkt deleted file mode 100644 index 653c14b7..00000000 --- a/provable-algorithms/finite_volume/code_generator_vector_2d.rkt +++ /dev/null @@ -1,3281 +0,0 @@ -#lang racket - -(require "prover_core.rkt") -(require "prover_vector.rkt") -(require "code_generator_core.rkt") -(provide generate-lax-friedrichs-vector3-2d - generate-lax-friedrichs-vector3-2d-second-order - generate-roe-vector3-2d - generate-roe-vector3-2d-second-order) - -;; ---------------------------------------------------------------------------------- -;; Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs -;; ---------------------------------------------------------------------------------- -(define (generate-lax-friedrichs-vector3-2d pde-system - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") - (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-codes-x)) - (define flux-uis-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") - (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-codes-x)) - (define flux-ups-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") - (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-codes-x)) - - (define flux-ums-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") - (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-codes-y)) - (define flux-uis-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") - (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-codes-y)) - (define flux-ups-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") - (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a -// Lax–Friedrichs first-order finite-difference solver for a coupled vector system of 3 PDEs in 2D. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - double **un = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); - un[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - double *um_x = (double*) malloc(3 * sizeof(double)); - double *ui_x = (double*) malloc(3 * sizeof(double)); - double *up_x = (double*) malloc(3 * sizeof(double)); - - double *f_um_x = (double*) malloc(3 * sizeof(double)); - double *f_ui_x = (double*) malloc(3 * sizeof(double)); - double *f_up_x = (double*) malloc(3 * sizeof(double)); - - double *fluxL_x = (double*) malloc(3 * sizeof(double)); - double *fluxR_x = (double*) malloc(3 * sizeof(double)); - - double *um_y = (double*) malloc(3 * sizeof(double)); - double *ui_y = (double*) malloc(3 * sizeof(double)); - double *up_y = (double*) malloc(3 * sizeof(double)); - - double *f_um_y = (double*) malloc(3 * sizeof(double)); - double *f_ui_y = (double*) malloc(3 * sizeof(double)); - double *f_up_y = (double*) malloc(3 * sizeof(double)); - - double *fluxL_y = (double*) malloc(3 * sizeof(double)); - double *fluxR_y = (double*) malloc(3 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - - un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_y[k] = u[i][((j - 1) * 3) + k]; - ui_y[k] = u[i][(j * 3) + k]; - up_y[k] = u[i][((j + 1) * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; // F(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_x[k] = u[i - 1][(j * 3) + k]; - ui_x[k] = u[i][(j * 3) + k]; - up_x[k] = u[i + 1][(j * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_x[0] = ~a; - f_um_x[1] = ~a; - f_um_x[2] = ~a; // F(U_{i - 1}). - - f_ui_x[0] = ~a; - f_ui_x[1] = ~a; - f_ui_x[2] = ~a; // F(U_i). - - f_up_x[0] = ~a; - f_up_x[1] = ~a; - f_up_x[2] = ~a; // F(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha_x * (U_i - U_{i - 1}). - for (int k = 0; k < 3; k++) { - fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * alpha_x * (ui_x[k] - um_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha_x * (U_{i + 1} - U_i). - for (int k = 0; k < 3; k++) { - fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * alpha_x * (up_x[k] - ui_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_y[k] = u[i][((j - 1) * 3) + k]; - ui_y[k] = u[i][(j * 3) + k]; - up_y[k] = u[i][((j + 1) * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; // F(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - free(un[i]); - } - free(u); - free(un); - - free(local_alpha_x); - free(local_alpha_y); - - free(um_x); - free(ui_x); - free(up_x); - - free(f_um_x); - free(f_ui_x); - free(f_up_x); - - free(fluxL_x); - free(fluxR_x); - - free(um_y); - free(ui_y); - free(up_y); - - free(f_um_y); - free(f_ui_y); - free(f_up_y); - - free(fluxL_y); - free(fluxR_y); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). - (list-ref flux-ums-x 0) - (list-ref flux-ums-x 1) - (list-ref flux-ums-x 2) - (list-ref flux-uis-x 0) - (list-ref flux-uis-x 1) - (list-ref flux-uis-x 2) - (list-ref flux-ups-x 0) - (list-ref flux-ups-x 1) - (list-ref flux-ups-x 2) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - ;; PDE name for file output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------------------------------------- -;; Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------------------------------------------- -(define (generate-lax-friedrichs-vector3-2d-second-order pde-system limiter - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that solves the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method with a - second-order flux extrapolation using flux limiter `limiter`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") - (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]")) flux-codes-x)) - (define flux-umRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_x[0]") - (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]")) flux-codes-x)) - (define flux-uiLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") - (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]")) flux-codes-x)) - (define flux-uiRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") - (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]")) flux-codes-x)) - (define flux-upLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") - (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]")) flux-codes-x)) - (define flux-upRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") - (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]")) flux-codes-x)) - - (define flux-umR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") - (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-codes-x)) - (define flux-uiL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") - (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-codes-x)) - (define flux-uiR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") - (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-codes-x)) - (define flux-upL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") - (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-codes-x)) - - (define flux-umLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") - (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]")) flux-codes-y)) - (define flux-umRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") - (list-ref cons-codes 1) "umR_y[1]") (list-ref cons-codes 2) "umR_y[2]")) flux-codes-y)) - (define flux-uiLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") - (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]")) flux-codes-y)) - (define flux-uiRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") - (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]")) flux-codes-y)) - (define flux-upLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") - (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]")) flux-codes-y)) - (define flux-upRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") - (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]")) flux-codes-y)) - - (define flux-umR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") - (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-codes-y)) - (define flux-uiL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") - (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-codes-y)) - (define flux-uiR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") - (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-codes-y)) - (define flux-upL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") - (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Lax–Friedrichs first-order finite-difference solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing slopes. - double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); - double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - slope_x[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - slope_y[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - } - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - double **un = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - un[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - double *umL_x = (double*) malloc(3 * sizeof(double)); - double *umR_x = (double*) malloc(3 * sizeof(double)); - double *uiL_x = (double*) malloc(3 * sizeof(double)); - double *uiR_x = (double*) malloc(3 * sizeof(double)); - double *upL_x = (double*) malloc(3 * sizeof(double)); - double *upR_x = (double*) malloc(3 * sizeof(double)); - - double *f_umL_x = (double*) malloc(3 * sizeof(double)); - double *f_umR_x = (double*) malloc(3 * sizeof(double)); - double *f_uiL_x = (double*) malloc(3 * sizeof(double)); - double *f_uiR_x = (double*) malloc(3 * sizeof(double)); - double *f_upL_x = (double*) malloc(3 * sizeof(double)); - double *f_upR_x = (double*) malloc(3 * sizeof(double)); - - double *umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *f_umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *fluxL_x = (double*) malloc(3 * sizeof(double)); - double *fluxR_x = (double*) malloc(3 * sizeof(double)); - - double *umL_y = (double*) malloc(3 * sizeof(double)); - double *umR_y = (double*) malloc(3 * sizeof(double)); - double *uiL_y = (double*) malloc(3 * sizeof(double)); - double *uiR_y = (double*) malloc(3 * sizeof(double)); - double *upL_y = (double*) malloc(3 * sizeof(double)); - double *upR_y = (double*) malloc(3 * sizeof(double)); - - double *f_umL_y = (double*) malloc(3 * sizeof(double)); - double *f_umR_y = (double*) malloc(3 * sizeof(double)); - double *f_uiL_y = (double*) malloc(3 * sizeof(double)); - double *f_uiR_y = (double*) malloc(3 * sizeof(double)); - double *f_upL_y = (double*) malloc(3 * sizeof(double)); - double *f_upR_y = (double*) malloc(3 * sizeof(double)); - - double *umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *f_umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *fluxL_y = (double*) malloc(3 * sizeof(double)); - double *fluxR_y = (double*) malloc(3 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - - un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); - umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); - - uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); - uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); - - upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); - upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) / (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_x[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) + (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_x[k] = u[i - 1][(j * 3) + k] - (0.5 * slope_x[i - 1][(j * 3) + k]); - umR_x[k] = u[i - 1][(j * 3) + k] + (0.5 * slope_x[i - 1][(j * 3) + k]); - - uiL_x[k] = u[i][(j * 3) + k] - (0.5 * slope_x[i][(j * 3) + k]); - uiR_x[k] = u[i][(j * 3) + k] + (0.5 * slope_x[i][(j * 3) + k]); - - upL_x[k] = u[i + 1][(j * 3) + k] - (0.5 * slope_x[i + 1][(j * 3) + k]); - upR_x[k] = u[i + 1][(j * 3) + k] + (0.5 * slope_x[i + 1][(j * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_x[0] = ~a; - f_umL_x[1] = ~a; - f_umL_x[2] = ~a; - f_umR_x[0] = ~a; - f_umR_x[1] = ~a; - f_umR_x[2] = ~a; - - f_uiL_x[0] = ~a; - f_uiL_x[1] = ~a; - f_uiL_x[2] = ~a; - f_uiR_x[0] = ~a; - f_uiR_x[1] = ~a; - f_uiR_x[2] = ~a; - - f_upL_x[0] = ~a; - f_upL_x[1] = ~a; - f_upL_x[2] = ~a; - f_upR_x[0] = ~a; - f_upR_x[1] = ~a; - f_upR_x[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); - - uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - - upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_x[0] = ~a; - f_umR_evol_x[1] = ~a; - f_umR_evol_x[2] = ~a; // F(U_{i - 1, R+}) - f_uiL_evol_x[0] = ~a; - f_uiL_evol_x[1] = ~a; - f_uiL_evol_x[2] = ~a; // F(U_{i, L+}) - - f_uiR_evol_x[0] = ~a; - f_uiR_evol_x[1] = ~a; - f_uiR_evol_x[2] = ~a; // F(U_{i, R+}) - f_upL_evol_x[0] = ~a; - f_upL_evol_x[1] = ~a; - f_upL_evol_x[2] = ~a; // F(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha_x * (U_{i, L+} - U_{i - 1, R+}). - for (int k = 0; k < 3; k++) { - fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * alpha_x * (uiL_evol_x[k] - umR_evol_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha_x * (U_{i + 1, L+} - U_{i, R+}). - for (int k = 0; k < 3; k++) { - fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * alpha_x * (upL_evol_x[k] - uiR_evol_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); - umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); - - uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); - uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); - - upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); - upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - free(un[i]); - free(slope_x[i]); - free(slope_y[i]); - } - free(u); - free(un); - free(slope_x); - free(slope_y); - - free(local_alpha_x); - free(local_alpha_y); - - free(umL_x); - free(umR_x); - free(uiL_x); - free(uiR_x); - free(upL_x); - free(upR_x); - - free(f_umL_x); - free(f_umR_x); - free(f_uiL_x); - free(f_uiR_x); - free(f_upL_x); - free(f_upR_x); - - free(umR_evol_x); - free(uiL_evol_x); - free(uiR_evol_x); - free(upL_evol_x); - - free(f_umR_evol_x); - free(f_uiL_evol_x); - free(f_uiR_evol_x); - free(f_upL_evol_x); - - free(fluxL_x); - free(fluxR_x); - - free(umL_y); - free(umR_y); - free(uiL_y); - free(uiR_y); - free(upL_y); - free(upR_y); - - free(f_umL_y); - free(f_umR_y); - free(f_uiL_y); - free(f_uiR_y); - free(f_upL_y); - free(f_upR_y); - - free(umR_evol_y); - free(uiL_evol_y); - free(uiR_evol_y); - free(upL_evol_y); - - free(f_umR_evol_y); - free(f_uiL_evol_y); - free(f_uiR_evol_y); - free(f_upL_evol_y); - - free(fluxL_y); - free(fluxR_y); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). - (list-ref flux-umLs-x 0) - (list-ref flux-umLs-x 1) - (list-ref flux-umLs-x 2) - (list-ref flux-umRs-x 0) - (list-ref flux-umRs-x 1) - (list-ref flux-umRs-x 2) - ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). - (list-ref flux-uiLs-x 0) - (list-ref flux-uiLs-x 1) - (list-ref flux-uiLs-x 2) - (list-ref flux-uiRs-x 0) - (list-ref flux-uiRs-x 1) - (list-ref flux-uiRs-x 2) - ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). - (list-ref flux-upLs-x 0) - (list-ref flux-upLs-x 1) - (list-ref flux-upLs-x 2) - (list-ref flux-upRs-x 0) - (list-ref flux-upRs-x 1) - (list-ref flux-upRs-x 2) - ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). - (list-ref flux-umR-evols-x 0) - (list-ref flux-umR-evols-x 1) - (list-ref flux-umR-evols-x 2) - (list-ref flux-uiL-evols-x 0) - (list-ref flux-uiL-evols-x 1) - (list-ref flux-uiL-evols-x 2) - ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). - (list-ref flux-uiR-evols-x 0) - (list-ref flux-uiR-evols-x 1) - (list-ref flux-uiR-evols-x 2) - (list-ref flux-upL-evols-x 0) - (list-ref flux-upL-evols-x 1) - (list-ref flux-upL-evols-x 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - ;; PDE name for file output. - name - name - )) - code) - -;; ------------------------------------------------------------------- -;; Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs -;; ------------------------------------------------------------------- -(define (generate-roe-vector3-2d pde-system - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that solves the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Roe finite-volume method. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define flux-jacobian-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) - (define flux-jacobian-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) - (define flux-jacobian-eigvals-simp-x (list (symbolic-simp (list-ref flux-jacobian-eigvals-x 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals-x 1)) - (symbolic-simp (list-ref flux-jacobian-eigvals-x 2)))) - (define flux-jacobian-eigvals-simp-y (list (symbolic-simp (list-ref flux-jacobian-eigvals-y 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals-y 1)) - (symbolic-simp (list-ref flux-jacobian-eigvals-y 2)))) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define flux-deriv-codes-x (map (lambda (flux-deriv-expr-x) - (convert-expr flux-deriv-expr-x)) flux-jacobian-eigvals-simp-x)) - (define flux-deriv-codes-y (map (lambda (flux-deriv-expr-y) - (convert-expr flux-deriv-expr-y)) flux-jacobian-eigvals-simp-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") - (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-codes-x)) - (define flux-uis-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") - (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-codes-x)) - (define flux-ups-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") - (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-codes-x)) - - (define flux-deriv-ums-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "um_x[0]") - (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-uis-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "ui_x[0]") - (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-ups-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "up_x[0]") - (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-deriv-codes-x)) - - (define flux-ums-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") - (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-codes-y)) - (define flux-uis-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") - (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-codes-y)) - (define flux-ups-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") - (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-codes-y)) - - (define flux-deriv-ums-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "um_y[0]") - (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-uis-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "ui_y[0]") - (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-ups-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "up_y[0]") - (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-deriv-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a -// Roe higher-order finite-volume solver for a coupled vector system of 3 PDEs in 2D. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - double **un = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); - un[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - double *um_x = (double*) malloc(3 * sizeof(double)); - double *ui_x = (double*) malloc(3 * sizeof(double)); - double *up_x = (double*) malloc(3 * sizeof(double)); - - double *f_um_x = (double*) malloc(3 * sizeof(double)); - double *f_ui_x = (double*) malloc(3 * sizeof(double)); - double *f_up_x = (double*) malloc(3 * sizeof(double)); - - double *f_deriv_um_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_ui_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_up_x = (double*) malloc(3 * sizeof(double)); - - double *aL_roe_x = (double*) malloc(3 * sizeof(double)); - double *aR_roe_x = (double*) malloc(3 * sizeof(double)); - - double *fluxL_x = (double*) malloc(3 * sizeof(double)); - double *fluxR_x = (double*) malloc(3 * sizeof(double)); - - double *um_y = (double*) malloc(3 * sizeof(double)); - double *ui_y = (double*) malloc(3 * sizeof(double)); - double *up_y = (double*) malloc(3 * sizeof(double)); - - double *f_um_y = (double*) malloc(3 * sizeof(double)); - double *f_ui_y = (double*) malloc(3 * sizeof(double)); - double *f_up_y = (double*) malloc(3 * sizeof(double)); - - double *f_deriv_um_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_ui_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_up_y = (double*) malloc(3 * sizeof(double)); - - double *aL_roe_y = (double*) malloc(3 * sizeof(double)); - double *aR_roe_y = (double*) malloc(3 * sizeof(double)); - - double *fluxL_y = (double*) malloc(3 * sizeof(double)); - double *fluxR_y = (double*) malloc(3 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - - un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_y[k] = u[i][((j - 1) * 3) + k]; - ui_y[k] = u[i][(j * 3) + k]; - up_y[k] = u[i][((j + 1) * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; // F(U_{j + 1}). - - // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. - f_deriv_um_y[0] = ~a; - f_deriv_um_y[1] = ~a; - f_deriv_um_y[2] = ~a; // Eigenvalues of F'(U_{j - 1}). - - f_deriv_ui_y[0] = ~a; - f_deriv_ui_y[1] = ~a; - f_deriv_ui_y[2] = ~a; // Eigenvalues of F'(U_j). - - f_deriv_up_y[0] = ~a; - f_deriv_up_y[1] = ~a; - f_deriv_up_y[2] = ~a; // Eigenvalues of F'(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * |aL_roe_y| * (U_j - U_{j - 1}). - for (int k = 0; k < 3; k++) { - aL_roe_y[k] = 0.5 * (f_deriv_um_y[k] + f_deriv_ui_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * |aR_roe_y| * (U_{j + 1} - U_j). - for (int k = 0; k < 3; k++) { - aR_roe_y[k] = 0.5 * (f_deriv_ui_y[k] + f_deriv_up_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the x-direction. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_x[k] = u[i - 1][(j * 3) + k]; - ui_x[k] = u[i][(j * 3) + k]; - up_x[k] = u[i + 1][(j * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_x[0] = ~a; - f_um_x[1] = ~a; - f_um_x[2] = ~a; // F(U_{i - 1}). - - f_ui_x[0] = ~a; - f_ui_x[1] = ~a; - f_ui_x[2] = ~a; // F(U_i). - - f_up_x[0] = ~a; - f_up_x[1] = ~a; - f_up_x[2] = ~a; // F(U_{i + 1}). - - // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. - f_deriv_um_x[0] = ~a; - f_deriv_um_x[1] = ~a; - f_deriv_um_x[2] = ~a; // Eigenvalues of F'(U_{i - 1}). - - f_deriv_ui_x[0] = ~a; - f_deriv_ui_x[1] = ~a; - f_deriv_ui_x[2] = ~a; // Eigenvalues of F'(U_i). - - f_deriv_up_x[0] = ~a; - f_deriv_up_x[1] = ~a; - f_deriv_up_x[2] = ~a; // Eigenvalues of F'(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * |aL_roe_x| * (U_i - U_{i - 1}). - for (int k = 0; k < 3; k++) { - aL_roe_x[k] = 0.5 * (f_deriv_um_x[k] + f_deriv_ui_x[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * fabs(aL_roe_x[k]) * (ui_x[k] - um_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * |aR_roe_x| * (U_{i + 1} - U_i). - for (int k = 0; k < 3; k++) { - aR_roe_x[k] = 0.5 * (f_deriv_ui_x[k] + f_deriv_up_x[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * fabs(aR_roe_x[k]) * (up_x[k] - ui_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_y[k] = u[i][((j - 1) * 3) + k]; - ui_y[k] = u[i][(j * 3) + k]; - up_y[k] = u[i][((j + 1) * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; // F(U_{j + 1}). - - // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. - f_deriv_um_y[0] = ~a; - f_deriv_um_y[1] = ~a; - f_deriv_um_y[2] = ~a; // Eigenvalues of F'(U_{j - 1}). - - f_deriv_ui_y[0] = ~a; - f_deriv_ui_y[1] = ~a; - f_deriv_ui_y[2] = ~a; // Eigenvalues of F'(U_j). - - f_deriv_up_y[0] = ~a; - f_deriv_up_y[1] = ~a; - f_deriv_up_y[2] = ~a; // Eigenvalues of F'(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * |aL_roe_y| * (U_j - U_{j - 1}). - for (int k = 0; k < 3; k++) { - aL_roe_y[k] = 0.5 * (f_deriv_um_y[k] + f_deriv_ui_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * |aR_roe_y| * (U_{j + 1} - U_j). - for (int k = 0; k < 3; k++) { - aR_roe_y[k] = 0.5 * (f_deriv_ui_y[k] + f_deriv_up_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - free(un[i]); - } - free(u); - free(un); - - free(local_alpha_x); - free(local_alpha_y); - - free(um_x); - free(ui_x); - free(up_x); - - free(f_um_x); - free(f_ui_x); - free(f_up_x); - - free(f_deriv_um_x); - free(f_deriv_ui_x); - free(f_deriv_up_x); - - free(aL_roe_x); - free(aR_roe_x); - - free(fluxL_x); - free(fluxR_x); - - free(um_y); - free(ui_y); - free(up_y); - - free(f_um_y); - free(f_ui_y); - free(f_up_y); - - free(f_deriv_um_y); - free(f_deriv_ui_y); - free(f_deriv_up_y); - - free(aL_roe_y); - free(aR_roe_y); - - free(fluxL_y); - free(fluxR_y); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - ;; Eigenvalues of left, middle, right flux Jacobians in y-direction F'(u_{j - 1}), F'(u_j), F'(u_{j + 1}). - (list-ref flux-deriv-ums-y 0) - (list-ref flux-deriv-ums-y 1) - (list-ref flux-deriv-ums-y 2) - (list-ref flux-deriv-uis-y 0) - (list-ref flux-deriv-uis-y 1) - (list-ref flux-deriv-uis-y 2) - (list-ref flux-deriv-ups-y 0) - (list-ref flux-deriv-ups-y 1) - (list-ref flux-deriv-ups-y 2) - ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). - (list-ref flux-ums-x 0) - (list-ref flux-ums-x 1) - (list-ref flux-ums-x 2) - (list-ref flux-uis-x 0) - (list-ref flux-uis-x 1) - (list-ref flux-uis-x 2) - (list-ref flux-ups-x 0) - (list-ref flux-ups-x 1) - (list-ref flux-ups-x 2) - ;; Eigenvalues of left, middle, right flux Jacobians in x-direction F'(u_{i - 1}), F'(u_i), F'(u_{i + 1}). - (list-ref flux-deriv-ums-x 0) - (list-ref flux-deriv-ums-x 1) - (list-ref flux-deriv-ums-x 2) - (list-ref flux-deriv-uis-x 0) - (list-ref flux-deriv-uis-x 1) - (list-ref flux-deriv-uis-x 2) - (list-ref flux-deriv-ups-x 0) - (list-ref flux-deriv-ups-x 1) - (list-ref flux-deriv-ups-x 2) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - ;; Eigenvalues of left, middle, right flux Jacobians in y-direction F'(u_{j - 1}), F'(u_j), F'(u_{j + 1}). - (list-ref flux-deriv-ums-y 0) - (list-ref flux-deriv-ums-y 1) - (list-ref flux-deriv-ums-y 2) - (list-ref flux-deriv-uis-y 0) - (list-ref flux-deriv-uis-y 1) - (list-ref flux-deriv-uis-y 2) - (list-ref flux-deriv-ups-y 0) - (list-ref flux-deriv-ups-y 1) - (list-ref flux-deriv-ups-y 2) - ;; PDE name for file output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------------------- -;; Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation -;; ---------------------------------------------------------------------------------------------------------- -(define (generate-roe-vector3-2d-second-order pde-system limiter - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that solves the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Roe finite-volume method with a - second-order flux extrapolation using flux limiter `limiter`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define flux-jacobian-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) - (define flux-jacobian-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) - (define flux-jacobian-eigvals-simp-x (list (symbolic-simp (list-ref flux-jacobian-eigvals-x 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals-x 1)) - (symbolic-simp (list-ref flux-jacobian-eigvals-x 2)))) - (define flux-jacobian-eigvals-simp-y (list (symbolic-simp (list-ref flux-jacobian-eigvals-y 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals-y 1)) - (symbolic-simp (list-ref flux-jacobian-eigvals-y 2)))) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define flux-deriv-codes-x (map (lambda (flux-deriv-expr-x) - (convert-expr flux-deriv-expr-x)) flux-jacobian-eigvals-simp-x)) - (define flux-deriv-codes-y (map (lambda (flux-deriv-expr-y) - (convert-expr flux-deriv-expr-y)) flux-jacobian-eigvals-simp-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") - (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]")) flux-codes-x)) - (define flux-umRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_x[0]") - (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]")) flux-codes-x)) - (define flux-uiLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") - (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]")) flux-codes-x)) - (define flux-uiRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") - (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]")) flux-codes-x)) - (define flux-upLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") - (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]")) flux-codes-x)) - (define flux-upRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") - (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]")) flux-codes-x)) - - (define flux-umR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") - (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-codes-x)) - (define flux-uiL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") - (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-codes-x)) - (define flux-uiR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") - (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-codes-x)) - (define flux-upL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") - (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-codes-x)) - - (define flux-deriv-umR-evols-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "umR_evol_x[0]") - (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-uiL-evols-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") - (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-uiR-evols-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") - (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-upL-evols-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "upL_evol_x[0]") - (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-deriv-codes-x)) - - (define flux-umLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") - (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]")) flux-codes-y)) - (define flux-umRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") - (list-ref cons-codes 1) "umR_y[1]") (list-ref cons-codes 2) "umR_y[2]")) flux-codes-y)) - (define flux-uiLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") - (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]")) flux-codes-y)) - (define flux-uiRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") - (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]")) flux-codes-y)) - (define flux-upLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") - (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]")) flux-codes-y)) - (define flux-upRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") - (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]")) flux-codes-y)) - - (define flux-umR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") - (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-codes-y)) - (define flux-uiL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") - (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-codes-y)) - (define flux-uiR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") - (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-codes-y)) - (define flux-upL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") - (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-codes-y)) - - (define flux-deriv-umR-evols-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "umR_evol_y[0]") - (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-uiL-evols-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") - (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-uiR-evols-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") - (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-upL-evols-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "upL_evol_y[0]") - (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-deriv-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Roe higher-order finite-volume solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing slopes. - double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); - double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - slope_x[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - slope_y[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - } - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - double **un = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - un[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - double *umL_x = (double*) malloc(3 * sizeof(double)); - double *umR_x = (double*) malloc(3 * sizeof(double)); - double *uiL_x = (double*) malloc(3 * sizeof(double)); - double *uiR_x = (double*) malloc(3 * sizeof(double)); - double *upL_x = (double*) malloc(3 * sizeof(double)); - double *upR_x = (double*) malloc(3 * sizeof(double)); - - double *f_umL_x = (double*) malloc(3 * sizeof(double)); - double *f_umR_x = (double*) malloc(3 * sizeof(double)); - double *f_uiL_x = (double*) malloc(3 * sizeof(double)); - double *f_uiR_x = (double*) malloc(3 * sizeof(double)); - double *f_upL_x = (double*) malloc(3 * sizeof(double)); - double *f_upR_x = (double*) malloc(3 * sizeof(double)); - - double *umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *f_umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *f_deriv_umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *aL_roe_x = (double*) malloc(3 * sizeof(double)); - double *aR_roe_x = (double*) malloc(3 * sizeof(double)); - - double *fluxL_x = (double*) malloc(3 * sizeof(double)); - double *fluxR_x = (double*) malloc(3 * sizeof(double)); - - double *umL_y = (double*) malloc(3 * sizeof(double)); - double *umR_y = (double*) malloc(3 * sizeof(double)); - double *uiL_y = (double*) malloc(3 * sizeof(double)); - double *uiR_y = (double*) malloc(3 * sizeof(double)); - double *upL_y = (double*) malloc(3 * sizeof(double)); - double *upR_y = (double*) malloc(3 * sizeof(double)); - - double *f_umL_y = (double*) malloc(3 * sizeof(double)); - double *f_umR_y = (double*) malloc(3 * sizeof(double)); - double *f_uiL_y = (double*) malloc(3 * sizeof(double)); - double *f_uiR_y = (double*) malloc(3 * sizeof(double)); - double *f_upL_y = (double*) malloc(3 * sizeof(double)); - double *f_upR_y = (double*) malloc(3 * sizeof(double)); - - double *umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *f_umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *f_deriv_umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *aL_roe_y = (double*) malloc(3 * sizeof(double)); - double *aR_roe_y = (double*) malloc(3 * sizeof(double)); - - double *fluxL_y = (double*) malloc(3 * sizeof(double)); - double *fluxR_y = (double*) malloc(3 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - - un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); - umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); - - uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); - uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); - - upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); - upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) - - // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. - f_deriv_umR_evol_y[0] = ~a; - f_deriv_umR_evol_y[1] = ~a; - f_deriv_umR_evol_y[2] = ~a; // F'(U_{j - 1, R+}) - f_deriv_uiL_evol_y[0] = ~a; - f_deriv_uiL_evol_y[1] = ~a; - f_deriv_uiL_evol_y[2] = ~a; // F'(U_{j, L+}) - - f_deriv_uiR_evol_y[0] = ~a; - f_deriv_uiR_evol_y[1] = ~a; - f_deriv_uiR_evol_y[2] = ~a; // F'(U_{j, R+}) - f_deriv_upL_evol_y[0] = ~a; - f_deriv_upL_evol_y[1] = ~a; - f_deriv_upL_evol_y[2] = ~a; // F'(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * |aL_roe_y| * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 3; k++) { - aL_roe_y[k] = 0.5 * (f_deriv_umR_evol_y[k] + f_deriv_uiL_evol_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * |aR_roe_y| * (U_{j + 1, L+} - u_{j, R+}). - for (int k = 0; k < 3; k++) { - aR_roe_y[k] = 0.5 * (f_deriv_uiR_evol_y[k] + f_deriv_upL_evol_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) / (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_x[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) + (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the x-direction. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_x[k] = u[i - 1][(j * 3) + k] - (0.5 * slope_x[i - 1][(j * 3) + k]); - umR_x[k] = u[i - 1][(j * 3) + k] + (0.5 * slope_x[i - 1][(j * 3) + k]); - - uiL_x[k] = u[i][(j * 3) + k] - (0.5 * slope_x[i][(j * 3) + k]); - uiR_x[k] = u[i][(j * 3) + k] + (0.5 * slope_x[i][(j * 3) + k]); - - upL_x[k] = u[i + 1][(j * 3) + k] - (0.5 * slope_x[i + 1][(j * 3) + k]); - upR_x[k] = u[i + 1][(j * 3) + k] + (0.5 * slope_x[i + 1][(j * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_x[0] = ~a; - f_umL_x[1] = ~a; - f_umL_x[2] = ~a; - f_umR_x[0] = ~a; - f_umR_x[1] = ~a; - f_umR_x[2] = ~a; - - f_uiL_x[0] = ~a; - f_uiL_x[1] = ~a; - f_uiL_x[2] = ~a; - f_uiR_x[0] = ~a; - f_uiR_x[1] = ~a; - f_uiR_x[2] = ~a; - - f_upL_x[0] = ~a; - f_upL_x[1] = ~a; - f_upL_x[2] = ~a; - f_upR_x[0] = ~a; - f_upR_x[1] = ~a; - f_upR_x[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); - - uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - - upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_x[0] = ~a; - f_umR_evol_x[1] = ~a; - f_umR_evol_x[2] = ~a; // F(U_{i - 1, R+}) - f_uiL_evol_x[0] = ~a; - f_uiL_evol_x[1] = ~a; - f_uiL_evol_x[2] = ~a; // F(U_{i, L+}) - - f_uiR_evol_x[0] = ~a; - f_uiR_evol_x[1] = ~a; - f_uiR_evol_x[2] = ~a; // F(U_{i, R+}) - f_upL_evol_x[0] = ~a; - f_upL_evol_x[1] = ~a; - f_upL_evol_x[2] = ~a; // F(U_{i + 1, L+}) - - // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. - f_deriv_umR_evol_x[0] = ~a; - f_deriv_umR_evol_x[1] = ~a; - f_deriv_umR_evol_x[2] = ~a; // F'(U_{i - 1, R+}) - f_deriv_uiL_evol_x[0] = ~a; - f_deriv_uiL_evol_x[1] = ~a; - f_deriv_uiL_evol_x[2] = ~a; // F'(U_{i, L+}) - - f_deriv_uiR_evol_x[0] = ~a; - f_deriv_uiR_evol_x[1] = ~a; - f_deriv_uiR_evol_x[2] = ~a; // F'(U_{i, R+}) - f_deriv_upL_evol_x[0] = ~a; - f_deriv_upL_evol_x[1] = ~a; - f_deriv_upL_evol_x[2] = ~a; // F'(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * |aL_roe_x| * (U_{i, L+} - U_{i - 1, R+}). - for (int k = 0; k < 3; k++) { - aL_roe_x[k] = 0.5 * (f_deriv_umR_evol_x[k] + f_deriv_uiL_evol_x[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * fabs(aL_roe_x[k]) * (uiL_evol_x[k] - umR_evol_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * |aR_roe_x| * (U_{i + 1, L+} - u_{i, R+}). - for (int k = 0; k < 3; k++) { - aR_roe_x[k] = 0.5 * (f_deriv_uiR_evol_x[k] + f_deriv_upL_evol_x[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * fabs(aR_roe_x[k]) * (upL_evol_x[k] - uiR_evol_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); - umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); - - uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); - uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); - - upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); - upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) - - // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. - f_deriv_umR_evol_y[0] = ~a; - f_deriv_umR_evol_y[1] = ~a; - f_deriv_umR_evol_y[2] = ~a; // F'(U_{j - 1, R+}) - f_deriv_uiL_evol_y[0] = ~a; - f_deriv_uiL_evol_y[1] = ~a; - f_deriv_uiL_evol_y[2] = ~a; // F'(U_{j, L+}) - - f_deriv_uiR_evol_y[0] = ~a; - f_deriv_uiR_evol_y[1] = ~a; - f_deriv_uiR_evol_y[2] = ~a; // F'(U_{j, R+}) - f_deriv_upL_evol_y[0] = ~a; - f_deriv_upL_evol_y[1] = ~a; - f_deriv_upL_evol_y[2] = ~a; // F'(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * |aL_roe_y| * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 3; k++) { - aL_roe_y[k] = 0.5 * (f_deriv_umR_evol_y[k] + f_deriv_uiL_evol_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * |aR_roe_y| * (U_{j + 1, L+} - u_{j, R+}). - for (int k = 0; k < 3; k++) { - aR_roe_y[k] = 0.5 * (f_deriv_uiR_evol_y[k] + f_deriv_upL_evol_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - free(un[i]); - free(slope_x[i]); - free(slope_y[i]); - } - free(u); - free(un); - free(slope_x); - free(slope_y); - - free(local_alpha_x); - free(local_alpha_y); - - free(umL_x); - free(umR_x); - free(uiL_x); - free(uiR_x); - free(upL_x); - free(upR_x); - - free(f_umL_x); - free(f_umR_x); - free(f_uiL_x); - free(f_uiR_x); - free(f_upL_x); - free(f_upR_x); - - free(umR_evol_x); - free(uiL_evol_x); - free(uiR_evol_x); - free(upL_evol_x); - - free(f_umR_evol_x); - free(f_uiL_evol_x); - free(f_uiR_evol_x); - free(f_upL_evol_x); - - free(f_deriv_umR_evol_x); - free(f_deriv_uiL_evol_x); - free(f_deriv_uiR_evol_x); - free(f_deriv_upL_evol_x); - - free(aL_roe_x); - free(aR_roe_x); - - free(fluxL_x); - free(fluxR_x); - - free(umL_y); - free(umR_y); - free(uiL_y); - free(uiR_y); - free(upL_y); - free(upR_y); - - free(f_umL_y); - free(f_umR_y); - free(f_uiL_y); - free(f_uiR_y); - free(f_upL_y); - free(f_upR_y); - - free(umR_evol_y); - free(uiL_evol_y); - free(uiR_evol_y); - free(upL_evol_y); - - free(f_umR_evol_y); - free(f_uiL_evol_y); - free(f_uiR_evol_y); - free(f_upL_evol_y); - - free(f_deriv_umR_evol_y); - free(f_deriv_uiL_evol_y); - free(f_deriv_uiR_evol_y); - free(f_deriv_upL_evol_y); - - free(aL_roe_y); - free(aR_roe_y); - - free(fluxL_y); - free(fluxR_y); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - ;; Evolved right negative/left central flux Jacobian eigenvalues in y-direction F'(U_{j - 1, R+}), F'(U_{j, L+}). - (list-ref flux-deriv-umR-evols-y 0) - (list-ref flux-deriv-umR-evols-y 1) - (list-ref flux-deriv-umR-evols-y 2) - (list-ref flux-deriv-uiL-evols-y 0) - (list-ref flux-deriv-uiL-evols-y 1) - (list-ref flux-deriv-uiL-evols-y 2) - ;; Evolved right central/left positive flux Jacobian eigenvalues in y-direction F'(U_{j, R+}), F'(U_{j + 1, L+}). - (list-ref flux-deriv-uiR-evols-y 0) - (list-ref flux-deriv-uiR-evols-y 1) - (list-ref flux-deriv-uiR-evols-y 2) - (list-ref flux-deriv-upL-evols-y 0) - (list-ref flux-deriv-upL-evols-y 1) - (list-ref flux-deriv-upL-evols-y 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). - (list-ref flux-umLs-x 0) - (list-ref flux-umLs-x 1) - (list-ref flux-umLs-x 2) - (list-ref flux-umRs-x 0) - (list-ref flux-umRs-x 1) - (list-ref flux-umRs-x 2) - ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). - (list-ref flux-uiLs-x 0) - (list-ref flux-uiLs-x 1) - (list-ref flux-uiLs-x 2) - (list-ref flux-uiRs-x 0) - (list-ref flux-uiRs-x 1) - (list-ref flux-uiRs-x 2) - ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). - (list-ref flux-upLs-x 0) - (list-ref flux-upLs-x 1) - (list-ref flux-upLs-x 2) - (list-ref flux-upRs-x 0) - (list-ref flux-upRs-x 1) - (list-ref flux-upRs-x 2) - ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). - (list-ref flux-umR-evols-x 0) - (list-ref flux-umR-evols-x 1) - (list-ref flux-umR-evols-x 2) - (list-ref flux-uiL-evols-x 0) - (list-ref flux-uiL-evols-x 1) - (list-ref flux-uiL-evols-x 2) - ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). - (list-ref flux-uiR-evols-x 0) - (list-ref flux-uiR-evols-x 1) - (list-ref flux-uiR-evols-x 2) - (list-ref flux-upL-evols-x 0) - (list-ref flux-upL-evols-x 1) - (list-ref flux-upL-evols-x 2) - ;; Evolved right negative/left central flux Jacobian eigenvalues in x-direction F'(U_{i - 1, R+}), F'(U_{i, L+}). - (list-ref flux-deriv-umR-evols-x 0) - (list-ref flux-deriv-umR-evols-x 1) - (list-ref flux-deriv-umR-evols-x 2) - (list-ref flux-deriv-uiL-evols-x 0) - (list-ref flux-deriv-uiL-evols-x 1) - (list-ref flux-deriv-uiL-evols-x 2) - ;; Evolved right central/left positive flux Jacobian eigenvalues in x-direction F'(U_{i, R+}), F'(U_{i + 1, L+}). - (list-ref flux-deriv-uiR-evols-x 0) - (list-ref flux-deriv-uiR-evols-x 1) - (list-ref flux-deriv-uiR-evols-x 2) - (list-ref flux-deriv-upL-evols-x 0) - (list-ref flux-deriv-upL-evols-x 1) - (list-ref flux-deriv-upL-evols-x 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - ;; Evolved right negative/left central flux Jacobian eigenvalues in y-direction F'(U_{j - 1, R+}), F'(U_{j, L+}). - (list-ref flux-deriv-umR-evols-y 0) - (list-ref flux-deriv-umR-evols-y 1) - (list-ref flux-deriv-umR-evols-y 2) - (list-ref flux-deriv-uiL-evols-y 0) - (list-ref flux-deriv-uiL-evols-y 1) - (list-ref flux-deriv-uiL-evols-y 2) - ;; Evolved right central/left positive flux Jacobian eigenvalues in y-direction F'(U_{j, R+}), F'(U_{j + 1, L+}). - (list-ref flux-deriv-uiR-evols-y 0) - (list-ref flux-deriv-uiR-evols-y 1) - (list-ref flux-deriv-uiR-evols-y 2) - (list-ref flux-deriv-upL-evols-y 0) - (list-ref flux-deriv-upL-evols-y 1) - (list-ref flux-deriv-upL-evols-y 2) - ;; PDE name for file output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/prover_vector.rkt b/provable-algorithms/finite_volume/prover_vector.rkt deleted file mode 100644 index 78de9881..00000000 --- a/provable-algorithms/finite_volume/prover_vector.rkt +++ /dev/null @@ -1,1916 +0,0 @@ -#lang racket - -(require racket/trace) -(current-prefix-in " ") -(current-prefix-out " ") - -(provide symbolic-jacobian - symbolic-gradient - symbolic-hessian - symbolic-eigvals2 - symbolic-eigvals3 - is-non-zero - are-distinct - symbolic-roe-matrix - prove-lax-friedrichs-vector2-1d-hyperbolicity - prove-lax-friedrichs-vector2-1d-strict-hyperbolicity - prove-lax-friedrichs-vector2-1d-cfl-stability - prove-lax-friedrichs-vector2-1d-local-lipschitz - prove-lax-friedrichs-vector3-2d-hyperbolicity - prove-lax-friedrichs-vector3-2d-strict-hyperbolicity - prove-lax-friedrichs-vector3-2d-cfl-stability - prove-lax-friedrichs-vector3-2d-local-lipschitz - prove-roe-vector2-1d-hyperbolicity - prove-roe-vector2-1d-strict-hyperbolicity - prove-roe-vector2-1d-flux-conservation - prove-roe-vector3-2d-hyperbolicity - prove-roe-vector3-2d-strict-hyperbolicity - prove-roe-vector3-2d-flux-conservation) - -;; Lightweight symbolic differentiator (differentiates expr with respect to var). -(define (symbolic-diff expr var) - (match expr - ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. - [(? symbol? symb) (cond - [(eq? symb var) 1.0] - [else 0.0])] - - ;; If expr is a numerical constant, then it differentiates to 0. - [(? number?) 0.0] - - ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] - ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] - - ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. - [`(* . ,terms) - (define n (length terms)) - (define (mult xs) (cons '* xs)) ; Multiplication helper function. - - ((lambda (sums) (cond - [(null? (cdr sums)) (car sums)] - [else (cons '+ sums)])) - (let loop ([i 0]) - (cond - [(= i n) `()] - [else - ;; Evaluate the derivative of the i-th term in the product. - (let ([di (symbolic-diff (list-ref terms i) var)]) - (cons - (mult (for/list ([j (in-range n)]) - (cond - [(= j i) di] - [else (list-ref terms j)]))) - (loop (add1 i))))])))] - - ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. - [`(/ ,x ,y) - `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] - - ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). - [`(abs ,arg) - `(* (sgn ,arg) ,(symbolic-diff arg var))] - - ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. - [`(sgn ,arg) 0.0] - - ;; Otherwise, return false. - [else #f])) - -;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). -(define (symbolic-simp-rule expr) - (match expr - ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. - [`(+ 0 ,x) `,x] - [`(+ 0.0 ,x) `,x] - [`(+ -0.0 ,x) `,x] - - ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. - [`(* 1 ,x) `,x] - [`(* 1.0 ,x) `,x] - - ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. - [`(* 0 ,x) 0] - [`(* 0.0 ,x) 0.0] - [`(* -0.0 ,x) 0.0] - - ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. - [`(- ,x 0) `,x] - [`(- ,x 0.0) `,x] - [`(- ,x -0.0) `,x] - - ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). - [`(- 0 ,x) `(* -1 ,x)] - [`(- 0.0 ,x) `(* -1.0 ,x)] - [`(- -0.0 ,x) `(* -1.0 ,x)] - - ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. - [`(/ ,x 1) `,x] - [`(/ ,x 1.0) `,x] - - ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). - [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] - [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] - - ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). - [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] - [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] - - ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. - [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] - [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] - - ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients - [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] - [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] - - ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. - [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] - - ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). - [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] - - ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). - [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] - - ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). - [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] - - ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). - [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] - - ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). - [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] - - ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). - [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] - ;; Likewise for differences. - [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] - - ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. - [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] - - ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). - [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] - - ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). - [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] - - ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. - [`(sqrt (* ,x ,x)) `,x] - [`(* (sqrt ,x) (sqrt ,x)) `,x] - - ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). - [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] - ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). - [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] - - ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). - [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] - - ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. - [`(sqrt ,(and x (? number?))) (sqrt x)] - - ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. - [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] - [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] - - ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., - [`(abs ,(and x (? number?))) (abs x)] - - ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). - [`(abs (* -1 ,x)) `(abs ,x)] - [`(abs (* -1.0 ,x)) `(abs ,x)] - - ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). - [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] - [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - - ;; If expr is of the form (x + x), thens implify to (2.0 * x). - [`(+ ,x ,x) `(* 2.0 ,x)] - - ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). - [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] - - ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). - [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] - - ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). - [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] - - ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). - [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] - - ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). - [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] - [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] - - ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). - [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] - - ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). - [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] - - ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). - [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] - [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - - ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). - [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] - - ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). - [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] - - ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. - [`(/ 0 ,x) 0] - [`(/ 0.0 ,x) 0.0] - [`(/ -0.0 ,x) 0.0] - - ;; If expr is of the form (x / x), then simplify to 1.0 - [`(/ ,x ,x) 1.0] - - ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). - [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] - ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). - [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] - - ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). - [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] - - ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). - [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] - [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] - - ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). - [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] - [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] - - ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for differences. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. - [`(* . ,terms) - `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for quotients. - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. - [`(sqrt ,arg) - `(sqrt ,(symbolic-simp-rule arg))] - - ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. - [`(abs ,arg) - `(abs ,(symbolic-simp-rule arg))] - - ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). - [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] - [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] - - ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). - [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). - [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] - - ;; Otherwise, return the expression. - [else expr])) - -;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). -(define (symbolic-simp expr) - (define simp-expr (symbolic-simp-rule expr)) - - (cond - [(equal? simp-expr expr) expr] - [else (symbolic-simp simp-expr)])) - -;; Recursively determine whether an expression corresponds to a real number. -(define (is-real expr cons-vars parameters) - (match expr - ;; Real numbers are trivially real. - [(? real?) #t] - - ;; Conserved variables are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (not (equal? (member arg cons-vars) #f)))) #t] - - ;; Simulation parameters are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (equal? arg (list-ref parameter 1))) parameters)))) #t] - - ;; The outcome of a conditional operation is real if both branches yield real numbers. - [`(cond - [,cond1 ,expr1] - [else ,expr2]) - (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] - - ;; The sum, difference, product, or quotient of two real numbers is always real. - [`(+ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(- . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(* . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(/ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - - ;; Otherwise, assume false. - [else #f])) - -;; Recursively replace conserved variable expressions within the flux derivative expression (for Roe functions). -(define (flux-deriv-replace flux-deriv-expr cons-expr new-cons-expr) - (match flux-deriv-expr - ;; If the flux derivative expression is just the conserved variable expression, then return the new conserved variable expression. - [(? (lambda (arg) - (equal? arg cons-expr))) new-cons-expr] - - ;; If the flux derivative expression consists of a sum, difference, product, or quotient, then recursively apply replacement to each term. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - [`(- . ,terms) - `(- ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - [`(* . ,terms) - `(* ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - - ;; Otherwise, return the flux derivative expression. - [else flux-deriv-expr])) - -;; Compute symbolic Jacobian matrix by mapping symbolic differentiation over exprs with respect to vars. -(define (symbolic-jacobian exprs vars) - (map (lambda (expr) - (map (lambda (var) - (symbolic-simp (symbolic-diff expr var))) - vars)) - exprs)) - -;; Compute symbolic gradient vector by applying symbolic differentiation to expr, mapped over vars. -(define (symbolic-gradient expr vars) - (map (lambda (var) - (symbolic-simp (symbolic-diff expr var))) - vars)) - -;; Compute symbolic Hessian matrix by computing the symbolic Jacobian matrix of the symbolic gradient vector of expr with respect to vars. -(define (symbolic-hessian expr vars) - (symbolic-jacobian (symbolic-gradient expr vars) vars)) - -;; Compute symbolic eigenvalues of a 2x2 symbolic matrix via explicit solution of the characteristic polynomial. -(define (symbolic-eigvals2 matrix) - (let ([a (list-ref (list-ref matrix 0) 0)] - [b (list-ref (list-ref matrix 0) 1)] - [c (list-ref (list-ref matrix 1) 0)] - [d (list-ref (list-ref matrix 1) 1)]) - (cond - ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a pair of zeroes. - [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0)) (list 0.0 0.0)] - - ;; Otherwise, calculate the eigenvalues explicitly. - [else (list `(* 0.5 (+ (- ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)) - `(* 0.5 (+ (+ ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)))]))) - -;; Compute symbolic eigenvalues of a 3x3 symbolic matrix (in restricted cases) via explicit solution of the characteristic polynomial. -(define (symbolic-eigvals3 matrix) - (let ([a (list-ref (list-ref matrix 0) 0)] - [b (list-ref (list-ref matrix 0) 1)] - [c (list-ref (list-ref matrix 0) 2)] - [d (list-ref (list-ref matrix 1) 0)] - [e (list-ref (list-ref matrix 1) 1)] - [f (list-ref (list-ref matrix 1) 2)] - [g (list-ref (list-ref matrix 2) 0)] - [h (list-ref (list-ref matrix 2) 1)] - [i (list-ref (list-ref matrix 2) 2)]) - (cond - ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a triple of zeroes. - [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0) (equal? e 0.0) (equal? f 0.0) (equal? g 0.0) (equal? h 0.0) (equal? i 0.0)) (list 0.0 0.0 0.0)] - - ;; If the matrix is in a restricted (tractable) form, calculate the eigenvalues explicitly. - [(and (equal? a 0.0) (equal? b 1.0) (equal? c 0.0) (equal? f 0.0)) - (list `(* 0.5 (- ,e (sqrt (+ (* 4.0 ,d) (* ,e ,e))))) `(* 0.5 (+ ,e (sqrt (+ (* 4.0 ,d) (* ,e ,e))))) i)] - [(and (equal? a 0.0) (equal? b 0.0) (equal? c 1.0) (equal? h 0.0)) - (list e `(* 0.5 (- ,i (sqrt (+ (* 4.0 ,g) (* ,i ,i))))) `(* 0.5 (+ ,i (sqrt (+ (* 4.0 ,g) (* ,i ,i))))))] - - ;; Otherwise, return false(s). - [else (list #f #f #f)]))) - -;; Determine whether an expression is non-zero. -(define (is-non-zero expr parameters) - (match expr - ;; A non-zero number is, trivially, non-zero. - [(? (lambda (arg) - (and (number? arg) (not (equal? arg 0)) (not (equal? arg 0.0))))) #t] - - ;; Simulation parameters that are non-zero are, trivially, non-zero. - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (and (equal? arg (list-ref parameter 1)) - (or (not (equal? (list-ref parameter 2) 0)) - (not (equal? (list-ref parameter 2) 0.0))))) parameters)))) #t] - - ;; The product of two non-zero numbers is always non-zero. - [`(* ,x ,y) (and (is-non-zero x parameters) (is-non-zero y parameters))] - - ;; Otherwise, assume false. - [else #f])) - -;; Recursively determine whether two expressions are distinct. -(define (are-distinct expr parameters) - (match expr - ;; Two numbers that are unequal are, trivially, distinct. - [(? (lambda (arg) - (and (number? (list-ref arg 0)) (number? (list-ref arg 1)) (not (equal? (list-ref arg 0) (list-ref arg 1)))))) #t] - - ;; Expressions of the form (expr, -expr) or (-expr, expr) are distinct, so long as expr is non-zero. - [`(,x (* -1 ,x)) (is-non-zero x parameters)] - [`(,x (* -1.0 ,x)) (is-non-zero x parameters)] - [`((* -1 ,x) ,x) (is-non-zero x parameters)] - [`((* -1.0 ,x) ,x) (is-non-zero x parameters)] - - ;; Expressions of the form ((x + y), (x - y)) or ((x - y), (x + y)) are distinct, so long as y is non-zero. - [`((+ ,x ,y) (- ,x ,y)) (is-non-zero y parameters)] - [`((- ,x ,y) (+ ,x ,y)) (is-non-zero y parameters)] - - ;; Expressions of the form (x, (x - y)) or (x, (x + y)) are distinct, so long as y is non-zero. - [`(,x (- ,x ,y)) (is-non-zero y parameters)] - [`(,x (+ ,x ,y)) (is-non-zero y parameters)] - - ;; Expressions of the form ((x - y), x) or ((x + y), x) are distinct, so long as y is non-zero. - [`((- ,x ,y) ,x) (is-non-zero y parameters)] - [`((+ ,x ,y) ,x) (is-non-zero y parameters)] - - ;; Otherwise, assume false. - [else #f])) - -;; Compute the symbolic Roe matrix (averaged flux Jacobian). -(define (symbolic-roe-matrix flux-jacobian cons-exprs) - (map (lambda (row) - (map (lambda (column) - (symbolic-simp `(+ (* 0.5 ,(flux-deriv-replace (flux-deriv-replace column (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")))) - (* 0.5 ,(flux-deriv-replace (flux-deriv-replace column (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))))) - row)) - flux-jacobian)) - -;; Determine whether an expression is non-negative. -(define (is-non-negative expr parameters) - (match expr - ;; A non-negative number is, trivially, non-negative. - [(? (lambda (arg) - (and (number? arg) (or (>= arg 0) (>= arg 0.0))))) #t] - - ;; Simulation parameters that are non-negative are, trivially, non-negative. - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (and (equal? arg (list-ref parameter 1)) - (or (>= (list-ref parameter 2) 0) - (>= (list-ref parameter 2) 0.0)))) parameters)))) #t] - - ;; The sum, product, or quotient of two non-negative numbers is always non-negative. - [`(+ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] - [`(* ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] - [`(/ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] - - ;; Otherwise, assume false. - [else #f])) - -;; ------------------------------------------------------------------------------------------------------------- -;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - - (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define flux-eigvals-simp (list - (symbolic-simp (list-ref flux-eigvals 0)) - (symbolic-simp (list-ref flux-eigvals 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the flux Jacobian are all real (otherwise, return false). - [(or (not (is-real (list-ref flux-eigvals-simp 0) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp 1) cons-exprs parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - - out) -(trace prove-lax-friedrichs-vector2-1d-hyperbolicity) - -;; -------------------------------------------------------------------------------------------------------------------- -;; Prove strict hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; -------------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Lax-Friedrichs finite-difference method preserves strict hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - (trace is-non-zero) - (trace are-distinct) - - (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define flux-eigvals-simp (list - (symbolic-simp (list-ref flux-eigvals 0)) - (symbolic-simp (list-ref flux-eigvals 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the flux Jacobian are all real (otherwise, return false). - [(or (not (is-real (list-ref flux-eigvals-simp 0) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the flux Jacobian are all distinct (otherwise, return false). - [(not (are-distinct flux-eigvals-simp parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - (untrace is-non-zero) - (untrace are-distinct) - - out) -(trace prove-lax-friedrichs-vector2-1d-strict-hyperbolicity) - -;; ------------------------------------------------------------------------------------------------------------- -;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - - (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define max-speed-exprs-simp (list - (symbolic-simp (list-ref max-speed-exprs 0)) - (symbolic-simp (list-ref max-speed-exprs 1)))) - (define flux-eigvals-simp (list - (symbolic-simp `(abs ,(list-ref flux-eigvals 0))) - (symbolic-simp `(abs ,(list-ref flux-eigvals 1))))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the absolute eigenvalues of the flux Jacobian are symbolically equivalent to the maximum wave-speed estimates (otherwise, return false). - [(or (equal? (member (list-ref flux-eigvals-simp 0) max-speed-exprs-simp) #f) - (equal? (member (list-ref flux-eigvals-simp 1) max-speed-exprs-simp) #f)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - - out) -(trace prove-lax-friedrichs-vector2-1d-cfl-stability) - -;; --------------------------------------------------------------------------------------------------------------------------------------------------------- -;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; --------------------------------------------------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - (trace symbolic-gradient) - (trace symbolic-hessian) - (trace is-non-negative) - - (define hessian-mats (list - (symbolic-hessian (list-ref flux-exprs 0) cons-exprs) - (symbolic-hessian (list-ref flux-exprs 1) cons-exprs))) - (define hessian-eigvals (list - (symbolic-eigvals2 (list-ref hessian-mats 0)) - (symbolic-eigvals2 (list-ref hessian-mats 1)))) - (define hessian-eigvals-simp (list - (symbolic-simp (list-ref (list-ref hessian-eigvals 0) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals 0) 1)) - (symbolic-simp (list-ref (list-ref hessian-eigvals 1) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals 1) 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the flux function is convex, i.e. that the Hessian matrix for each flux component is positive semidefinite (otherwise, return false). - [(or (not (is-non-negative (list-ref hessian-eigvals-simp 0) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp 1) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp 2) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp 3) parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - (untrace symbolic-gradient) - (untrace symbolic-hessian) - (untrace is-non-negative) - - out) -(trace prove-lax-friedrichs-vector2-1d-local-lipschitz) - -;; ------------------------------------------------------------------------------------------------------------- -;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs -;; ------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector3-2d-hyperbolicity pde-system - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals3) - - (define flux-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) - (define flux-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) - (define flux-eigvals-simp-x (list - (symbolic-simp (list-ref flux-eigvals-x 0)) - (symbolic-simp (list-ref flux-eigvals-x 1)) - (symbolic-simp (list-ref flux-eigvals-x 2)))) - (define flux-eigvals-simp-y (list - (symbolic-simp (list-ref flux-eigvals-y 0)) - (symbolic-simp (list-ref flux-eigvals-y 1)) - (symbolic-simp (list-ref flux-eigvals-y 2)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the flux Jacobians are all real (otherwise, return false). - [(or (not (is-real (list-ref flux-eigvals-simp-x 0) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp-x 1) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp-x 2) cons-exprs parameters))) #f] - [(or (not (is-real (list-ref flux-eigvals-simp-y 0) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp-y 1) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp-y 2) cons-exprs parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals3) - - out) -(trace prove-lax-friedrichs-vector3-2d-hyperbolicity) - -;; -------------------------------------------------------------------------------------------------------------------- -;; Prove strict hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs -;; -------------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector3-2d-strict-hyperbolicity pde-system - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Prove that the Lax-Friedrichs finite-difference method preserves strict hyperbolicity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals3) - (trace is-non-zero) - (trace are-distinct) - - (define flux-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) - (define flux-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) - (define flux-eigvals-simp-x (list - (symbolic-simp (list-ref flux-eigvals-x 0)) - (symbolic-simp (list-ref flux-eigvals-x 1)) - (symbolic-simp (list-ref flux-eigvals-x 2)))) - (define flux-eigvals-simp-y (list - (symbolic-simp (list-ref flux-eigvals-y 0)) - (symbolic-simp (list-ref flux-eigvals-y 1)) - (symbolic-simp (list-ref flux-eigvals-y 2)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the flux Jacobians are all real (otherwise, return false). - [(or (not (is-real (list-ref flux-eigvals-simp-x 0) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp-x 1) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp-x 2) cons-exprs parameters))) #f] - [(or (not (is-real (list-ref flux-eigvals-simp-y 0) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp-y 1) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp-y 2) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the flux Jacobians are all distinct (otherwise, return false). - [(not (are-distinct (list (list-ref flux-eigvals-simp-x 0) (list-ref flux-eigvals-simp-x 1)) parameters)) #f] - [(not (are-distinct (list (list-ref flux-eigvals-simp-x 0) (list-ref flux-eigvals-simp-x 2)) parameters)) #f] - [(not (are-distinct (list (list-ref flux-eigvals-simp-x 1) (list-ref flux-eigvals-simp-x 2)) parameters)) #f] - [(not (are-distinct (list (list-ref flux-eigvals-simp-y 0) (list-ref flux-eigvals-simp-y 1)) parameters)) #f] - [(not (are-distinct (list (list-ref flux-eigvals-simp-y 0) (list-ref flux-eigvals-simp-y 2)) parameters)) #f] - [(not (are-distinct (list (list-ref flux-eigvals-simp-y 1) (list-ref flux-eigvals-simp-y 2)) parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals3) - (untrace is-non-zero) - (untrace are-distinct) - - out) -(trace prove-lax-friedrichs-vector3-2d-strict-hyperbolicity) - -;; ------------------------------------------------------------------------------------------------------------- -;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs -;; ------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector3-2d-cfl-stability pde-system - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 2D coupled vector system of 3 PDEs specified by `pde-system`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals3) - - (define flux-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) - (define flux-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) - (define max-speed-exprs-simp-x (list - (symbolic-simp (list-ref max-speed-exprs-x 0)) - (symbolic-simp (list-ref max-speed-exprs-x 1)) - (symbolic-simp (list-ref max-speed-exprs-x 2)))) - (define max-speed-exprs-simp-y (list - (symbolic-simp (list-ref max-speed-exprs-y 0)) - (symbolic-simp (list-ref max-speed-exprs-y 1)) - (symbolic-simp (list-ref max-speed-exprs-y 2)))) - (define flux-eigvals-simp-x (list - (symbolic-simp `(abs ,(list-ref flux-eigvals-x 0))) - (symbolic-simp `(abs ,(list-ref flux-eigvals-x 1))) - (symbolic-simp `(abs ,(list-ref flux-eigvals-x 2))))) - (define flux-eigvals-simp-y (list - (symbolic-simp `(abs ,(list-ref flux-eigvals-y 0))) - (symbolic-simp `(abs ,(list-ref flux-eigvals-y 1))) - (symbolic-simp `(abs ,(list-ref flux-eigvals-y 2))))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the absolute eigenvalues of the flux Jacobians are symbolically equivalent to the maximum wave-speed estimates (otherwise, return false). - [(or (equal? (member (list-ref flux-eigvals-simp-x 0) max-speed-exprs-simp-x) #f) - (equal? (member (list-ref flux-eigvals-simp-x 1) max-speed-exprs-simp-x) #f) - (equal? (member (list-ref flux-eigvals-simp-x 2) max-speed-exprs-simp-x) #f)) #f] - [(or (equal? (member (list-ref flux-eigvals-simp-y 0) max-speed-exprs-simp-y) #f) - (equal? (member (list-ref flux-eigvals-simp-y 1) max-speed-exprs-simp-y) #f) - (equal? (member (list-ref flux-eigvals-simp-y 2) max-speed-exprs-simp-y) #f)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals3) - - out) -(trace prove-lax-friedrichs-vector3-2d-cfl-stability) - -;; --------------------------------------------------------------------------------------------------------------------------------------------------------- -;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs -;; --------------------------------------------------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector3-2d-local-lipschitz pde-system - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals3) - (trace symbolic-gradient) - (trace symbolic-hessian) - (trace is-non-negative) - - (define hessian-mats-x (list - (symbolic-hessian (list-ref flux-exprs-x 0) cons-exprs) - (symbolic-hessian (list-ref flux-exprs-x 1) cons-exprs) - (symbolic-hessian (list-ref flux-exprs-x 2) cons-exprs))) - (define hessian-mats-y (list - (symbolic-hessian (list-ref flux-exprs-y 0) cons-exprs) - (symbolic-hessian (list-ref flux-exprs-y 1) cons-exprs) - (symbolic-hessian (list-ref flux-exprs-y 2) cons-exprs))) - (define hessian-eigvals-x (list - (symbolic-eigvals3 (list-ref hessian-mats-x 0)) - (symbolic-eigvals3 (list-ref hessian-mats-x 1)) - (symbolic-eigvals3 (list-ref hessian-mats-x 2)))) - (define hessian-eigvals-y (list - (symbolic-eigvals3 (list-ref hessian-mats-y 0)) - (symbolic-eigvals3 (list-ref hessian-mats-y 1)) - (symbolic-eigvals3 (list-ref hessian-mats-y 2)))) - (define hessian-eigvals-simp-x (list - (symbolic-simp (list-ref (list-ref hessian-eigvals-x 0) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-x 0) 1)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-x 0) 2)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-x 1) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-x 1) 1)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-x 1) 2)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-x 2) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-x 2) 1)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-x 2) 2)))) - (define hessian-eigvals-simp-y (list - (symbolic-simp (list-ref (list-ref hessian-eigvals-y 0) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-y 0) 1)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-y 0) 2)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-y 1) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-y 1) 1)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-y 1) 2)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-y 2) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-y 2) 1)) - (symbolic-simp (list-ref (list-ref hessian-eigvals-y 2) 2)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the flux functions are convex, i.e. that the Hessian matrices for each flux component are positive semidefinite (otherwise, return false). - [(or (not (is-non-negative (list-ref hessian-eigvals-simp-x 0) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-x 1) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp-x 2) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-x 3) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp-x 4) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-x 5) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp-x 6) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-x 7) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp-x 8) parameters))) #f] - [(or (not (is-non-negative (list-ref hessian-eigvals-simp-y 0) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-y 1) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp-y 2) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-y 3) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp-y 4) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-y 5) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp-y 6) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-y 7) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp-y 8) parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals3) - (untrace symbolic-gradient) - (untrace symbolic-hessian) - (untrace is-non-negative) - - out) -(trace prove-lax-friedrichs-vector3-2d-local-lipschitz) - -;; ---------------------------------------------------------------------------------------------- -;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; ---------------------------------------------------------------------------------------------- -(define (prove-roe-vector2-1d-hyperbolicity pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Roe finite-volume method preserves hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - (trace symbolic-roe-matrix) - (trace flux-deriv-replace) - - (define roe-matrix-eigvals (symbolic-eigvals2 (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs))) - (define roe-matrix-eigvals-simp (list - (symbolic-simp (list-ref roe-matrix-eigvals 0)) - (symbolic-simp (list-ref roe-matrix-eigvals 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the Roe matrix are all real (otherwise, return false). - [(or (not (is-real (list-ref roe-matrix-eigvals-simp 0) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters)) - (not (is-real (list-ref roe-matrix-eigvals-simp 1) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - (untrace symbolic-roe-matrix) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-vector2-1d-hyperbolicity) - -;; ----------------------------------------------------------------------------------------------------- -;; Prove strict hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; ----------------------------------------------------------------------------------------------------- -(define (prove-roe-vector2-1d-strict-hyperbolicity pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Roe finite-volume method preserves strict hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - (trace symbolic-roe-matrix) - (trace flux-deriv-replace) - (trace is-non-zero) - (trace are-distinct) - - (define roe-matrix-eigvals (symbolic-eigvals2 (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs))) - (define roe-matrix-eigvals-simp (list - (symbolic-simp (list-ref roe-matrix-eigvals 0)) - (symbolic-simp (list-ref roe-matrix-eigvals 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the Roe matrix are all real (otherwise, return false). - [(or (not (is-real (list-ref roe-matrix-eigvals-simp 0) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters)) - (not (is-real (list-ref roe-matrix-eigvals-simp 1) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters))) #f] - - ;; Check whether the eigenvalues of the Roe matrix are all distinct (otherwise, return false). - [(not (are-distinct roe-matrix-eigvals-simp parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - (untrace symbolic-roe-matrix) - (untrace flux-deriv-replace) - (untrace is-non-zero) - (untrace are-distinct) - - out) -(trace prove-roe-vector2-1d-strict-hyperbolicity) - -;; -------------------------------------------------------------------------------------------------------------------- -;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; -------------------------------------------------------------------------------------------------------------------- -(define (prove-roe-vector2-1d-flux-conservation pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-roe-matrix) - (trace flux-deriv-replace) - - (define roe-matrix (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs)) - (define cons-jump (list (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")))) - (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")))))) - - (define roe-jump (list (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix 0) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix 0) 1) ,(list-ref cons-jump 1)))) - (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix 1) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix 1) 1) ,(list-ref cons-jump 1)))))) - (define flux-jump (list (symbolic-simp `(- ,(flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs 0) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - ,(flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs 0) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))) - (symbolic-simp `(- ,(flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs 1) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - ,(flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs 1) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the jump in the flux vector is equal to the product of the Roe matrix and the jump in the conserved variable vector (otherwise, return false). - [(or (not (equal? (list-ref roe-jump 0) (list-ref flux-jump 0))) - (not (equal? (list-ref roe-jump 1) (list-ref flux-jump 1)))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-roe-matrix) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-vector2-1d-flux-conservation) - -;; ---------------------------------------------------------------------------------------------- -;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs -;; ---------------------------------------------------------------------------------------------- -(define (prove-roe-vector3-2d-hyperbolicity pde-system - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Prove that the Roe finite-volume method preserves hyperbolicity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals3) - (trace symbolic-roe-matrix) - (trace flux-deriv-replace) - - (define roe-matrix-eigvals-x (symbolic-eigvals3 (symbolic-roe-matrix (symbolic-jacobian flux-exprs-x cons-exprs) cons-exprs))) - (define roe-matrix-eigvals-y (symbolic-eigvals3 (symbolic-roe-matrix (symbolic-jacobian flux-exprs-y cons-exprs) cons-exprs))) - (define roe-matrix-eigvals-simp-x (list - (symbolic-simp (list-ref roe-matrix-eigvals-x 0)) - (symbolic-simp (list-ref roe-matrix-eigvals-x 1)) - (symbolic-simp (list-ref roe-matrix-eigvals-x 2)))) - (define roe-matrix-eigvals-simp-y (list - (symbolic-simp (list-ref roe-matrix-eigvals-y 0)) - (symbolic-simp (list-ref roe-matrix-eigvals-y 1)) - (symbolic-simp (list-ref roe-matrix-eigvals-y 2)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the Roe matrices are all real (otherwise, return false). - [(or (not (is-real (list-ref roe-matrix-eigvals-simp-x 0) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters)) - (not (is-real (list-ref roe-matrix-eigvals-simp-x 1) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters))) #f] - [(or (not (is-real (list-ref roe-matrix-eigvals-simp-y 0) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters)) - (not (is-real (list-ref roe-matrix-eigvals-simp-y 1) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals3) - (untrace symbolic-roe-matrix) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-vector3-2d-hyperbolicity) - -;; ----------------------------------------------------------------------------------------------------- -;; Prove strict hyperbolicity of the Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs -;; ----------------------------------------------------------------------------------------------------- -(define (prove-roe-vector3-2d-strict-hyperbolicity pde-system - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Prove that the Roe finite-volume method preserves strict hyperbolicity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals3) - (trace symbolic-roe-matrix) - (trace flux-deriv-replace) - (trace is-non-zero) - (trace are-distinct) - - (define roe-matrix-eigvals-x (symbolic-eigvals3 (symbolic-roe-matrix (symbolic-jacobian flux-exprs-x cons-exprs) cons-exprs))) - (define roe-matrix-eigvals-y (symbolic-eigvals3 (symbolic-roe-matrix (symbolic-jacobian flux-exprs-y cons-exprs) cons-exprs))) - (define roe-matrix-eigvals-simp-x (list - (symbolic-simp (list-ref roe-matrix-eigvals-x 0)) - (symbolic-simp (list-ref roe-matrix-eigvals-x 1)) - (symbolic-simp (list-ref roe-matrix-eigvals-x 2)))) - (define roe-matrix-eigvals-simp-y (list - (symbolic-simp (list-ref roe-matrix-eigvals-y 0)) - (symbolic-simp (list-ref roe-matrix-eigvals-y 1)) - (symbolic-simp (list-ref roe-matrix-eigvals-y 2)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the Roe matrices are all real (otherwise, return false). - [(or (not (is-real (list-ref roe-matrix-eigvals-simp-x 0) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters)) - (not (is-real (list-ref roe-matrix-eigvals-simp-x 1) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters))) #f] - [(or (not (is-real (list-ref roe-matrix-eigvals-simp-y 0) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters)) - (not (is-real (list-ref roe-matrix-eigvals-simp-y 1) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters))) #f] - - ;; Check whether the eigenvalues of the Roe matrices are all distinct (otherwise, return false). - [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-x 0) (list-ref roe-matrix-eigvals-simp-x 1)) parameters)) #f] - [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-x 0) (list-ref roe-matrix-eigvals-simp-x 2)) parameters)) #f] - [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-x 1) (list-ref roe-matrix-eigvals-simp-x 2)) parameters)) #f] - [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-y 0) (list-ref roe-matrix-eigvals-simp-y 1)) parameters)) #f] - [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-y 0) (list-ref roe-matrix-eigvals-simp-y 2)) parameters)) #f] - [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-y 1) (list-ref roe-matrix-eigvals-simp-y 2)) parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals3) - (untrace symbolic-roe-matrix) - (untrace flux-deriv-replace) - (untrace is-non-zero) - (untrace are-distinct) - - out) -(trace prove-roe-vector3-2d-strict-hyperbolicity) - -;; -------------------------------------------------------------------------------------------------------------------- -;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs -;; -------------------------------------------------------------------------------------------------------------------- -(define (prove-roe-vector3-2d-flux-conservation pde-system - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 2D coupled vector system of 3 PDEs specified by `pde-system`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-roe-matrix) - (trace flux-deriv-replace) - - (define roe-matrix-x (symbolic-roe-matrix (symbolic-jacobian flux-exprs-x cons-exprs) cons-exprs)) - (define roe-matrix-y (symbolic-roe-matrix (symbolic-jacobian flux-exprs-y cons-exprs) cons-exprs)) - (define cons-jump (list (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")))) - (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")))) - (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) - ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R")))))) - - (define roe-jump-x (list (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-x 0) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix-x 0) 1) ,(list-ref cons-jump 1)) - (* ,(list-ref (list-ref roe-matrix-x 0) 2) ,(list-ref cons-jump 2)))) - (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-x 1) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix-x 1) 1) ,(list-ref cons-jump 1)) - (* ,(list-ref (list-ref roe-matrix-x 1) 2) ,(list-ref cons-jump 1)))) - (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-x 2) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix-x 2) 1) ,(list-ref cons-jump 1)) - (* ,(list-ref (list-ref roe-matrix-x 2) 2) ,(list-ref cons-jump 1)))))) - (define roe-jump-y (list (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-y 0) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix-y 0) 1) ,(list-ref cons-jump 1)) - (* ,(list-ref (list-ref roe-matrix-y 0) 2) ,(list-ref cons-jump 2)))) - (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-y 1) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix-y 1) 1) ,(list-ref cons-jump 1)) - (* ,(list-ref (list-ref roe-matrix-y 1) 2) ,(list-ref cons-jump 1)))) - (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-y 2) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix-y 2) 1) ,(list-ref cons-jump 1)) - (* ,(list-ref (list-ref roe-matrix-y 2) 2) ,(list-ref cons-jump 1)))))) - (define flux-jump-x (list (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-x 0) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) - ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-x 0) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))) - (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-x 1) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) - ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-x 1) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))) - (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-x 2) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) - ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-x 2) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))))) - (define flux-jump-y (list (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-y 0) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) - ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-y 0) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))) - (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-y 1) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) - ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-y 1) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))) - (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-y 2) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) - ,(flux-deriv-replace (flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs-y 2) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) - (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the jumps in the flux vectors are equal to the products of the Roe matrices and the jumps in the conserved variable vector (otherwise, return false). - [(or (not (equal? (list-ref roe-jump-x 0) (list-ref flux-jump-x 0))) - (not (equal? (list-ref roe-jump-x 1) (list-ref flux-jump-x 1))) - (not (equal? (list-ref roe-jump-x 2) (list-ref flux-jump-x 2)))) #f] - [(or (not (equal? (list-ref roe-jump-y 0) (list-ref flux-jump-y 0))) - (not (equal? (list-ref roe-jump-y 1) (list-ref flux-jump-y 1))) - (not (equal? (list-ref roe-jump-y 2) (list-ref flux-jump-y 2)))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-roe-matrix) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-vector3-2d-flux-conservation) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_inviscid_burgers.rkt b/provable-algorithms/finite_volume/test_inviscid_burgers.rkt deleted file mode 100644 index 325a8663..00000000 --- a/provable-algorithms/finite_volume/test_inviscid_burgers.rkt +++ /dev/null @@ -1,448 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "code_generator_core_2d.rkt") -(require "prover_core.rkt") -(provide (all-from-out "code_generator_core.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D inviscid Burgers' equation: du/dt + u du/dx = 0. -(define pde-inviscid-burgers - (hash - 'name "inviscid-burgers" - 'cons-expr `u ; conserved variable: u - 'flux-expr `(* 0.5 u u) ; flux function: f(u) = 0.5 * u^2 - 'max-speed-expr `(abs u) ; local wave-speed: alpha = |u| - 'parameters `() - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.0) -(define x1 1.0) -(define t-final 0.5) -(define cfl 0.95) -(define init-func `(cond - [(< x 0.0) 1.0] - [else 0.0])) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-lax - (generate-lax-friedrichs-scalar-1d pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax))) - -(display "1D Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-hyperbolicity - (call-with-output-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-inviscid-burgers-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-cfl-stability - (call-with-output-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-cfl-stability pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-inviscid-burgers-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-local-lipschitz - (call-with-output-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-inviscid-burgers-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-roe - (generate-roe-scalar-1d pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe))) - -(display "1D Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-roe-hyperbolicity - (call-with-output-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-hyperbolicity pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-inviscid-burgers-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-roe-flux-conservation - (call-with-output-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-flux-conservation pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-inviscid-burgers-roe-flux-conservation) -(display "\n\n\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-inviscid-burgers-lax-minmod - (generate-lax-friedrichs-scalar-1d-second-order pde-inviscid-burgers limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-inviscid-burgers-roe-minmod - (generate-roe-scalar-1d-second-order pde-inviscid-burgers limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-minmod))) - -;; Define the 2D inviscid Burgers' equation: du/dt + u du/dx + u du/dy = 0. -(define pde-inviscid-burgers-2d - (hash - 'name "burgers-2d" - 'cons-expr `u ; conserved variable: u - 'flux-expr-x `(* 0.5 u u) ; x-flux function: f(u) = 0.5 * u^2 - 'flux-expr-y `(* 0.5 u u) ; y-flux function: f(u) = 0.5 * u^2 - 'max-speed-expr-x `(abs u) ; local wave-speed: alpha_x = |u| - 'max-speed-expr-y `(abs u) ; local wave-speed: alpha_y = |u| - 'parameters `() - )) - -;; Define 2D simulation parameters. -(define nx-2d 100) -(define ny-2d 100) -(define x0-2d 0.0) -(define x1-2d 2.0) -(define y0-2d 0.0) -(define y1-2d 2.0) -(define t-final-2d 0.5) -(define cfl-2d 0.95) -(define init-func-2d `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 2.0] - [else 0.0])) - -;; Synthesize the code for a Lax-Friedrichs solver for the 2D inviscid Burgers' equation. -(define code-inviscid-burgers-lax-2d - (generate-lax-friedrichs-scalar-2d pde-inviscid-burgers-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-2d))) - -(display "2D Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 2D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-hyperbolicity-2d - (call-with-output-file "proofs/proof_inviscid_burgers_lax_hyperbolicity_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-2d-hyperbolicity pde-inviscid-burgers-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_hyperbolicity_2d.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-inviscid-burgers-lax-hyperbolicity-2d) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 2D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-cfl-stability-2d - (call-with-output-file "proofs/proof_inviscid_burgers_lax_cfl_stability_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-2d-cfl-stability pde-inviscid-burgers-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_cfl_stability_2d.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-inviscid-burgers-lax-cfl-stability-2d) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 2D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-local-lipschitz-2d - (call-with-output-file "proofs/proof_inviscid_burgers_lax_local_lipschitz_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-2d-local-lipschitz pde-inviscid-burgers-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_local_lipschitz_2d.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-inviscid-burgers-lax-local-lipschitz-2d) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 2D inviscid Burgers' equation. -(define code-inviscid-burgers-roe-2d - (generate-roe-scalar-2d pde-inviscid-burgers-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-2d))) - -(display "2D Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 2D inviscid Burgers' equation. -(define proof-inviscid-burgers-roe-hyperbolicity-2d - (call-with-output-file "proofs/proof_inviscid_burgers_roe_hyperbolicity_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-2d-hyperbolicity pde-inviscid-burgers-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_hyperbolicity_2d.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-inviscid-burgers-roe-hyperbolicity-2d) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 2D inviscid Burgers' equation. -(define proof-inviscid-burgers-roe-flux-conservation-2d - (call-with-output-file "proofs/proof_inviscid_burgers_roe_flux_conservation_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-2d-flux-conservation pde-inviscid-burgers-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_flux_conservation_2d.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-inviscid-burgers-roe-flux-conservation-2d) -(display "\n") - -;; Synthesize the code for a Lax-Friedrichs solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-inviscid-burgers-lax-minmod-2d - (generate-lax-friedrichs-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax_minmod_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-minmod-2d))) - -;; Synthesize the code for a Roe solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-inviscid-burgers-roe-minmod-2d - (generate-roe-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe_minmod_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-minmod-2d))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_isothermal_euler_2d.rkt b/provable-algorithms/finite_volume/test_isothermal_euler_2d.rkt deleted file mode 100644 index 2340836f..00000000 --- a/provable-algorithms/finite_volume/test_isothermal_euler_2d.rkt +++ /dev/null @@ -1,350 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "code_generator_vector_2d.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "code_generator_core.rkt")) -(provide (all-from-out "code_generator_vector_2d.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 2D isothermal Euler equations (density, x-momentum and y-momentum components). -(define pde-system-isothermal-euler-2d - (hash - 'name "isothermal-euler-2d" - 'cons-exprs (list - `rho - `mom_x - `mom_y) ; conserved variables: density, x-momentum, y-momentum - 'flux-exprs-x (list - `mom_x - `(+ (/ (* mom_x mom_x) rho) (* rho vt vt)) - `(* mom_y (/ mom_x rho))) ; x-flux vector - 'flux-exprs-y (list - `mom_y - `(* mom_x (/ mom_y rho)) - `(+ (/ (* mom_y mom_y) rho) (* rho vt vt))) ; y-flux vector - 'max-speed-exprs-x (list - `(abs (- (/ mom_x rho) vt)) - `(abs (/ mom_x rho)) - `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds (x-direction) - 'max-speed-exprs-y (list - `(abs (- (/ mom_y rho) vt)) - `(abs (/ mom_y rho)) - `(abs (+ (/ mom_y rho) vt))) ; local wave-speeds (y-direction) - 'parameters (list - `(define vt 1.0)) ; thermal velocity: vt = 1.0 - )) - -;; Define 2D simulation parameters. -(define nx-2d 50) -(define ny-2d 50) -(define x0-2d 0.0) -(define x1-2d 2.0) -(define y0-2d 0.0) -(define y1-2d 2.0) -(define t-final-2d 0.2) -(define cfl-2d 0.9) -(define init-funcs-2d (list - `(cond - [(> y 1.0) - (cond - [(< x 1.0) 0.5323] - [else 1.5])] - [else - (cond - [(< x 1.0) 0.138] - [else 0.5323])]) - `(cond - [(> y 1.0) - (cond - [(< x 1.0) 1.206] - [else 0.0])] - [else - (cond - [(< x 1.0) 1.206] - [else 0.0])]) - `(cond - [(> y 1.0) - (cond - [(< x 1.0) 0.0] - [else 0.0])] - [else - (cond - [(< x 1.0) 1.206] - [else 1.206])]))) - -;; Synthesize the code for a Lax-Friedrichs solver for the 2D isothermal Euler equations. -(define code-isothermal-euler-lax-2d - (generate-lax-friedrichs-vector3-2d pde-system-isothermal-euler-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_lax_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-lax-2d))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 2D isothermal Euler equations. -(define proof-isothermal-euler-lax-hyperbolicity-2d - (call-with-output-file "proofs/proof_isothermal_euler_lax_hyperbolicity_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector3-2d-hyperbolicity pde-system-isothermal-euler-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_lax_hyperbolicity_2d.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-lax-hyperbolicity-2d) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 2D isothermal Euler equations. -(define proof-isothermal-euler-lax-strict-hyperbolicity-2d - (call-with-output-file "proofs/proof_isothermal_euler_lax_strict_hyperbolicity_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector3-2d-strict-hyperbolicity pde-system-isothermal-euler-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_lax_strict_hyperbolicity_2d.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-lax-strict-hyperbolicity-2d) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 2D isothermal Euler equations. -(define proof-isothermal-euler-lax-cfl-stability-2d - (call-with-output-file "proofs/proof_isothermal_euler_lax_cfl_stability_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector3-2d-cfl-stability pde-system-isothermal-euler-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_lax_cfl_stability_2d.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-isothermal-euler-lax-cfl-stability-2d) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 2D isothermal Euler equations. -(define proof-isothermal-euler-lax-local-lipschitz-2d - (call-with-output-file "proofs/proof_isothermal_euler_lax_local_lipschitz_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector3-2d-local-lipschitz pde-system-isothermal-euler-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_lax_local_lipschitz_2d.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-isothermal-euler-lax-local-lipschitz-2d) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 2D isothermal Euler equations. -(define code-isothermal-euler-roe-2d - (generate-roe-vector3-2d pde-system-isothermal-euler-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_roe_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-roe-2d))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 2D isothermal Euler equations. -(define proof-isothermal-euler-roe-hyperbolicity-2d - (call-with-output-file "proofs/proof_isothermal_euler_roe_hyperbolicity_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector3-2d-hyperbolicity pde-system-isothermal-euler-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_roe_hyperbolicity_2d.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-roe-hyperbolicity-2d) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 2D isothermal Euler equations. -(define proof-isothermal-euler-roe-strict-hyperbolicity-2d - (call-with-output-file "proofs/proof_isothermal_euler_roe_strict_hyperbolicity_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector3-2d-strict-hyperbolicity pde-system-isothermal-euler-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_roe_strict_hyperbolicity_2d.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-roe-strict-hyperbolicity-2d) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 2D isothermal Euler equations. -(define proof-isothermal-euler-roe-flux-conservation-2d - (call-with-output-file "proofs/proof_isothermal_euler_roe_flux_conservation_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector3-2d-flux-conservation pde-system-isothermal-euler-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_roe_flux_conservation_2d.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-isothermal-euler-roe-flux-conservation-2d) -(display "\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter). -(define code-isothermal-euler-lax-minmod-2d - (generate-lax-friedrichs-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_lax_minmod_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-lax-minmod-2d))) - -;; Synthesize the code for a Roe solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter). -(define code-isothermal-euler-roe-minmod-2d - (generate-roe-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_roe_minmod_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-roe-minmod-2d))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_linear_advection.rkt b/provable-algorithms/finite_volume/test_linear_advection.rkt deleted file mode 100644 index d5b892a8..00000000 --- a/provable-algorithms/finite_volume/test_linear_advection.rkt +++ /dev/null @@ -1,451 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "code_generator_core_2d.rkt") -(require "prover_core.rkt") -(provide (all-from-out "code_generator_core.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D linear advection equation: du/dt + d(au)/dx = 0. -(define pde-linear-advection - (hash - 'name "linear-advection" - 'cons-expr `u ; conserved variable: u - 'flux-expr `(* a u) ; flux function: f(u) = a * u - 'max-speed-expr `(abs a) ; local wave-speed: alpha = |a| - 'parameters (list - `(define a 1.0)) ; advection speed: a = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 0.0) -(define x1 2.0) -(define t-final 0.5) -(define cfl 0.95) -(define init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D linear advection equation. -(define code-linear-advection-lax - (generate-lax-friedrichs-scalar-1d pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax))) - -(display "1D Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D linear advection equation. -(define proof-linear-advection-lax-hyperbolicity - (call-with-output-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-linear-advection-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D linear advection equation. -(define proof-linear-advection-lax-cfl-stability - (call-with-output-file "proofs/proof_linear_advection_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-cfl-stability pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-linear-advection-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D linear advection equation. -(define proof-linear-advection-lax-local-lipschitz - (call-with-output-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-linear-advection-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D linear advection equation. -(define code-linear-advection-roe - (generate-roe-scalar-1d pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe))) - -(display "1D Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D linear advection equation. -(define proof-linear-advection-roe-hyperbolicity - (call-with-output-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-hyperbolicity pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-linear-advection-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D linear advection equation. -(define proof-linear-advection-roe-flux-conservation - (call-with-output-file "proofs/proof_linear_advection_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-flux-conservation pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-linear-advection-roe-flux-conservation) -(display "\n\n\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-linear-advection-lax-minmod - (generate-lax-friedrichs-scalar-1d-second-order pde-linear-advection limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-linear-advection-roe-minmod - (generate-roe-scalar-1d-second-order pde-linear-advection limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-minmod))) - -;; Define the 2D linear advection equation: du/dt + d(au)/dx + d(bu)/dy = 0. -(define pde-linear-advection-2d - (hash - 'name "linear-advection-2d" - 'cons-expr `u ; conserved variable: u - 'flux-expr-x `(* a u) ; x-flux function: f(u) = a * u - 'flux-expr-y `(* b u) ; y-flux function: f(u) = b * u - 'max-speed-expr-x `(abs a) ; local x wave-speed: alpha_x = |a| - 'max-speed-expr-y `(abs b) ; local y wave-speed: alpha_y = |b| - 'parameters (list - `(define a 1.0) - `(define b 1.0)) ; advection speesd: a = 1.0, b = 1.0 - )) - -;; Define 2D simulation parameters. -(define nx-2d 100) -(define ny-2d 100) -(define x0-2d 0.0) -(define x1-2d 2.0) -(define y0-2d 0.0) -(define y1-2d 2.0) -(define t-final-2d 0.5) -(define cfl-2d 0.95) -(define init-func-2d `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 1.0] - [else 0.0])) - -;; Synthesize the code for a Lax-Friedrichs solver for the 2D linear advection equation. -(define code-linear-advection-lax-2d - (generate-lax-friedrichs-scalar-2d pde-linear-advection-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-2d))) - -(display "2D Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 2D linear advection equation. -(define proof-linear-advection-lax-hyperbolicity-2d - (call-with-output-file "proofs/proof_linear_advection_lax_hyperbolicity_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-2d-hyperbolicity pde-linear-advection-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_hyperbolicity_2d.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-linear-advection-lax-hyperbolicity-2d) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 2D linear advection equation. -(define proof-linear-advection-lax-cfl-stability-2d - (call-with-output-file "proofs/proof_linear_advection_lax_cfl_stability_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-2d-cfl-stability pde-linear-advection-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_cfl_stability_2d.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-linear-advection-lax-cfl-stability-2d) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 2D linear advection equation. -(define proof-linear-advection-lax-local-lipschitz-2d - (call-with-output-file "proofs/proof_linear_advection_lax_local_lipschitz_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-2d-local-lipschitz pde-linear-advection-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_local_lipschitz_2d.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-linear-advection-lax-local-lipschitz-2d) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 2D linear advection equation. -(define code-linear-advection-roe-2d - (generate-roe-scalar-2d pde-linear-advection-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-2d))) - -(display "2D Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 2D linear advection equation. -(define proof-linear-advection-roe-hyperbolicity-2d - (call-with-output-file "proofs/proof_linear_advection_roe_hyperbolicity_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-2d-hyperbolicity pde-linear-advection-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_hyperbolicity_2d.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-linear-advection-roe-hyperbolicity-2d) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 2D linear advection equation. -(define proof-linear-advection-roe-flux-conservation-2d - (call-with-output-file "proofs/proof_linear_advection_roe_flux_conservation_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-2d-flux-conservation pde-linear-advection-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_flux_conservation_2d.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-linear-advection-roe-flux-conservation-2d) -(display "\n") - -;; Synthesize the code for a Lax-Friedrichs solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-linear-advection-lax-minmod-2d - (generate-lax-friedrichs-scalar-2d-second-order pde-linear-advection-2d limiter-minmod - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax_minmod_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-minmod-2d))) - -;; Synthesize the code for a Roe solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-linear-advection-roe-minmod-2d - (generate-roe-scalar-2d-second-order pde-linear-advection-2d limiter-minmod - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe_minmod_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-minmod-2d))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_code_generator_lax.rkt b/provable-algorithms/gkyl_code_generator_lax.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_code_generator_lax.rkt rename to provable-algorithms/gkyl_code_generator_lax.rkt diff --git a/provable-algorithms/finite_volume/gkyl_code_generator_lax_vector.rkt b/provable-algorithms/gkyl_code_generator_lax_vector.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_code_generator_lax_vector.rkt rename to provable-algorithms/gkyl_code_generator_lax_vector.rkt diff --git a/provable-algorithms/finite_volume/gkyl_code_generator_roe.rkt b/provable-algorithms/gkyl_code_generator_roe.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_code_generator_roe.rkt rename to provable-algorithms/gkyl_code_generator_roe.rkt diff --git a/provable-algorithms/finite_volume/gkyl_code_generator_roe_vector.rkt b/provable-algorithms/gkyl_code_generator_roe_vector.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_code_generator_roe_vector.rkt rename to provable-algorithms/gkyl_code_generator_roe_vector.rkt diff --git a/provable-algorithms/finite_volume/gkyl_test_inviscid_burgers.rkt b/provable-algorithms/gkyl_test_inviscid_burgers.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_test_inviscid_burgers.rkt rename to provable-algorithms/gkyl_test_inviscid_burgers.rkt diff --git a/provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_x.rkt b/provable-algorithms/gkyl_test_isothermal_euler_mom_x.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_x.rkt rename to provable-algorithms/gkyl_test_isothermal_euler_mom_x.rkt diff --git a/provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_yz.rkt b/provable-algorithms/gkyl_test_isothermal_euler_mom_yz.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_yz.rkt rename to provable-algorithms/gkyl_test_isothermal_euler_mom_yz.rkt diff --git a/provable-algorithms/finite_volume/gkyl_test_limiters.rkt b/provable-algorithms/gkyl_test_limiters.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_test_limiters.rkt rename to provable-algorithms/gkyl_test_limiters.rkt diff --git a/provable-algorithms/finite_volume/gkyl_test_linear_advection.rkt b/provable-algorithms/gkyl_test_linear_advection.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_test_linear_advection.rkt rename to provable-algorithms/gkyl_test_linear_advection.rkt diff --git a/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Bx_psi.rkt b/provable-algorithms/gkyl_test_maxwell_1d_Bx_psi.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Bx_psi.rkt rename to provable-algorithms/gkyl_test_maxwell_1d_Bx_psi.rkt diff --git a/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ex_phi.rkt b/provable-algorithms/gkyl_test_maxwell_1d_Ex_phi.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ex_phi.rkt rename to provable-algorithms/gkyl_test_maxwell_1d_Ex_phi.rkt diff --git a/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ey_Bz.rkt b/provable-algorithms/gkyl_test_maxwell_1d_Ey_Bz.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ey_Bz.rkt rename to provable-algorithms/gkyl_test_maxwell_1d_Ey_Bz.rkt diff --git a/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ez_By.rkt b/provable-algorithms/gkyl_test_maxwell_1d_Ez_By.rkt similarity index 100% rename from provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ez_By.rkt rename to provable-algorithms/gkyl_test_maxwell_1d_Ez_By.rkt diff --git a/provable-algorithms/neural_networks/code_generator_core_training.rkt b/provable-algorithms/neural_networks/code_generator_core_training.rkt deleted file mode 100644 index d11c189d..00000000 --- a/provable-algorithms/neural_networks/code_generator_core_training.rkt +++ /dev/null @@ -1,1415 +0,0 @@ -#lang racket - -(require "prover_core.rkt") -(provide convert-expr - remove-bracketed-expressions - remove-bracketed-expressions-from-file - flux-substitute - train-lax-friedrichs-scalar-1d - train-lax-friedrichs-scalar-1d-second-order - train-roe-scalar-1d - train-roe-scalar-1d-second-order) - -;; Lightweight converter from Racket expressions (expr) into strings representing equivalent C code. -(define (convert-expr expr) - (match expr - ;; If expr is a symbol, then convert it directly to a string. - [(? symbol? symb) (symbol->string symb)] - - ;; If expr is a numerical constant, then convert it directly to a string. - [(? number? num) (number->string num)] - - ;; If expr is a sum of the form (+ expr1 expr2 ...), then convert it to "(expr1 + expr2 + ...)" in C. - [`(+ . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " + ") ")"))] - ;; Likewise for differences. - [`(- . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " - ") ")"))] - - ;; If expr is a product of the form (* expr1 expr2 ...), then convert it to "(expr1 * expr2 * ...)" in C. - [`(* . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " * ") ")"))] - ;; Likewise for quotients. - [`(/ . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " / ") ")"))] - - ;; If expr is an absolute value of the form (abs expr1), then convert it to "fabs(expr1)" in C. - [`(abs ,arg) - (format "fabs(~a)" (convert-expr arg))] - - ;; If expr is a square root of the form (sqrt expr1), then convert it to "sqrt(expr1)" in C. - [`(sqrt ,arg) - (format "sqrt(~a)" (convert-expr arg))] - - ;; If expr is a maximum of the form (max expr1 expr2), then convert it to "fmax(expr1, expr2)" in C. - [`(max ,arg1 ,arg2) - (format "fmax(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a maximum of the form (max expr1 expr2 expr2), then convert it to "fmax(expr1, expr2, expr3)" in C. - [`(max ,arg1 ,arg2 ,arg3) - (format "fmax3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] - - ;; If expr is a minimum of the form (max expr1 expr2), then convert it to "fmin(expr1, expr2)" in C. - [`(min ,arg1 ,arg2) - (format "fmin(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a minimum of the form (max expr1 expr2 expr2), then convert it to "fmin(expr1, expr2, expr3)" in C. - [`(min ,arg1 ,arg2 ,arg3) - (format "fmin3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] - - ;; If expr is a variable assignment of the form (define expr1 expr2), then convert it to "expr1 = expr2" in C. - [`(define ,arg1 ,arg2) - (format "~a = ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a strict comparison of the form (< expr1 expr2), then convert it to "expr1 < expr2" in C. - [`(< ,arg1 ,arg2) - (format "~a < ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a comparison of the form (<= expr1 expr2), then convert it to "expr1 <= expr2" in C. - [`(<= ,arg1 ,arg2) - (format "~a <= ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a strict comparison of the form (> expr1 expr2), then convert it to "expr1 > expr2" in C. - [`(> ,arg1 ,arg2) - (format "~a > ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a comparison of the form (>= expr1 expr2), then convert it to "expr1 >= expr2" in C. - [`(>= ,arg1 ,arg2) - (format "~a >= ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a logical conjunction of the form (and expr1 expr2), then convert it to "expr1 && expr2" in C. - [`(and ,arg1 ,arg2) - (format "~a && ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is an equality comparison of the form (equal? expr1 expr2), then convert it to "expr1 == expr2" in C. - [`(equal? ,arg1 ,arg2) - (format "~a == ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a conditional of the form [(cond [cond1 expr1] [else expr2])], then convert it to the ternary operator "(cond1) ? expr1 : expr2" in C. - [`(cond - [,cond1 ,expr1] - [else ,expr2]) - (format "(~a) ? ~a : ~a" (convert-expr cond1) (convert-expr expr1) (convert-expr expr2))])) - -;; A simple boilerplate function for removing bracketed expressions from strings. -(define (remove-bracketed-expressions str) - (regexp-replace* #rx"\\[.*?\\]" str "")) - -;; A simple boilerplate function for removing bracketed expressions from files. -(define (remove-bracketed-expressions-from-file output-file) - (define content - (with-input-from-file output-file - (lambda () - (port->string (current-input-port))))) - (define cleaned - (remove-bracketed-expressions content)) - (with-output-to-file output-file #:exists 'replace - (lambda () - (display cleaned)))) - -(define (flux-substitute flux-expr cons-expr var-name) - (string-replace flux-expr cons-expr var-name)) - -;; ------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------------- -(define (train-lax-friedrichs-scalar-1d pde neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that trains a surrogate solver for the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define flux-um (flux-substitute flux-code cons-code "um")) - (define flux-ui (flux-substitute flux-code cons-code "ui")) - (define flux-up (flux-substitute flux-code cons-code "up")) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a scalar PDE in 1D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * sizeof(double)); - double *un = (double*) malloc((nx + 2) * sizeof(double)); - - // Arrays for storing training data. - float **input_data = (float**) malloc(nx * num_trains * sizeof(float*)); - float **output_data = (float**) malloc(nx * num_trains * sizeof(float*)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[i] = ~a; // init-func in C. - un[i] = ~a; // init-func in C. - } - - // Initialize neural network architecture. - kad_node_t *t_net; - kann_t *ann; - t_net = kann_layer_input(2); - - for (int i = 0; i < nn_depth; i++) { - t_net = kann_layer_dense(t_net, nn_width); - t_net = kad_tanh(t_net); - } - - t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); - ann = kann_new(t_net, 0); - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable. - for (int i = 1; i <= nx; i++) { - double um = u[i - 1]; - double ui = u[i]; - double up = u[i + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um = ~a; // f(u_{i - 1}). - double f_ui = ~a; // f(u_i). - double f_up = ~a; // f(u_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * alpha * (u_i - u_{i - 1}). - double fluxL = 0.5 * (f_um + f_ui) - 0.5 * alpha * (ui - um); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * alpha * (u_{i + 1} - u_i). - double fluxR = 0.5 * (f_ui + f_up) - 0.5 * alpha * (up - ui); - - // Update the conserved variable. - un[i] = ui - (dt / dx) * (fluxR - fluxL); - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - u[i] = un[i]; - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[1]; - u[nx + 1] = u[nx]; - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - - input_data[(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); - output_data[(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); - - input_data[(n * nx) + (i - 1)][0] = t; - input_data[(n * nx) + (i - 1)][1] = x; - output_data[(n * nx) + (i - 1)][0] = u[i]; - } - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - kann_mt(ann, num_threads, mini_size); - kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data, output_data); - - // Output neural network to disk. - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - kann_save(file_nm, ann); - - free(u); - free(un); - - kann_delete(ann); - - for (int i = 0; i < nx * num_trains; i++) { - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expression for local wave-speed estimate. - max-speed-local - ;; Left flux f(u_{i - 1}). - flux-um - ;; Middle flux f(u_i). - flux-ui - ;; Right flux f(u_{i + 1}). - flux-up - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Scalar PDE with a Second-Order Flux Extrapolation -;; ---------------------------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-scalar-1d-second-order pde limiter neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that trains a surrogate solver for the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method with a second-order flux extrapolation - using the flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umL (flux-substitute flux-code cons-code "umL")) - (define flux-umR (flux-substitute flux-code cons-code "umR")) - (define flux-uiL (flux-substitute flux-code cons-code "uiL")) - (define flux-uiR (flux-substitute flux-code cons-code "uiR")) - (define flux-upL (flux-substitute flux-code cons-code "upL")) - (define flux-upR (flux-substitute flux-code cons-code "upR")) - - (define flux-umR-evol (flux-substitute flux-code cons-code "umR_evol")) - (define flux-uiL-evol (flux-substitute flux-code cons-code "uiL_evol")) - (define flux-uiR-evol (flux-substitute flux-code cons-code "uiR_evol")) - (define flux-upL-evol (flux-substitute flux-code cons-code "upL_evol")) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a scalar PDE in 1D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Array for storing slopes. - double *slope = (double*) malloc((nx + 4) * sizeof(double)); - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * sizeof(double)); - double *un = (double*) malloc((nx + 4) * sizeof(double)); - - // Arrays for storing training data. - float **input_data = (float**) malloc(nx * num_trains * sizeof(float*)); - float **output_data = (float**) malloc(nx * num_trains * sizeof(float*)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[i] = ~a; // init-func in C. - un[i] = ~a; // init-func in C. - } - - // Initialize neural network architecture. - kad_node_t *t_net; - kann_t *ann; - t_net = kann_layer_input(2); - - for (int i = 0; i < nn_depth; i++) { - t_net = kann_layer_dense(t_net, nn_width); - t_net = kad_tanh(t_net); - } - - t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); - ann = kann_new(t_net, 0); - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - double r = (u[i] - u[i - 1]) / (u[i + 1] - u[i]); - double limiter = ~a; // limiter-r in C. - - slope[i] = limiter * (0.5 * ((u[i] - u[i - 1]) + (u[i + 1] - u[i]))); - } - - // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable. - for (int i = 2; i <= nx + 1; i++) { - // Extrapolate boundary states. - double umL = u[i - 1] - (0.5 * slope[i - 1]); - double umR = u[i - 1] + (0.5 * slope[i - 1]); - - double uiL = u[i] - (0.5 * slope[i]); - double uiR = u[i] + (0.5 * slope[i]); - - double upL = u[i + 1] - (0.5 * slope[i + 1]); - double upR = u[i + 1] + (0.5 * slope[i + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL = ~a; - double f_umR = ~a; - - double f_uiL = ~a; - double f_uiR = ~a; - - double f_upL = ~a; - double f_upR = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol = umR + ((dt / (2.0 * dx)) * (f_umL - f_umR)); - - double uiL_evol = uiL + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); - double uiR_evol = uiR + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); - - double upL_evol = upL + ((dt / (2.0 * dx)) * (f_upL - f_upR)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol = ~a; - double f_uiL_evol = ~a; - - double f_uiR_evol = ~a; - double f_upL_evol = ~a; - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * alpha * (u_{i, L+} - u_{i - 1, R+}). - double fluxL = 0.5 * (f_umR_evol + f_uiL_evol) - 0.5 * alpha * (uiL_evol - umR_evol); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * alpha * (u_{i + 1, L+} - u_{i, R+}). - double fluxR = 0.5 * (f_uiR_evol + f_upL_evol) - 0.5 * alpha * (upL_evol - uiR_evol); - - // Update the conserved variable. - un[i] = u[i] - (dt / dx) * (fluxR - fluxL); - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - u[i] = un[i]; - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[2]; - u[1] = u[2]; - u[nx + 2] = u[nx + 1]; - u[nx + 3] = u[nx + 1]; - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - - input_data[(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); - output_data[(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); - - input_data[(n * nx) + (i - 2)][0] = t; - input_data[(n * nx) + (i - 2)][1] = x; - output_data[(n * nx) + (i - 2)][0] = u[i]; - } - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - kann_mt(ann, num_threads, mini_size); - kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data, output_data); - - // Output neural network to disk. - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - kann_save(file_nm, ann); - - free(u); - free(un); - - kann_delete(ann); - - for (int i = 0; i < nx * num_trains; i++) { - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expression for local wave-speed estimate. - max-speed-local - ;; Expression for flux limiter function. - limiter-r - ;; Left negative flux f(u_{i - 1, L}). - flux-umL - ;; Right negative flux f(u_{i - 1, R}). - flux-umR - ;; Left central flux f(u_{i, L}). - flux-uiL - ;; Right central flux f(u_{i, R}). - flux-uiR - ;; Left positive flux f(u_{i + 1, L}). - flux-upL - ;; Right positive flux f(u_{i + 1, R}). - flux-upR - ;; Evolved right negative flux f(u_{i - 1, R+}). - flux-umR-evol - ;; Evolved left central flux f(u_{i, L+}). - flux-uiL-evol - ;; Evolved right central flux f(u_{i, R+}). - flux-uiR-evol - ;; Evolved left positive flux f(u_{i + 1, L+}). - flux-upL-evol - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ---------------------------------------------------------------- -;; Train a Roe (Finite-Volume) Surrogate Solver for a 1D Scalar PDE -;; ---------------------------------------------------------------- -(define (train-roe-scalar-1d pde neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that trains a surrogate solver for the 1D scalar PDE specified by `pde` using the Roe finite-volume method, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define flux-deriv-code (convert-expr flux-deriv)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define flux-um (flux-substitute flux-code cons-code "um")) - (define flux-ui (flux-substitute flux-code cons-code "ui")) - (define flux-up (flux-substitute flux-code cons-code "up")) - - (define flux-deriv-um (flux-substitute flux-deriv-code cons-code "um")) - (define flux-deriv-ui (flux-substitute flux-deriv-code cons-code "ui")) - (define flux-deriv-up (flux-substitute flux-deriv-code cons-code "up")) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a -// Train a Roe higher-order finite-volume surrogate solver for a scalar PDE in 1D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * sizeof(double)); - double *un = (double*) malloc((nx + 2) * sizeof(double)); - - // Arrays for storing training data. - float **input_data = (float**) malloc(nx * num_trains * sizeof(float*)); - float **output_data = (float**) malloc(nx * num_trains * sizeof(float*)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[i] = ~a; // init-func in C. - un[i] = ~a; // init-func in C. - } - - // Initialize neural network architecture. - kad_node_t *t_net; - kann_t *ann; - t_net = kann_layer_input(2); - - for (int i = 0; i < nn_depth; i++) { - t_net = kann_layer_dense(t_net, nn_width); - t_net = kad_tanh(t_net); - } - - t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); - ann = kann_new(t_net, 0); - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Roe approximation and update the conserved variable. - for (int i = 1; i <= nx; i++) { - double um = u[i - 1]; - double ui = u[i]; - double up = u[i + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um = ~a; // f(u_{i - 1}). - double f_ui = ~a; // f(u_i). - double f_up = ~a; // f(u_{i + 1}). - - // Evaluate flux derivative for each value of the conserved variable. - double f_deriv_um = ~a; // f'(u_{i - 1}). - double f_deriv_ui = ~a; // f'(u_i). - double f_deriv_up = ~a; // f'(u_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * |aL_roe| * (u_i - u_{i - 1}). - double aL_roe = 0.5 * (f_deriv_um + f_deriv_ui); - double fluxL = 0.5 * (f_um + f_ui) - 0.5 * fabs(aL_roe) * (ui - um); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * |aR_roe| * (u_{i + 1} - u_i). - double aR_roe = 0.5 * (f_deriv_ui + f_deriv_up); - double fluxR = 0.5 * (f_ui + f_up) - 0.5 * fabs(aR_roe) * (up - ui); - - // Update the conserved variable. - un[i] = ui - (dt / dx) * (fluxR - fluxL); - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - u[i] = un[i]; - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[1]; - u[nx + 1] = u[nx]; - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - - input_data[(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); - output_data[(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); - - input_data[(n * nx) + (i - 1)][0] = t; - input_data[(n * nx) + (i - 1)][1] = x; - output_data[(n * nx) + (i - 1)][0] = u[i]; - } - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - kann_mt(ann, num_threads, mini_size); - kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data, output_data); - - // Output neural network to disk. - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - kann_save(file_nm, ann); - - free(u); - free(un); - - kann_delete(ann); - - for (int i = 0; i < nx * num_trains; i++) { - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expression for local wave-speed estimate. - max-speed-local - ;; Left flux f(u_{i - 1}). - flux-um - ;; Middle flux f(u_i). - flux-ui - ;; Right flux f(u_{i + 1}). - flux-up - ;; Left flux derivative f'(u_{i - 1}). - flux-deriv-um - ;; Middle flux derivative f'(u_i). - flux-deriv-ui - ;; Right flux derivative f'(u_{i + 1}). - flux-deriv-up - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------------------- -;; Train a Roe (Finite-Volume) Surrogate Solver for a 1D Scalar PDE with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------------------------- -(define (train-roe-scalar-1d-second-order pde limiter neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that trains a surrogate solver for the 1D scalar PDE specified by `pde` using the Roe finite-volume method with a second-order flux extrapolation - using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define flux-deriv-code (convert-expr flux-deriv)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umL (flux-substitute flux-code cons-code "umL")) - (define flux-umR (flux-substitute flux-code cons-code "umR")) - (define flux-uiL (flux-substitute flux-code cons-code "uiL")) - (define flux-uiR (flux-substitute flux-code cons-code "uiR")) - (define flux-upL (flux-substitute flux-code cons-code "upL")) - (define flux-upR (flux-substitute flux-code cons-code "upR")) - - (define flux-umR-evol (flux-substitute flux-code cons-code "umR_evol")) - (define flux-uiL-evol (flux-substitute flux-code cons-code "uiL_evol")) - (define flux-uiR-evol (flux-substitute flux-code cons-code "uiR_evol")) - (define flux-upL-evol (flux-substitute flux-code cons-code "upL_evol")) - - (define flux-deriv-umR-evol (flux-substitute flux-deriv-code cons-code "umR_evol")) - (define flux-deriv-uiL-evol (flux-substitute flux-deriv-code cons-code "uiL_evol")) - (define flux-deriv-uiR-evol (flux-substitute flux-deriv-code cons-code "uiR_evol")) - (define flux-deriv-upL-evol (flux-substitute flux-deriv-code cons-code "upL_evol")) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Train a Roe higher-order finite-volume surrogate solver for a scalar PDE in 1D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Array for storing slopes. - double *slope = (double*) malloc((nx + 4) * sizeof(double)); - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * sizeof(double)); - double *un = (double*) malloc((nx + 4) * sizeof(double)); - - // Arrays for storing training data. - float **input_data = (float**) malloc(nx * num_trains * sizeof(float*)); - float **output_data = (float**) malloc(nx * num_trains * sizeof(float*)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[i] = ~a; // init-func in C. - un[i] = ~a; // init-func in C. - } - - // Initialize neural network architecture. - kad_node_t *t_net; - kann_t *ann; - t_net = kann_layer_input(2); - - for (int i = 0; i < nn_depth; i++) { - t_net = kann_layer_dense(t_net, nn_width); - t_net = kad_tanh(t_net); - } - - t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); - ann = kann_new(t_net, 0); - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - double r = (u[i] - u[i - 1]) / (u[i + 1] - u[i]); - double limiter = ~a; // limiter-r in C. - - slope[i] = limiter * (0.5 * ((u[i] - u[i - 1]) + (u[i + 1] - u[i]))); - } - - // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable. - for (int i = 2; i <= nx + 1; i++) { - // Extrapolate boundary states. - double umL = u[i - 1] - (0.5 * slope[i - 1]); - double umR = u[i - 1] + (0.5 * slope[i - 1]); - - double uiL = u[i] - (0.5 * slope[i]); - double uiR = u[i] + (0.5 * slope[i]); - - double upL = u[i + 1] - (0.5 * slope[i + 1]); - double upR = u[i + 1] + (0.5 * slope[i + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL = ~a; - double f_umR = ~a; - - double f_uiL = ~a; - double f_uiR = ~a; - - double f_upL = ~a; - double f_upR = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol = umR + ((dt / (2.0 * dx)) * (f_umL - f_umR)); - - double uiL_evol = uiL + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); - double uiR_evol = uiR + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); - - double upL_evol = upL + ((dt / (2.0 * dx)) * (f_upL - f_upR)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol = ~a; - double f_uiL_evol = ~a; - - double f_uiR_evol = ~a; - double f_upL_evol = ~a; - - // Evaluate flux derivative for each value of the (evolved) conserved variable. - double f_deriv_umR_evol = ~a; - double f_deriv_uiL_evol = ~a; - - double f_deriv_uiR_evol = ~a; - double f_deriv_upL_evol = ~a; - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * |aL_roe| * (u_{i, L+} - u_{i - 1, R+}). - double aL_roe = 0.5 * (f_deriv_umR_evol + f_deriv_uiL_evol); - double fluxL = 0.5 * (f_umR_evol + f_uiL_evol) - 0.5 * fabs(aL_roe) * (uiL_evol - umR_evol); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * |aR_roe| * (u_{i + 1, L+} - u_{i, R+}). - double aR_roe = 0.5 * (f_deriv_uiR_evol + f_deriv_upL_evol); - double fluxR = 0.5 * (f_uiR_evol + f_upL_evol) - 0.5 * fabs(aR_roe) * (upL_evol - uiR_evol); - - // Update the conserved variable. - un[i] = u[i] - (dt / dx) * (fluxR - fluxL); - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - u[i] = un[i]; - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[2]; - u[1] = u[2]; - u[nx + 2] = u[nx + 1]; - u[nx + 3] = u[nx + 1]; - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - - input_data[(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); - output_data[(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); - - input_data[(n * nx) + (i - 2)][0] = t; - input_data[(n * nx) + (i - 2)][1] = x; - output_data[(n * nx) + (i - 2)][0] = u[i]; - } - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - kann_mt(ann, num_threads, mini_size); - kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data, output_data); - - // Output neural network to disk. - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - kann_save(file_nm, ann); - - free(u); - free(un); - free(slope); - - kann_delete(ann); - - for (int i = 0; i < nx * num_trains; i++) { - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expression for local wave-speed estimate. - max-speed-local - ;; Expression for flux limiter function. - limiter-r - ;; Left negative flux f(u_{i - 1, L}). - flux-umL - ;; Right negative flux f(u_{i - 1, R}). - flux-umR - ;; Left central flux f(u_{i, L}). - flux-uiL - ;; Right central flux f(u_{i, R}). - flux-uiR - ;; Left positive flux f(u_{i + 1, L}). - flux-upL - ;; Right positive flux f(u_{i + 1, R}). - flux-upR - ;; Evolved right negative flux f(u_{i - 1, R+}). - flux-umR-evol - ;; Evolved left central flux f(u_{i, L+}). - flux-uiL-evol - ;; Evolved right central flux f(u_{i, R+}). - flux-uiR-evol - ;; Evolved left positive flux f(u_{i + 1, L+}). - flux-upL-evol - ;; Evolved right negative flux derivative f'(u_{i - 1, R+}). - flux-deriv-umR-evol - ;; Evolved left central flux derivative f'(u_{i, L+}). - flux-deriv-uiL-evol - ;; Evolved right central flux derivative f'(u_{i, R+}). - flux-deriv-uiR-evol - ;; Evolved left positive flux derivative f'(u_{i + 1, L+}). - flux-deriv-upL-evol - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_core_training_2d.rkt b/provable-algorithms/neural_networks/code_generator_core_training_2d.rkt deleted file mode 100644 index 8939319c..00000000 --- a/provable-algorithms/neural_networks/code_generator_core_training_2d.rkt +++ /dev/null @@ -1,2325 +0,0 @@ -#lang racket - -(require "prover_core.rkt") -(require "code_generator_core_training.rkt") -(provide train-lax-friedrichs-scalar-2d - train-lax-friedrichs-scalar-2d-second-order - train-roe-scalar-2d - train-roe-scalar-2d-second-order) - -;; ------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Scalar PDE -;; ------------------------------------------------------------------------------- -(define (train-lax-friedrichs-scalar-2d pde neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that trains a surrogate solver for the 2D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-code (convert-expr cons-expr)) - (define flux-code-x (convert-expr flux-expr-x)) - (define flux-code-y (convert-expr flux-expr-y)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define flux-um-x (flux-substitute flux-code-x cons-code "um_x")) - (define flux-ui-x (flux-substitute flux-code-x cons-code "ui_x")) - (define flux-up-x (flux-substitute flux-code-x cons-code "up_x")) - - (define flux-um-y (flux-substitute flux-code-y cons-code "um_y")) - (define flux-ui-y (flux-substitute flux-code-y cons-code "ui_y")) - (define flux-up-y (flux-substitute flux-code-y cons-code "up_y")) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a scalar PDE in 2D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - double **un = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * sizeof(double)); - un[i] = (double*) malloc((ny + 2) * sizeof(double)); - } - - // Arrays for storing training data. - float **input_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - float **output_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][j] = ~a; // init-func in C. - un[i][j] = ~a; // init-func in C. - } - } - - // Initialize neural network architecture. - kad_node_t *t_net; - kann_t *ann; - t_net = kann_layer_input(3); - - for (int i = 0; i < nn_depth; i++) { - t_net = kann_layer_dense(t_net, nn_width); - t_net = kad_tanh(t_net); - } - - t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); - ann = kann_new(t_net, 0); - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_y = u[i][j - 1]; - double ui_y = u[i][j]; - double up_y = u[i][j + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um_y = ~a; // f(u_{j - 1}). - double f_ui_y = ~a; // f(u_j). - double f_up_y = ~a; // f(u_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * alpha_y * (u_j - u_{j - 1}). - double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * alpha_y * (ui_y - um_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * alpha_y * (u_{j + 1} - u_j). - double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * alpha_y * (up_y - ui_y); - - // Update the conserved variable. - un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the x-direction. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_x = u[i - 1][j]; - double ui_x = u[i][j]; - double up_x = u[i + 1][j]; - - // Evaluate flux for each value of the conserved variable. - double f_um_x = ~a; // f(u_{i - 1}). - double f_ui_x = ~a; // f(u_i). - double f_up_x = ~a; // f(u_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * alpha_x * (u_i - u_{i - 1}). - double fluxL_x = 0.5 * (f_um_x + f_ui_x) - 0.5 * alpha_x * (ui_x - um_x); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * alpha_x * (u_{i + 1} - u_i). - double fluxR_x = 0.5 * (f_ui_x + f_up_x) - 0.5 * alpha_x * (up_x - ui_x); - - // Update the conserved variable. - un[i][j] = ui_x - (dt / dx) * (fluxR_x - fluxL_x); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_y = u[i][j - 1]; - double ui_y = u[i][j]; - double up_y = u[i][j + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um_y = ~a; // f(u_{j - 1}). - double f_ui_y = ~a; // f(u_j). - double f_up_y = ~a; // f(u_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * alpha_y * (u_j - u_{j - 1}). - double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * alpha_y * (ui_y - um_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * alpha_y * (u_{j + 1} - u_j). - double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * alpha_y * (up_y - ui_y); - - // Update the conserved variable. - un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j<= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); - output_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); - - input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; - input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; - input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; - output_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][j]; - } - } - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - kann_mt(ann, num_threads, mini_size); - kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data, output_data); - - // Output neural network to disk. - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - kann_save(file_nm, ann); - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - free(un[i]); - } - free(u); - free(un); - - kann_delete(ann); - - for (int i = 0; i < nx * ny * num_trains; i++) { - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). - flux-um-y - flux-ui-y - flux-up-y - ;; Left, middle, right fluxes in x-direction f(u_{i - 1}), f(u_i), f(u_{i + 1}). - flux-um-x - flux-ui-x - flux-up-x - ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). - flux-um-y - flux-ui-y - flux-up-y - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Scalar PDE with a Second-Order Flux Extrapolation -;; ---------------------------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-scalar-2d-second-order pde limiter neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that trains a surrogate solver for the 2D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method with a second-order flux extrapolation - using the flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-code (convert-expr cons-expr)) - (define flux-code-x (convert-expr flux-expr-x)) - (define flux-code-y (convert-expr flux-expr-y)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umL-x (flux-substitute flux-code-x cons-code "umL_x")) - (define flux-umR-x (flux-substitute flux-code-x cons-code "umR_x")) - (define flux-uiL-x (flux-substitute flux-code-x cons-code "uiL_x")) - (define flux-uiR-x (flux-substitute flux-code-x cons-code "uiR_x")) - (define flux-upL-x (flux-substitute flux-code-x cons-code "upL_x")) - (define flux-upR-x (flux-substitute flux-code-x cons-code "upR_x")) - - (define flux-umR-evol-x (flux-substitute flux-code-x cons-code "umR_evol_x")) - (define flux-uiL-evol-x (flux-substitute flux-code-x cons-code "uiL_evol_x")) - (define flux-uiR-evol-x (flux-substitute flux-code-x cons-code "uiR_evol_x")) - (define flux-upL-evol-x (flux-substitute flux-code-x cons-code "upL_evol_x")) - - (define flux-umL-y (flux-substitute flux-code-y cons-code "umL_y")) - (define flux-umR-y (flux-substitute flux-code-y cons-code "umR_y")) - (define flux-uiL-y (flux-substitute flux-code-y cons-code "uiL_y")) - (define flux-uiR-y (flux-substitute flux-code-y cons-code "uiR_y")) - (define flux-upL-y (flux-substitute flux-code-y cons-code "upL_y")) - (define flux-upR-y (flux-substitute flux-code-y cons-code "upR_y")) - - (define flux-umR-evol-y (flux-substitute flux-code-y cons-code "umR_evol_y")) - (define flux-uiL-evol-y (flux-substitute flux-code-y cons-code "uiL_evol_y")) - (define flux-uiR-evol-y (flux-substitute flux-code-y cons-code "uiR_evol_y")) - (define flux-upL-evol-y (flux-substitute flux-code-y cons-code "upL_evol_y")) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a scalar PDE in 2D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing slopes. - double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); - double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - slope_x[i] = (double*) malloc((ny + 4) * sizeof(double)); - slope_y[i] = (double*) malloc((ny + 4) * sizeof(double)); - } - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - double **un = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * sizeof(double)); - un[i] = (double*) malloc((ny + 4) * sizeof(double)); - } - - // Arrays for storing training data. - float **input_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - float **output_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][j] = ~a; // init-func in C. - un[i][j] = ~a; // init-func in C. - } - } - - // Initialize neural network architecture. - kad_node_t *t_net; - kann_t *ann; - t_net = kann_layer_input(3); - - for (int i = 0; i < nn_depth; i++) { - t_net = kann_layer_dense(t_net, nn_width); - t_net = kad_tanh(t_net); - } - - t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); - ann = kann_new(t_net, 0); - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); - } - } - - // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); - double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); - - double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); - double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); - - double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); - double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_y = ~a; - double f_umR_y = ~a; - - double f_uiL_y = ~a; - double f_uiR_y = ~a; - - double f_upL_y = ~a; - double f_upR_y = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); - - double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - - double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_y = ~a; - double f_uiL_evol_y = ~a; - - double f_uiR_evol_y = ~a; - double f_upL_evol_y = ~a; - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * alpha * (u_{j, L+} - u_{j - 1, R+}). - double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * alpha_y * (uiL_evol_y - umR_evol_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * alpha * (u_{j + 1, L+} - u_{j, R+}). - double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * alpha_y * (upL_evol_y - uiR_evol_y); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i - 1][j]) / (u[i + 1][j] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_x[i][j] = limiter * (0.5 * ((u[i][j] - u[i - 1][j]) + (u[i + 1][j] - u[i][j]))); - } - } - - // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the x-direction. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_x = u[i - 1][j] - (0.5 * slope_x[i - 1][j]); - double umR_x = u[i - 1][j] + (0.5 * slope_x[i - 1][j]); - - double uiL_x = u[i][j] - (0.5 * slope_x[i][j]); - double uiR_x = u[i][j] + (0.5 * slope_x[i][j]); - - double upL_x = u[i + 1][j] - (0.5 * slope_x[i + 1][j]); - double upR_x = u[i + 1][j] + (0.5 * slope_x[i + 1][j]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_x = ~a; - double f_umR_x = ~a; - - double f_uiL_x = ~a; - double f_uiR_x = ~a; - - double f_upL_x = ~a; - double f_upR_x = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_x = umR_x + ((dt / (2.0 * dx)) * (f_umL_x - f_umR_x)); - - double uiL_evol_x = uiL_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); - double uiR_evol_x = uiR_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); - - double upL_evol_x = upL_x + ((dt / (2.0 * dx)) * (f_upL_x - f_upR_x)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_x = ~a; - double f_uiL_evol_x = ~a; - - double f_uiR_evol_x = ~a; - double f_upL_evol_x = ~a; - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * alpha * (u_{i, L+} - u_{i - 1, R+}). - double fluxL_x = 0.5 * (f_umR_evol_x + f_uiL_evol_x) - 0.5 * alpha_x * (uiL_evol_x - umR_evol_x); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * alpha * (u_{i + 1, L+} - u_{i, R+}). - double fluxR_x = 0.5 * (f_uiR_evol_x + f_upL_evol_x) - 0.5 * alpha_x * (upL_evol_x - uiR_evol_x); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / dx) * (fluxR_x - fluxL_x); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); - } - } - - // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); - double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); - - double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); - double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); - - double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); - double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_y = ~a; - double f_umR_y = ~a; - - double f_uiL_y = ~a; - double f_uiR_y = ~a; - - double f_upL_y = ~a; - double f_upR_y = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); - - double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - - double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_y = ~a; - double f_uiL_evol_y = ~a; - - double f_uiR_evol_y = ~a; - double f_upL_evol_y = ~a; - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * alpha * (u_{j, L+} - u_{j - 1, R+}). - double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * alpha_y * (uiL_evol_y - umR_evol_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * alpha * (u_{j + 1, L+} - u_{j, R+}). - double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * alpha_y * (upL_evol_y - uiR_evol_y); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); - output_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); - - input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; - input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; - input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; - output_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][j]; - } - } - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - kann_mt(ann, num_threads, mini_size); - kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data, output_data); - - // Output neural network to disk. - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - kann_save(file_nm, ann); - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - free(un[i]); - free(slope_x[i]); - free(slope_y[i]); - } - free(u); - free(un); - free(slope_x); - free(slope_y); - - kann_delete(ann); - - for (int i = 0; i < nx * num_trains; i++) { - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). - flux-umL-y - flux-umR-y - ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). - flux-uiL-y - flux-uiR-y - ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). - flux-upL-y - flux-upR-y - ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). - flux-umR-evol-y - ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). - flux-uiL-evol-y - flux-uiR-evol-y - ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). - flux-upL-evol-y - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in x-direction f(u_{i - 1, L}), f(u_{i - 1, R}). - flux-umL-x - flux-umR-x - ;; Left/right central fluxes in x-direction f(u_{i, L}), f(u_{i, R}). - flux-uiL-x - flux-uiR-x - ;; Left/right positive fluxes in x-direction f(u_{i + 1, L}), f(u_{i + 1, R}). - flux-upL-x - flux-upR-x - ;; Evolved right negative flux in x-direction f(u_{i - 1, R+}). - flux-umR-evol-x - ;; Evolved left/right central fluxes in x-direction f(u_{i, L+}), f(u_{i, R+}). - flux-uiL-evol-x - flux-uiR-evol-x - ;; Evolved left positive flux in x-direction f(u_{i + 1, L+}). - flux-upL-evol-x - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). - flux-umL-y - flux-umR-y - ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). - flux-uiL-y - flux-uiR-y - ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). - flux-upL-y - flux-upR-y - ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). - flux-umR-evol-y - ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). - flux-uiL-evol-y - flux-uiR-evol-y - ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). - flux-upL-evol-y - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ---------------------------------------------------------------- -;; Train a Roe (Finite-Volume) Surrogate Solver for a 2D Scalar PDE -;; ---------------------------------------------------------------- -(define (train-roe-scalar-2d pde neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that trains a surrogate solver for the 2D scalar PDE specified by `pde` using the Roe finite-volume method, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) - (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) - - (define cons-code (convert-expr cons-expr)) - (define flux-code-x (convert-expr flux-expr-x)) - (define flux-code-y (convert-expr flux-expr-y)) - (define flux-deriv-code-x (convert-expr flux-deriv-x)) - (define flux-deriv-code-y (convert-expr flux-deriv-y)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define flux-um-x (flux-substitute flux-code-x cons-code "um_x")) - (define flux-ui-x (flux-substitute flux-code-x cons-code "ui_x")) - (define flux-up-x (flux-substitute flux-code-x cons-code "up_x")) - - (define flux-um-y (flux-substitute flux-code-y cons-code "um_y")) - (define flux-ui-y (flux-substitute flux-code-y cons-code "ui_y")) - (define flux-up-y (flux-substitute flux-code-y cons-code "up_y")) - - (define flux-deriv-um-x (flux-substitute flux-deriv-code-x cons-code "um_x")) - (define flux-deriv-ui-x (flux-substitute flux-deriv-code-x cons-code "ui_x")) - (define flux-deriv-up-x (flux-substitute flux-deriv-code-x cons-code "up_x")) - - (define flux-deriv-um-y (flux-substitute flux-deriv-code-y cons-code "um_y")) - (define flux-deriv-ui-y (flux-substitute flux-deriv-code-y cons-code "ui_y")) - (define flux-deriv-up-y (flux-substitute flux-deriv-code-y cons-code "up_y")) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a -// Train a Roe higher-order finite-volume surrogate solver for a scalar PDE in 2D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - double **un = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * sizeof(double)); - un[i] = (double*) malloc((ny + 2) * sizeof(double)); - } - - // Arrays for storing training data. - float **input_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - float **output_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][j] = ~a; // init-func in C. - un[i][j] = ~a; // init-func in C. - } - } - - // Initialize neural network architecture. - kad_node_t *t_net; - kann_t *ann; - t_net = kann_layer_input(3); - - for (int i = 0; i < nn_depth; i++) { - t_net = kann_layer_dense(t_net, nn_width); - t_net = kad_tanh(t_net); - } - - t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); - ann = kann_new(t_net, 0); - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Roe approximation and update the conserved variable in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_y = u[i][j - 1]; - double ui_y = u[i][j]; - double up_y = u[i][j + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um_y = ~a; // f(u_{j - 1}). - double f_ui_y = ~a; // f(u_j). - double f_up_y = ~a; // f(u_{j + 1}). - - // Evaluate flux derivative for each value of the conserved variable. - double f_deriv_um_y = ~a; // f'(u_{j - 1}). - double f_deriv_ui_y = ~a; // f'(u_j). - double f_deriv_up_y = ~a; // f'(u_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * |aL_roe_y| * (u_j - u_{j - 1}). - double aL_roe_y = 0.5 * (f_deriv_um_y + f_deriv_ui_y); - double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * fabs(aL_roe_y) * (ui_y - um_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * |aR_roe_y| * (u_{j + 1} - u_j). - double aR_roe_y = 0.5 * (f_deriv_ui_y + f_deriv_up_y); - double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * fabs(aR_roe_y) * (up_y - ui_y); - - // Update the conserved variable. - un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Compute fluxes with Roe approximation and update the conserved variable in the x-direction. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_x = u[i - 1][j]; - double ui_x = u[i][j]; - double up_x = u[i + 1][j]; - - // Evaluate flux for each value of the conserved variable. - double f_um_x = ~a; // f(u_{i - 1}). - double f_ui_x = ~a; // f(u_i). - double f_up_x = ~a; // f(u_{i + 1}). - - // Evaluate flux derivative for each value of the conserved variable. - double f_deriv_um_x = ~a; // f'(u_{i - 1}). - double f_deriv_ui_x = ~a; // f'(u_i). - double f_deriv_up_x = ~a; // f'(u_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * |aL_roe_x| * (u_i - u_{i - 1}). - double aL_roe_x = 0.5 * (f_deriv_um_x + f_deriv_ui_x); - double fluxL_x = 0.5 * (f_um_x + f_ui_x) - 0.5 * fabs(aL_roe_x) * (ui_x - um_x); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * |aR_roe_x| * (u_{i + 1} - u_i). - double aR_roe_x = 0.5 * (f_deriv_ui_x + f_deriv_up_x); - double fluxR_x = 0.5 * (f_ui_x + f_up_x) - 0.5 * fabs(aR_roe_x) * (up_x - ui_x); - - // Update the conserved variable. - un[i][j] = ui_x - (dt / dx) * (fluxR_x - fluxL_x); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Compute fluxes with Roe approximation and update the conserved variable in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double um_y = u[i][j - 1]; - double ui_y = u[i][j]; - double up_y = u[i][j + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um_y = ~a; // f(u_{j - 1}). - double f_ui_y = ~a; // f(u_j). - double f_up_y = ~a; // f(u_{j + 1}). - - // Evaluate flux derivative for each value of the conserved variable. - double f_deriv_um_y = ~a; // f'(u_{j - 1}). - double f_deriv_ui_y = ~a; // f'(u_j). - double f_deriv_up_y = ~a; // f'(u_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * |aL_roe_y| * (u_j - u_{j - 1}). - double aL_roe_y = 0.5 * (f_deriv_um_y + f_deriv_ui_y); - double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * fabs(aL_roe_y) * (ui_y - um_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * |aR_roe_y| * (u_{j + 1} - u_j). - double aR_roe_y = 0.5 * (f_deriv_ui_y + f_deriv_up_y); - double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * fabs(aR_roe_y) * (up_y - ui_y); - - // Update the conserved variable. - un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - - un[0][j] = un[1][j]; - un[nx + 1][j] = un[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - - un[i][0] = un[i][1]; - un[i][ny + 1] = un[i][ny]; - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j<= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); - output_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); - - input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; - input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; - input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; - output_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][j]; - } - } - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - kann_mt(ann, num_threads, mini_size); - kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data, output_data); - - // Output neural network to disk. - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - kann_save(file_nm, ann); - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - free(un[i]); - } - free(u); - free(un); - - kann_delete(ann); - - for (int i = 0; i < nx * ny * num_trains; i++) { - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). - flux-um-y - flux-ui-y - flux-up-y - ;; Left, middle, right flux derivatives in y-direction f'(u_{j - 1}), f'(u_j), f'(u_{j + 1}). - flux-deriv-um-y - flux-deriv-ui-y - flux-deriv-up-y - ;; Left, middle, right fluxes in x-direction f(u_{i - 1}), f(u_i), f(u_{i + 1}). - flux-um-x - flux-ui-x - flux-up-x - ;; Left, middle, right flux derivatives in x-direction f'(u_{i - 1}), f'(u_i), f'(u_{i + 1}). - flux-deriv-um-x - flux-deriv-ui-x - flux-deriv-up-x - ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). - flux-um-y - flux-ui-y - flux-up-y - ;; Left, middle, right flux derivatives in y-direction f'(u_{j - 1}), f'(u_j), f'(u_{j + 1}). - flux-deriv-um-y - flux-deriv-ui-y - flux-deriv-up-y - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------------------- -;; Train a Roe (Finite-Volume) Surrogate Solver for a 2D Scalar PDE with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------------------------- -(define (train-roe-scalar-2d-second-order pde limiter neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that trains a surrogate solver for the 2D scalar PDE specified by `pde` using the Roe finite-volume method with a second-order flux extrapolation - using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) - (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) - - (define cons-code (convert-expr cons-expr)) - (define flux-code-x (convert-expr flux-expr-x)) - (define flux-code-y (convert-expr flux-expr-y)) - (define flux-deriv-code-x (convert-expr flux-deriv-x)) - (define flux-deriv-code-y (convert-expr flux-deriv-y)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umL-x (flux-substitute flux-code-x cons-code "umL_x")) - (define flux-umR-x (flux-substitute flux-code-x cons-code "umR_x")) - (define flux-uiL-x (flux-substitute flux-code-x cons-code "uiL_x")) - (define flux-uiR-x (flux-substitute flux-code-x cons-code "uiR_x")) - (define flux-upL-x (flux-substitute flux-code-x cons-code "upL_x")) - (define flux-upR-x (flux-substitute flux-code-x cons-code "upR_x")) - - (define flux-umR-evol-x (flux-substitute flux-code-x cons-code "umR_evol_x")) - (define flux-uiL-evol-x (flux-substitute flux-code-x cons-code "uiL_evol_x")) - (define flux-uiR-evol-x (flux-substitute flux-code-x cons-code "uiR_evol_x")) - (define flux-upL-evol-x (flux-substitute flux-code-x cons-code "upL_evol_x")) - - (define flux-deriv-umR-evol-x (flux-substitute flux-deriv-code-x cons-code "umR_evol_x")) - (define flux-deriv-uiL-evol-x (flux-substitute flux-deriv-code-x cons-code "uiL_evol_x")) - (define flux-deriv-uiR-evol-x (flux-substitute flux-deriv-code-x cons-code "uiR_evol_x")) - (define flux-deriv-upL-evol-x (flux-substitute flux-deriv-code-x cons-code "upL_evol_x")) - - (define flux-umL-y (flux-substitute flux-code-y cons-code "umL_y")) - (define flux-umR-y (flux-substitute flux-code-y cons-code "umR_y")) - (define flux-uiL-y (flux-substitute flux-code-y cons-code "uiL_y")) - (define flux-uiR-y (flux-substitute flux-code-y cons-code "uiR_y")) - (define flux-upL-y (flux-substitute flux-code-y cons-code "upL_y")) - (define flux-upR-y (flux-substitute flux-code-y cons-code "upR_y")) - - (define flux-umR-evol-y (flux-substitute flux-code-y cons-code "umR_evol_y")) - (define flux-uiL-evol-y (flux-substitute flux-code-y cons-code "uiL_evol_y")) - (define flux-uiR-evol-y (flux-substitute flux-code-y cons-code "uiR_evol_y")) - (define flux-upL-evol-y (flux-substitute flux-code-y cons-code "upL_evol_y")) - - (define flux-deriv-umR-evol-y (flux-substitute flux-deriv-code-y cons-code "umR_evol_y")) - (define flux-deriv-uiL-evol-y (flux-substitute flux-deriv-code-y cons-code "uiL_evol_y")) - (define flux-deriv-uiR-evol-y (flux-substitute flux-deriv-code-y cons-code "uiR_evol_y")) - (define flux-deriv-upL-evol-y (flux-substitute flux-deriv-code-y cons-code "upL_evol_y")) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Train a Roe higher-order finite-volume surrogate solver for a scalar PDE in 2D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing slopes. - double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); - double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - slope_x[i] = (double*) malloc((ny + 4) * sizeof(double)); - slope_y[i] = (double*) malloc((ny + 4) * sizeof(double)); - } - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - double **un = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * sizeof(double)); - un[i] = (double*) malloc((ny + 4) * sizeof(double)); - } - - // Arrays for storing training data. - float **input_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - float **output_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][j] = ~a; // init-func in C. - un[i][j] = ~a; // init-func in C. - } - } - - // Initialize neural network architecture. - kad_node_t *t_net; - kann_t *ann; - t_net = kann_layer_input(3); - - for (int i = 0; i < nn_depth; i++) { - t_net = kann_layer_dense(t_net, nn_width); - t_net = kad_tanh(t_net); - } - - t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); - ann = kann_new(t_net, 0); - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); - } - } - - // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); - double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); - - double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); - double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); - - double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); - double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_y = ~a; - double f_umR_y = ~a; - - double f_uiL_y = ~a; - double f_uiR_y = ~a; - - double f_upL_y = ~a; - double f_upR_y = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); - - double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - - double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_y = ~a; - double f_uiL_evol_y = ~a; - - double f_uiR_evol_y = ~a; - double f_upL_evol_y = ~a; - - // Evaluate flux derivative for each value of the (evolved) conserved variable. - double f_deriv_umR_evol_y = ~a; - double f_deriv_uiL_evol_y = ~a; - - double f_deriv_uiR_evol_y = ~a; - double f_deriv_upL_evol_y = ~a; - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * |aL_roe_y| * (u_{j, L+} - u_{j - 1, R+}). - double aL_roe_y = 0.5 * (f_deriv_umR_evol_y + f_deriv_uiL_evol_y); - double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * fabs(aL_roe_y) * (uiL_evol_y - umR_evol_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * |aR_roe_y| * (u_{j + 1, L+} - u_{j, R+}). - double aR_roe_y = 0.5 * (f_deriv_uiR_evol_y + f_deriv_upL_evol_y); - double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * fabs(aR_roe_y) * (upL_evol_y - uiR_evol_y); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i - 1][j]) / (u[i + 1][j] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_x[i][j] = limiter * (0.5 * ((u[i][j] - u[i - 1][j]) + (u[i + 1][j] - u[i][j]))); - } - } - - // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the x-direction. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_x = u[i - 1][j] - (0.5 * slope_x[i - 1][j]); - double umR_x = u[i - 1][j] + (0.5 * slope_x[i - 1][j]); - - double uiL_x = u[i][j] - (0.5 * slope_x[i][j]); - double uiR_x = u[i][j] + (0.5 * slope_x[i][j]); - - double upL_x = u[i + 1][j] - (0.5 * slope_x[i + 1][j]); - double upR_x = u[i + 1][j] + (0.5 * slope_x[i + 1][j]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_x = ~a; - double f_umR_x = ~a; - - double f_uiL_x = ~a; - double f_uiR_x = ~a; - - double f_upL_x = ~a; - double f_upR_x = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_x = umR_x + ((dt / (2.0 * dx)) * (f_umL_x - f_umR_x)); - - double uiL_evol_x = uiL_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); - double uiR_evol_x = uiR_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); - - double upL_evol_x = upL_x + ((dt / (2.0 * dx)) * (f_upL_x - f_upR_x)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_x = ~a; - double f_uiL_evol_x = ~a; - - double f_uiR_evol_x = ~a; - double f_upL_evol_x = ~a; - - // Evaluate flux derivative for each value of the (evolved) conserved variable. - double f_deriv_umR_evol_x = ~a; - double f_deriv_uiL_evol_x = ~a; - - double f_deriv_uiR_evol_x = ~a; - double f_deriv_upL_evol_x = ~a; - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * |aL_roe_x| * (u_{i, L+} - u_{i - 1, R+}). - double aL_roe_x = 0.5 * (f_deriv_umR_evol_x + f_deriv_uiL_evol_x); - double fluxL_x = 0.5 * (f_umR_evol_x + f_uiL_evol_x) - 0.5 * fabs(aL_roe_x) * (uiL_evol_x - umR_evol_x); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * |aR_roe_x| * (u_{i + 1, L+} - u_{i, R+}). - double aR_roe_x = 0.5 * (f_deriv_uiR_evol_x + f_deriv_upL_evol_x); - double fluxR_x = 0.5 * (f_uiR_evol_x + f_upL_evol_x) - 0.5 * fabs(aR_roe_x) * (upL_evol_x - uiR_evol_x); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / dx) * (fluxR_x - fluxL_x); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); - } - } - - // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - // Extrapolate boundary states. - double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); - double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); - - double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); - double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); - - double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); - double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL_y = ~a; - double f_umR_y = ~a; - - double f_uiL_y = ~a; - double f_uiR_y = ~a; - - double f_upL_y = ~a; - double f_upR_y = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); - - double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); - - double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol_y = ~a; - double f_uiL_evol_y = ~a; - - double f_uiR_evol_y = ~a; - double f_upL_evol_y = ~a; - - // Evaluate flux derivative for each value of the (evolved) conserved variable. - double f_deriv_umR_evol_y = ~a; - double f_deriv_uiL_evol_y = ~a; - - double f_deriv_uiR_evol_y = ~a; - double f_deriv_upL_evol_y = ~a; - - // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * |aL_roe_y| * (u_{j, L+} - u_{j - 1, R+}). - double aL_roe_y = 0.5 * (f_deriv_umR_evol_y + f_deriv_uiL_evol_y); - double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * fabs(aL_roe_y) * (uiL_evol_y - umR_evol_y); - - // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * |aR_roe_y| * (u_{j + 1, L+} - u_{j, R+}). - double aR_roe_y = 0.5 * (f_deriv_uiR_evol_y + f_deriv_upL_evol_y); - double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * fabs(aR_roe_y) * (upL_evol_y - uiR_evol_y); - - // Update the conserved variable. - un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); - } - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - u[i][j] = un[i][j]; - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - - un[0][j] = un[2][j]; - un[1][j] = un[2][j]; - un[nx + 2][j] = un[nx + 1][j]; - un[nx + 3][j] = un[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - - un[i][0] = un[i][2]; - un[i][1] = un[i][2]; - un[i][ny + 2] = un[i][ny + 1]; - un[i][ny + 3] = un[i][ny + 1]; - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); - output_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); - - input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; - input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; - input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; - output_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][j]; - } - } - } - - // Output solution to disk. - const char *fmt = \"%s_output_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - kann_mt(ann, num_threads, mini_size); - kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data, output_data); - - // Output neural network to disk. - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - kann_save(file_nm, ann); - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - free(un[i]); - free(slope_x[i]); - free(slope_y[i]); - } - free(u); - free(un); - free(slope_x); - free(slope_y); - - kann_delete(ann); - - for (int i = 0; i < nx * num_trains; i++) { - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - init-func-code - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). - flux-umL-y - flux-umR-y - ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). - flux-uiL-y - flux-uiR-y - ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). - flux-upL-y - flux-upR-y - ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). - flux-umR-evol-y - ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). - flux-uiL-evol-y - flux-uiR-evol-y - ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). - flux-upL-evol-y - ;; Evolved right negative flux derivative in y-direction f'(u_{j - 1, R+}). - flux-deriv-umR-evol-y - ;; Evolved left/right central flux derivatives in y-direction f'(u_{j, L+}), f(u_{j, R+}). - flux-deriv-uiL-evol-y - flux-deriv-uiR-evol-y - ;; Evolved left positive flux derivative in y-direction f'(u_{j + 1, L+}). - flux-deriv-upL-evol-y - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in x-direction f(u_{i - 1, L}), f(u_{i - 1, R}). - flux-umL-x - flux-umR-x - ;; Left/right central fluxes in x-direction f(u_{i, L}), f(u_{i, R}). - flux-uiL-x - flux-uiR-x - ;; Left/right positive fluxes in x-direction f(u_{i + 1, L}), f(u_{i + 1, R}). - flux-upL-x - flux-upR-x - ;; Evolved right negative flux in x-direction f(u_{i - 1, R+}). - flux-umR-evol-x - ;; Evolved left/right central fluxes in x-direction f(u_{i, L+}), f(u_{i, R+}). - flux-uiL-evol-x - flux-uiR-evol-x - ;; Evolved left positive flux in x-direction f(u_{i + 1, L+}). - flux-upL-evol-x - ;; Evolved right negative flux derivative in x-direction f'(u_{i - 1, R+}). - flux-deriv-umR-evol-x - ;; Evolved left/right central flux derivatives in x-direction f'(u_{i, L+}), f(u_{i, R+}). - flux-deriv-uiL-evol-x - flux-deriv-uiR-evol-x - ;; Evolved left positive flux derivative in x-direction f'(u_{i + 1, L+}). - flux-deriv-upL-evol-x - ;; Expressions for flux limiter function. - limiter-r - ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). - flux-umL-y - flux-umR-y - ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). - flux-uiL-y - flux-uiR-y - ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). - flux-upL-y - flux-upR-y - ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). - flux-umR-evol-y - ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). - flux-uiL-evol-y - flux-uiR-evol-y - ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). - flux-upL-evol-y - ;; Evolved right negative flux derivative in y-direction f'(u_{j - 1, R+}). - flux-deriv-umR-evol-y - ;; Evolved left/right central flux derivatives in y-direction f'(u_{j, L+}), f(u_{j, R+}). - flux-deriv-uiL-evol-y - flux-deriv-uiR-evol-y - ;; Evolved left positive flux derivative in y-direction f'(u_{j + 1, L+}). - flux-deriv-upL-evol-y - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_core_validation.rkt b/provable-algorithms/neural_networks/code_generator_core_validation.rkt deleted file mode 100644 index 909b841f..00000000 --- a/provable-algorithms/neural_networks/code_generator_core_validation.rkt +++ /dev/null @@ -1,976 +0,0 @@ -#lang racket - -(provide validate-scalar-1d - validate-scalar-1d-second-order - validate-scalar-2d - validate-scalar-2d-second-order) - -;; Lightweight converter from Racket expressions (expr) into strings representing equivalent C code. -(define (convert-expr expr) - (match expr - ;; If expr is a symbol, then convert it directly to a string. - [(? symbol? symb) (symbol->string symb)] - - ;; If expr is a numerical constant, then convert it directly to a string. - [(? number? num) (number->string num)] - - ;; If expr is a sum of the form (+ expr1 expr2 ...), then convert it to "(expr1 + expr2 + ...)" in C. - [`(+ . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " + ") ")"))] - ;; Likewise for differences. - [`(- . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " - ") ")"))] - - ;; If expr is a product of the form (* expr1 expr2 ...), then convert it to "(expr1 * expr2 * ...)" in C. - [`(* . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " * ") ")"))] - ;; Likewise for quotients. - [`(/ . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " / ") ")"))] - - ;; If expr is an absolute value of the form (abs expr1), then convert it to "fabs(expr1)" in C. - [`(abs ,arg) - (format "fabs(~a)" (convert-expr arg))] - - ;; If expr is a square root of the form (sqrt expr1), then convert it to "sqrt(expr1)" in C. - [`(sqrt ,arg) - (format "sqrt(~a)" (convert-expr arg))] - - ;; If expr is a maximum of the form (max expr1 expr2), then convert it to "fmax(expr1, expr2)" in C. - [`(max ,arg1 ,arg2) - (format "fmax(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a maximum of the form (max expr1 expr2 expr2), then convert it to "fmax(expr1, expr2, expr3)" in C. - [`(max ,arg1 ,arg2 ,arg3) - (format "fmax3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] - - ;; If expr is a minimum of the form (max expr1 expr2), then convert it to "fmin(expr1, expr2)" in C. - [`(min ,arg1 ,arg2) - (format "fmin(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a minimum of the form (max expr1 expr2 expr2), then convert it to "fmin(expr1, expr2, expr3)" in C. - [`(min ,arg1 ,arg2 ,arg3) - (format "fmin3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] - - ;; If expr is a variable assignment of the form (define expr1 expr2), then convert it to "expr1 = expr2" in C. - [`(define ,arg1 ,arg2) - (format "~a = ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a strict comparison of the form (< expr1 expr2), then convert it to "expr1 < expr2" in C. - [`(< ,arg1 ,arg2) - (format "~a < ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a comparison of the form (<= expr1 expr2), then convert it to "expr1 <= expr2" in C. - [`(<= ,arg1 ,arg2) - (format "~a <= ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a strict comparison of the form (> expr1 expr2), then convert it to "expr1 > expr2" in C. - [`(> ,arg1 ,arg2) - (format "~a > ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a comparison of the form (>= expr1 expr2), then convert it to "expr1 >= expr2" in C. - [`(>= ,arg1 ,arg2) - (format "~a >= ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is an equality comparison of the form (equal? expr1 expr2), then convert it to "expr1 == expr2" in C. - [`(equal? ,arg1 ,arg2) - (format "~a == ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a conditional of the form [(cond [cond1 expr1] [else expr2])], then convert it to the ternary operator "(cond1) ? expr1 : expr2" in C. - [`(cond - [,cond1 ,expr1] - [else ,expr2]) - (format "(~a) ? ~a : ~a" (convert-expr cond1) (convert-expr expr1) (convert-expr expr2))])) - -;; A simple boilerplate function for removing bracketed expressions from strings. -(define (remove-bracketed-expressions str) - (regexp-replace* #rx"\\[.*?\\]" str "")) - -;; A simple boilerplate function for removing bracketed expressions from files. -(define (remove-bracketed-expressions-from-file output-file) - (define content - (with-input-from-file output-file - (lambda () - (port->string (current-input-port))))) - (define cleaned - (remove-bracketed-expressions content)) - (with-output-to-file output-file #:exists 'replace - (lambda () - (display cleaned)))) - -(define (flux-substitute flux-expr cons-expr var-name) - (string-replace flux-expr cons-expr var-name)) - -;; ------------------------------------------------------------------------ -;; Validate an Arbitrary (First-Order) Surrogate Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------ -(define (validate-scalar-1d pde neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that validates a surrogate solver for the 1D scalar PDE specified by `pde` using any first-order method, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define cons-code (convert-expr cons-expr)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON SCALAR PDE: ~a -// Validate any first-order surrogate solver for a scalar PDE in 1D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Array for storing solution. - double *u = (double*) malloc((nx + 2) * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[i] = ~a; // init-func in C. - } - - // Load neural network architecture. - kann_t *ann; - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann = kann_load(file_nm); - - fclose(fptr); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - - float *input_data = (float*) malloc(2 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - - output_data = kann_apply1(ann, input_data); - - u[i] = output_data[0]; - - free(input_data); - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[1]; - u[nx + 1] = u[nx]; - - // Output solution to disk. - const char *fmt = \"%s_validation_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr; - fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - } - - fclose(fptr); - - // Increment time. - t += dt; - n += 1; - } - - free(u); - kann_delete(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - ;; PDE name for neural network input. - name - name - ;; Expression for local wave-speed estimate. - max-speed-local - ;; PDE name for file output. - name - name - )) - code) - -;; ------------------------------------------------------------------------- -;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------- -(define (validate-scalar-1d-second-order pde limiter neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that validates a surrogate solver for the 1D scalar PDE specified by `pde` using any first-order method with any second-order flux extrapolation - using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - - (define cons-code (convert-expr cons-expr)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Validate any first-order surrogate solver for a scalar PDE in 1D, with any second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Array for storing solution. - double *u = (double*) malloc((nx + 4) * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[i] = ~a; // init-func in C. - } - - // Load neural network architecture. - kann_t *ann; - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann = kann_load(file_nm); - - fclose(fptr); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - - float *input_data = (float*) malloc(2 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - - output_data = kann_apply1(ann, input_data); - - u[i] = output_data[0]; - - free(input_data); - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[2]; - u[1] = u[2]; - u[nx + 2] = u[nx + 1]; - u[nx + 3] = u[nx + 1]; - - // Output solution to disk. - const char *fmt = \"%s_validation_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr; - fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[i]); - } - } - - fclose(fptr); - - // Increment time. - t += dt; - n += 1; - } - - free(u); - kann_delete(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - ;; PDE name for neural network input. - name - name - ;; Expression for local wave-speed estimate. - max-speed-local - ;; PDE name for file output. - name - name - )) - code) - -;; ------------------------------------------------------------------------ -;; Validate an Arbitrary (First-Order) Surrogate Solver for a 2D Scalar PDE -;; ------------------------------------------------------------------------ -(define (validate-scalar-2d pde neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that validates a surrogate solver for the 2D scalar PDE specified by `pde` using any first-order method, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define cons-code (convert-expr cons-expr)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON SCALAR PDE: ~a -// Validate any first-order surrogate solver for a scalar PDE in 2D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Array for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * sizeof(double)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][j] = ~a; // init-func in C. - } - } - - // Load neural network architecture. - kann_t *ann; - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann = kann_load(file_nm); - - fclose(fptr); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - float *input_data = (float*) malloc(3 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - input_data[2] = y; - - output_data = kann_apply1(ann, input_data); - - u[i][j] = output_data[0]; - - free(input_data); - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - u[0][j] = u[1][j]; - u[nx + 1][j] = u[nx][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - u[i][0] = u[i][1]; - u[i][ny + 1] = u[i][ny]; - } - - // Output solution to disk. - const char *fmt = \"%s_validation_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr; - fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - } - - fclose(fptr); - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - } - free(u); - kann_delete(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; PDE name for file output. - name - name - )) - code) - -;; ------------------------------------------------------------------------- -;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 2D Scalar PDE -;; ------------------------------------------------------------------------- -(define (validate-scalar-2d-second-order pde limiter neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Generate C code that validates a surrogate solver for the 2D scalar PDE specified by `pde` using any first-order method with any second-order flux extrapolation - using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - - (define cons-code (convert-expr cons-expr)) - (define max-speed-code-x (convert-expr max-speed-expr-x)) - (define max-speed-code-y (convert-expr max-speed-expr-y)) - (define init-func-code (convert-expr init-func)) - - (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) - (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Validate any first-order surrogate solver for a scalar PDE in 2D, with any second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Array for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * sizeof(double)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][j] = ~a; // init-func in C. - } - } - - // Load neural network architecture. - kann_t *ann; - const char *fmt = \"%s_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\"); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann = kann_load(file_nm); - - fclose(fptr); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double local_alpha_x = ~a; // max-speed-expr-x in C. - double local_alpha_y = ~a; // max-speed-expr-y in C. - - if (local_alpha_x > alpha_x) { - alpha_x = local_alpha_x; - } - if (local_alpha_y > alpha_y) { - alpha_y = local_alpha_y; - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j<= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - float *input_data = (float*) malloc(3 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - input_data[2] = y; - - output_data = kann_apply1(ann, input_data); - - u[i][j] = output_data[0]; - - free(input_data); - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - u[0][j] = u[2][j]; - u[1][j] = u[2][j]; - u[nx + 2][j] = u[nx + 1][j]; - u[nx + 3][j] = u[nx + 1][j]; - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - u[i][0] = u[i][2]; - u[i][1] = u[i][2]; - u[i][ny + 2] = u[i][ny + 1]; - u[i][ny + 3] = u[i][ny + 1]; - } - - // Output solution to disk. - const char *fmt = \"%s_validation_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); - - FILE *fptr; - fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); - } - } - } - - fclose(fptr); - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - } - free(u); - kann_delete(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - max-speed-local-x - max-speed-local-y - ;; PDE name for file output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_matrix_training.rkt b/provable-algorithms/neural_networks/code_generator_matrix_training.rkt deleted file mode 100644 index 905493ce..00000000 --- a/provable-algorithms/neural_networks/code_generator_matrix_training.rkt +++ /dev/null @@ -1,920 +0,0 @@ -#lang racket - -(require "code_generator_core_training.rkt") -(provide train-lax-friedrichs-vector3-1d - train-lax-friedrichs-vector3-1d-second-order) - -;; ---------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Coupled Vector System of 3 PDEs -;; ---------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-vector3-1d pde-system neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 0.0] - [else 0.0]) - `(cond - [(< x 0.5) 7.5] - [else 2.5]))]) - "Generate C code that trains a surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") - (list-ref cons-codes 1) "um[1]") (list-ref cons-codes 2) "um[2]")) flux-codes)) - (define flux-uis (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") - (list-ref cons-codes 1) "ui[1]") (list-ref cons-codes 2) "ui[2]")) flux-codes)) - (define flux-ups (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") - (list-ref cons-codes 1) "up[1]") (list-ref cons-codes 2) "up[2]")) flux-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 3) + 0]") - (list-ref cons-codes 1) "u[(i * 3) + 1]") (list-ref cons-codes 2) "u[(i * 3) + 2]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 3 PDEs in 1D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * 3 * sizeof(double)); - double *un = (double*) malloc((nx + 2) * 3 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(3 * sizeof(double)); - - double *um = (double*) malloc(3 * sizeof(double)); - double *ui = (double*) malloc(3 * sizeof(double)); - double *up = (double*) malloc(3 * sizeof(double)); - - double *f_um = (double*) malloc(3 * sizeof(double)); - double *f_ui = (double*) malloc(3 * sizeof(double)); - double *f_up = (double*) malloc(3 * sizeof(double)); - - double *fluxL = (double*) malloc(3 * sizeof(double)); - double *fluxR = (double*) malloc(3 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(3 * sizeof(float**)); - float ***output_data = (float***) malloc(3 * sizeof(float**)); - - for (int i = 0; i < 3; i++) { - input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[(i * 3) + 0] = ~a; // init-funcs[0] in C. - u[(i * 3) + 1] = ~a; // init-funcs[1] in C. - u[(i * 3) + 2] = ~a; // init-funcs[2] in C. - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - t_net[i] = kann_layer_input(2); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - local_alpha[2] = ~a; // max-speed-exprs[2] in C. - - for (int j = 0; j < 3; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. - for (int i = 1; i <= nx; i++) { - for (int j = 0; j < 3; j++) { - um[j] = u[((i - 1) * 3) + j]; - ui[j] = u[(i * 3) + j]; - up[j] = u[((i + 1) * 3) + j]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um[0] = ~a; - f_um[1] = ~a; - f_um[2] = ~a; // F(U_{i - 1}). - - f_ui[0] = ~a; - f_ui[1] = ~a; - f_ui[2] = ~a; // F(U_i). - - f_up[0] = ~a; - f_up[1] = ~a; - f_up[2] = ~a; // F(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha * (U_i - U_{i - 1}). - for (int j = 0; j < 3; j++) { - fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * alpha * (ui[j] - um[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha * (U_{i + 1} - U_i). - for (int j = 0; j < 3; j++) { - fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * alpha * (up[j] - ui[j]); - } - - // Update the conserved variable vector. - for (int j = 0; j < 3; j++) { - un[(i * 3) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j < 3; j++) { - u[(i * 3) + j] = un[(i * 3) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 3; j++) { - u[(0 * 3) + j] = u[(1 * 3) + j]; - u[((nx + 1) * 3) + j] = u[(nx * 3) + j]; - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - - for (int j = 0; j < 3; j++) { - input_data[j][(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); - output_data[j][(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); - - input_data[j][(n * nx) + (i - 1)][0] = t; - input_data[j][(n * nx) + (i - 1)][1] = x; - output_data[j][(n * nx) + (i - 1)][0] = u[(i * 3) + j]; - } - } - } - - // Output solution to disk. - for (int j = 0; j < 3; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 3) + j]); - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 3; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - free(u); - free(un); - - free(local_alpha); - - free(um); - free(ui); - free(up); - - free(f_um); - free(f_ui); - free(f_up); - - free(fluxL); - free(fluxR); - - for (int i = 0; i < 3; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 3; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - (list-ref max-speed-locals 2) - ;; Left flux vector F(u_{i - 1}). - (list-ref flux-ums 0) - (list-ref flux-ums 1) - (list-ref flux-ums 2) - ;; Middle flux vector F(u_i). - (list-ref flux-uis 0) - (list-ref flux-uis 1) - (list-ref flux-uis 2) - ;; Right flux vector F(u_{i + 1}). - (list-ref flux-ups 0) - (list-ref flux-ups 1) - (list-ref flux-ups 2) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-vector3-1d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 0.0] - [else 0.0]) - `(cond - [(< x 0.5) 7.5] - [else 2.5]))]) - "Generate C code that trains a surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method - with a second-order flux extrapolation using the limiter `limiter`, with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") - (list-ref cons-codes 1) "umL[1]") (list-ref cons-codes 2) "umL[2]")) flux-codes)) - (define flux-umRs (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") - (list-ref cons-codes 1) "umR[1]") (list-ref cons-codes 2) "umR[2]")) flux-codes)) - (define flux-uiLs (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") - (list-ref cons-codes 1) "uiL[1]") (list-ref cons-codes 2) "uiL[2]")) flux-codes)) - (define flux-uiRs (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") - (list-ref cons-codes 1) "uiR[1]") (list-ref cons-codes 2) "uiR[2]")) flux-codes)) - (define flux-upLs (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") - (list-ref cons-codes 1) "upL[1]") (list-ref cons-codes 2) "upL[2]")) flux-codes)) - (define flux-upRs (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") - (list-ref cons-codes 1) "upR[1]") (list-ref cons-codes 2) "upR[2]")) flux-codes)) - - (define flux-umR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") - (list-ref cons-codes 1) "umR_evol[1]") (list-ref cons-codes 2) "umR_evol[2]")) flux-codes)) - (define flux-uiL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") - (list-ref cons-codes 1) "uiL_evol[1]") (list-ref cons-codes 2) "uiL_evol[2]")) flux-codes)) - (define flux-uiR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") - (list-ref cons-codes 1) "uiR_evol[1]") (list-ref cons-codes 2) "uiR_evol[2]")) flux-codes)) - (define flux-upL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") - (list-ref cons-codes 1) "upL_evol[1]") (list-ref cons-codes 2) "upL_evol[2]")) flux-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 3) + 0]") - (list-ref cons-codes 1) "u[(i * 3) + 1]") (list-ref cons-codes 2) "u[(i * 3) + 2]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 3 PDEs in 1D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Array for storing slopes. - double *slope = (double*) malloc((nx + 4) * 3 * sizeof(double)); - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * 3 * sizeof(double)); - double *un = (double*) malloc((nx + 4) * 3 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(3 * sizeof(double)); - - double *umL = (double*) malloc(3 * sizeof(double)); - double *umR = (double*) malloc(3 * sizeof(double)); - double *uiL = (double*) malloc(3 * sizeof(double)); - double *uiR = (double*) malloc(3 * sizeof(double)); - double *upL = (double*) malloc(3 * sizeof(double)); - double *upR = (double*) malloc(3 * sizeof(double)); - - double *f_umL = (double*) malloc(3 * sizeof(double)); - double *f_umR = (double*) malloc(3 * sizeof(double)); - double *f_uiL = (double*) malloc(3 * sizeof(double)); - double *f_uiR = (double*) malloc(3 * sizeof(double)); - double *f_upL = (double*) malloc(3 * sizeof(double)); - double *f_upR = (double*) malloc(3 * sizeof(double)); - - double *umR_evol = (double*) malloc(3 * sizeof(double)); - double *uiL_evol = (double*) malloc(3 * sizeof(double)); - double *uiR_evol = (double*) malloc(3 * sizeof(double)); - double *upL_evol = (double*) malloc(3 * sizeof(double)); - - double *f_umR_evol = (double*) malloc(3 * sizeof(double)); - double *f_uiL_evol = (double*) malloc(3 * sizeof(double)); - double *f_uiR_evol = (double*) malloc(3 * sizeof(double)); - double *f_upL_evol = (double*) malloc(3 * sizeof(double)); - - double *fluxL = (double*) malloc(3 * sizeof(double)); - double *fluxR = (double*) malloc(3 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(3 * sizeof(float**)); - float ***output_data = (float***) malloc(3 * sizeof(float**)); - - for (int i = 0; i < 3; i++) { - input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[(i * 3) + 0] = ~a; // init-funcs[0] in C. - u[(i * 3) + 1] = ~a; // init-funcs[1] in C. - u[(i * 3) + 2] = ~a; // init-funcs[2] in C. - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - t_net[i] = kann_layer_input(2); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - local_alpha[2] = ~a; // max-speed-exprs[2] in C. - - for (int j = 0; j < 3; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 0; j < 3; j++) { - double r = (u[(i * 3) + j] - u[((i - 1) * 3) + j]) / (u[((i + 1) * 3) + j] - u[(i * 3) + j]); - double limiter = ~a; // limiter-r in C. - - slope[(i * 3) + j] = limiter * (0.5 * ((u[(i * 3) + j] - u[((i - 1) * 3) + j]) + (u[((i + 1) * 3) + j] - u[(i * 3) + j]))); - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. - for (int i = 2; i <= nx + 1; i++) { - // Extrapolate boundary states. - for (int j = 0; j < 3; j++) { - umL[j] = u[((i - 1) * 3) + j] - (0.5 * slope[((i - 1) * 3) + j]); - umR[j] = u[((i - 1) * 3) + j] + (0.5 * slope[((i - 1) * 3) + j]); - - uiL[j] = u[(i * 3) + j] - (0.5 * slope[(i * 3) + j]); - uiR[j] = u[(i * 3) + j] + (0.5 * slope[(i * 3) + j]); - - upL[j] = u[((i + 1) * 3) + j] - (0.5 * slope[((i + 1) * 3) + j]); - upR[j] = u[((i + 1) * 3) + j] + (0.5 * slope[((i + 1) * 3) + j]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL[0] = ~a; - f_umL[1] = ~a; - f_umL[2] = ~a; - f_umR[0] = ~a; - f_umR[1] = ~a; - f_umR[2] = ~a; - - f_uiL[0] = ~a; - f_uiL[1] = ~a; - f_uiL[2] = ~a; - f_uiR[0] = ~a; - f_uiR[1] = ~a; - f_uiR[2] = ~a; - - f_upL[0] = ~a; - f_upL[1] = ~a; - f_upL[2] = ~a; - f_upR[0] = ~a; - f_upR[1] = ~a; - f_upR[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int j = 0; j < 3; j++) { - umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); - - uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - - upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol[0] = ~a; - f_umR_evol[1] = ~a; - f_umR_evol[2] = ~a; // F(U_{i - 1, R+}) - f_uiL_evol[0] = ~a; - f_uiL_evol[1] = ~a; - f_uiL_evol[2] = ~a; // F(U_{i, L+}) - - f_uiR_evol[0] = ~a; - f_uiR_evol[1] = ~a; - f_uiR_evol[2] = ~a; // F(U_{i, R+}) - f_upL_evol[0] = ~a; - f_upL_evol[1] = ~a; - f_upL_evol[2] = ~a; // F(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha * (U_{i, L+} - U_{i - 1, R+}). - for (int j = 0; j < 3; j++) { - fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * alpha * (uiL_evol[j] - umR_evol[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha * (U_{i + 1, L+} - U_{i, R+}). - for (int j = 0; j < 3; j++) { - fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * alpha * (upL_evol[j] - uiR_evol[j]); - } - - // Update the conserved variable vector. - for (int j = 0; j < 3; j++) { - un[(i * 3) + j] = u[(i * 3) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j < 3; j++) { - u[(i * 3) + j] = un[(i * 3) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 3; j++) { - u[(0 * 3) + j] = u[(2 * 3) + j]; - u[(1 * 3) + j] = u[(2 * 3) + j]; - u[((nx + 2) * 3) + j] = u[((nx + 1) * 3) + j]; - u[((nx + 3) * 3) + j] = u[((nx + 1) * 3) + j]; - } - - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - - for (int j = 0; j < 3; j++) { - input_data[j][(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); - output_data[j][(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); - - input_data[j][(n * nx) + (i - 2)][0] = t; - input_data[j][(n * nx) + (i - 2)][1] = x; - output_data[j][(n * nx) + (i - 2)][0] = u[(i * 3) + j]; - } - } - } - - // Output solution to disk. - for (int j = 0; j < 3; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 3) + j]); - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 3; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - free(u); - free(un); - free(slope); - - free(local_alpha); - - free(umL); - free(umR); - free(uiL); - free(uiR); - free(upL); - free(upR); - - free(f_umL); - free(f_umR); - free(f_uiL); - free(f_uiR); - free(f_upL); - free(f_upR); - - free(umR_evol); - free(uiL_evol); - free(uiR_evol); - free(upL_evol); - - free(f_umR_evol); - free(f_uiL_evol); - free(f_uiR_evol); - free(f_upL_evol); - - free(fluxL); - free(fluxR); - - for (int i = 0; i < 2; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 2; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - (list-ref max-speed-locals 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left negative flux vector F(U_{i - 1, L}). - (list-ref flux-umLs 0) - (list-ref flux-umLs 1) - (list-ref flux-umLs 2) - ;; Right negative flux vector F(U_{i - 1, R}). - (list-ref flux-umRs 0) - (list-ref flux-umRs 1) - (list-ref flux-umRs 2) - ;; Left central flux vector F(U_{i, L}). - (list-ref flux-uiLs 0) - (list-ref flux-uiLs 1) - (list-ref flux-uiLs 2) - ;; Right central flux vector F(U_{i, R}). - (list-ref flux-uiRs 0) - (list-ref flux-uiRs 1) - (list-ref flux-uiRs 2) - ;; Left positive flux vector F(U_{i + 1, L}). - (list-ref flux-upLs 0) - (list-ref flux-upLs 1) - (list-ref flux-upLs 2) - ;; Right positive flux vector F(U_{i + 1, R}). - (list-ref flux-upRs 0) - (list-ref flux-upRs 1) - (list-ref flux-upRs 2) - ;; Evolved right negative flux vector F(U_{i - 1, R+}). - (list-ref flux-umR-evols 0) - (list-ref flux-umR-evols 1) - (list-ref flux-umR-evols 2) - ;; Evolved left central flux vector F(U_{i, L+}). - (list-ref flux-uiL-evols 0) - (list-ref flux-uiL-evols 1) - (list-ref flux-uiL-evols 2) - ;; Evolved right central flux vector F(U_{i, R+}). - (list-ref flux-uiR-evols 0) - (list-ref flux-uiR-evols 1) - (list-ref flux-uiR-evols 2) - ;; Evolved left positive flux vector F(U_{i + 1, L+}). - (list-ref flux-upL-evols 0) - (list-ref flux-upL-evols 1) - (list-ref flux-upL-evols 2) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_matrix_training_2d.rkt b/provable-algorithms/neural_networks/code_generator_matrix_training_2d.rkt deleted file mode 100644 index 83b8d443..00000000 --- a/provable-algorithms/neural_networks/code_generator_matrix_training_2d.rkt +++ /dev/null @@ -1,1827 +0,0 @@ -#lang racket - -(require "code_generator_core_training.rkt") -(provide train-lax-friedrichs-vector4-2d - train-lax-friedrichs-vector4-2d-second-order) - -;; ---------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Coupled Vector System of 4 PDEs -;; ---------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-vector4-2d pde-system neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0 - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]))]) - "Generate C code that trains a surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") - (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]") - (list-ref cons-codes 3) "um_x[3]")) flux-codes-x)) - (define flux-uis-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") - (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]") - (list-ref cons-codes 3) "ui_x[3]")) flux-codes-x)) - (define flux-ups-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") - (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]") - (list-ref cons-codes 3) "up_x[3]")) flux-codes-x)) - - (define flux-ums-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") - (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]") - (list-ref cons-codes 3) "um_y[3]")) flux-codes-y)) - (define flux-uis-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") - (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]") - (list-ref cons-codes 3) "ui_y[3]")) flux-codes-y)) - (define flux-ups-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") - (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]") - (list-ref cons-codes 3) "up_y[3]")) flux-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 4) + 0]") - (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") - (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 4) + 0]") - (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") - (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 4 PDEs in 2D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - double **un = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * 4 * sizeof(double)); - un[i] = (double*) malloc((ny + 2) * 4 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(4 * sizeof(double)); - double *local_alpha_y = (double*) malloc(4 * sizeof(double)); - - double *um_x = (double*) malloc(4 * sizeof(double)); - double *ui_x = (double*) malloc(4 * sizeof(double)); - double *up_x = (double*) malloc(4 * sizeof(double)); - - double *f_um_x = (double*) malloc(4 * sizeof(double)); - double *f_ui_x = (double*) malloc(4 * sizeof(double)); - double *f_up_x = (double*) malloc(4 * sizeof(double)); - - double *fluxL_x = (double*) malloc(4 * sizeof(double)); - double *fluxR_x = (double*) malloc(4 * sizeof(double)); - - double *um_y = (double*) malloc(4 * sizeof(double)); - double *ui_y = (double*) malloc(4 * sizeof(double)); - double *up_y = (double*) malloc(4 * sizeof(double)); - - double *f_um_y = (double*) malloc(4 * sizeof(double)); - double *f_ui_y = (double*) malloc(4 * sizeof(double)); - double *f_up_y = (double*) malloc(4 * sizeof(double)); - - double *fluxL_y = (double*) malloc(4 * sizeof(double)); - double *fluxR_y = (double*) malloc(4 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(4 * sizeof(float**)); - float ***output_data = (float***) malloc(4 * sizeof(float**)); - - for (int i = 0; i < 4; i++) { - input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. - u[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. - - un[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. - un[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. - } - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(4 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(4 * sizeof(kann_t*)); - - for (int i = 0; i < 4; i++) { - t_net[i] = kann_layer_input(3); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - local_alpha_x[3] = ~a; // max-speed-exprs-x[3] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - local_alpha_y[3] = ~a; // max-speed-exprs-y[3] in C. - - for (int k = 0; k < 4; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 4; k++) { - um_y[k] = u[i][((j - 1) * 4) + k]; - ui_y[k] = u[i][(j * 4) + k]; - up_y[k] = u[i][((j + 1) * 4) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; - f_um_y[3] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; - f_ui_y[3] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; - f_up_y[3] = ~a; // F(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). - for (int k = 0; k < 4; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). - for (int k = 0; k < 4; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 4; k++) { - un[i][(j * 4) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 4; k++) { - u[i][(j * 4) + k] = un[i][(j * 4) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 4; k++) { - u[0][(j * 4) + k] = u[1][(j * 4) + k]; - u[nx + 1][(j * 4) + k] = u[nx][(j * 4) + k]; - - un[0][(j * 4) + k] = un[1][(j * 4) + k]; - un[nx + 1][(j * 4) + k] = un[nx][(j * 4) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 4; k++) { - u[i][(0 * 4) + k] = u[i][(1 * 4) + k]; - u[i][((ny + 1) * 4) + k] = u[i][(ny * 4) + k]; - - un[i][(0 * 4) + k] = un[i][(1 * 4) + k]; - un[i][((ny + 1) * 4) + k] = un[i][(ny * 4) + k]; - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 4; k++) { - um_x[k] = u[i - 1][(j * 4) + k]; - ui_x[k] = u[i][(j * 4) + k]; - up_x[k] = u[i + 1][(j * 4) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_x[0] = ~a; - f_um_x[1] = ~a; - f_um_x[2] = ~a; - f_um_x[3] = ~a;// F(U_{i - 1}). - - f_ui_x[0] = ~a; - f_ui_x[1] = ~a; - f_ui_x[2] = ~a; - f_ui_x[3] = ~a; // F(U_i). - - f_up_x[0] = ~a; - f_up_x[1] = ~a; - f_up_x[2] = ~a; - f_up_x[3] = ~a; // F(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha_x * (U_i - U_{i - 1}). - for (int k = 0; k < 4; k++) { - fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * alpha_x * (ui_x[k] - um_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha_x * (U_{i + 1} - U_i). - for (int k = 0; k < 4; k++) { - fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * alpha_x * (up_x[k] - ui_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 4; k++) { - un[i][(j * 4) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 4; k++) { - u[i][(j * 4) + k] = un[i][(j * 4) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 4; k++) { - u[0][(j * 4) + k] = u[1][(j * 4) + k]; - u[nx + 1][(j * 4) + k] = u[nx][(j * 4) + k]; - - un[0][(j * 4) + k] = un[1][(j * 4) + k]; - un[nx + 1][(j * 4) + k] = un[nx][(j * 4) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 4; k++) { - u[i][(0 * 4) + k] = u[i][(1 * 4) + k]; - u[i][((ny + 1) * 4) + k] = u[i][(ny * 4) + k]; - - un[i][(0 * 4) + k] = un[i][(1 * 4) + k]; - un[i][((ny + 1) * 4) + k] = un[i][(ny * 4) + k]; - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 4; k++) { - um_y[k] = u[i][((j - 1) * 4) + k]; - ui_y[k] = u[i][(j * 4) + k]; - up_y[k] = u[i][((j + 1) * 4) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; - f_um_y[3] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; - f_ui_y[3] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; - f_up_y[3] = ~a; // F(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). - for (int k = 0; k < 4; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). - for (int k = 0; k < 4; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 4; k++) { - un[i][(j * 4) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 4; k++) { - u[i][(j * 4) + k] = un[i][(j * 4) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 4; k++) { - u[0][(j * 4) + k] = u[1][(j * 4) + k]; - u[nx + 1][(j * 4) + k] = u[nx][(j * 4) + k]; - - un[0][(j * 4) + k] = un[1][(j * 4) + k]; - un[nx + 1][(j * 4) + k] = un[nx][(j * 4) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 4; k++) { - u[i][(0 * 4) + k] = u[i][(1 * 4) + k]; - u[i][((ny + 1) * 4) + k] = u[i][(ny * 4) + k]; - - un[i][(0 * 4) + k] = un[i][(1 * 4) + k]; - un[i][((ny + 1) * 4) + k] = un[i][(ny * 4) + k]; - } - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - for (int k = 0; k < 4; k++) { - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); - output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); - - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; - output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][(j * 4) + k]; - } - } - } - } - - // Output solution to disk. - for (int k = 0; k < 4; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 4) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 4; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 4; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - free(un[i]); - } - free(u); - free(un); - - free(local_alpha_x); - free(local_alpha_y); - - free(um_x); - free(ui_x); - free(up_x); - - free(f_um_x); - free(f_ui_x); - free(f_up_x); - - free(fluxL_x); - free(fluxR_x); - - free(um_y); - free(ui_y); - free(up_y); - - free(f_um_y); - free(f_ui_y); - free(f_up_y); - - free(fluxL_y); - free(fluxR_y); - - for (int i = 0; i < 4; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 4; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 3) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 3) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-x 3) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - (list-ref max-speed-locals-y 3) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-ums-y 3) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-uis-y 3) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - (list-ref flux-ups-y 3) - ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). - (list-ref flux-ums-x 0) - (list-ref flux-ums-x 1) - (list-ref flux-ums-x 2) - (list-ref flux-ums-x 3) - (list-ref flux-uis-x 0) - (list-ref flux-uis-x 1) - (list-ref flux-uis-x 2) - (list-ref flux-uis-x 3) - (list-ref flux-ups-x 0) - (list-ref flux-ups-x 1) - (list-ref flux-ups-x 2) - (list-ref flux-ups-x 3) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-ums-y 3) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-uis-y 3) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - (list-ref flux-ups-y 3) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Coupled Vector System of 4 PDEs with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-vector4-2d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0 - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]))]) - "Generate C code that trains a surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method - with a second-order flux extrapolation using the limiter `limiter`, with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") - (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]") - (list-ref cons-codes 3) "umL_x[3]")) flux-codes-x)) - (define flux-umRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") - (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]") - (list-ref cons-codes 3) "umR_x[3]")) flux-codes-x)) - (define flux-uiLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") - (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]") - (list-ref cons-codes 3) "uiL_x[3]")) flux-codes-x)) - (define flux-uiRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") - (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]") - (list-ref cons-codes 3) "uiR_x[3]")) flux-codes-x)) - (define flux-upLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") - (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]") - (list-ref cons-codes 3) "upL_x[3]")) flux-codes-x)) - (define flux-upRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") - (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]") - (list-ref cons-codes 3) "upR_x[3]")) flux-codes-x)) - - (define flux-umR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") - (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]") - (list-ref cons-codes 3) "umR_evol_x[3]")) flux-codes-x)) - (define flux-uiL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") - (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]") - (list-ref cons-codes 3) "uiL_evol_x[3]")) flux-codes-x)) - (define flux-uiR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") - (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]") - (list-ref cons-codes 3) "uiR_evol_x[3]")) flux-codes-x)) - (define flux-upL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") - (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]") - (list-ref cons-codes 3) "upL_evol_x[3]")) flux-codes-x)) - - (define flux-umLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") - (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]") - (list-ref cons-codes 3) "umL_y[3]")) flux-codes-y)) - (define flux-umRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") - (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umR_y[2]") - (list-ref cons-codes 3) "umR_y[3]")) flux-codes-y)) - (define flux-uiLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") - (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]") - (list-ref cons-codes 3) "uiL_y[3]")) flux-codes-y)) - (define flux-uiRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") - (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]") - (list-ref cons-codes 3) "uiR_y[3]")) flux-codes-y)) - (define flux-upLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") - (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]") - (list-ref cons-codes 3) "upL_y[3]")) flux-codes-y)) - (define flux-upRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") - (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]") - (list-ref cons-codes 3) "upR_y[3]")) flux-codes-y)) - - (define flux-umR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") - (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]") - (list-ref cons-codes 3) "umR_evol_y[3]")) flux-codes-y)) - (define flux-uiL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") - (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]") - (list-ref cons-codes 3) "uiL_evol_y[3]")) flux-codes-y)) - (define flux-uiR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") - (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]") - (list-ref cons-codes 3) "uiR_evol_y[3]")) flux-codes-y)) - (define flux-upL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") - (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]") - (list-ref cons-codes 3) "upL_evol_y[3]")) flux-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 4) + 0]") - (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") - (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 4) + 0]") - (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") - (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 4 PDEs in 2D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing slopes. - double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); - double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - slope_x[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); - slope_y[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); - } - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - double **un = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 4; i++) { - u[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); - un[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(4 * sizeof(double)); - double *local_alpha_y = (double*) malloc(4 * sizeof(double)); - - double *umL_x = (double*) malloc(4 * sizeof(double)); - double *umR_x = (double*) malloc(4 * sizeof(double)); - double *uiL_x = (double*) malloc(4 * sizeof(double)); - double *uiR_x = (double*) malloc(4 * sizeof(double)); - double *upL_x = (double*) malloc(4 * sizeof(double)); - double *upR_x = (double*) malloc(4 * sizeof(double)); - - double *f_umL_x = (double*) malloc(4 * sizeof(double)); - double *f_umR_x = (double*) malloc(4 * sizeof(double)); - double *f_uiL_x = (double*) malloc(4 * sizeof(double)); - double *f_uiR_x = (double*) malloc(4 * sizeof(double)); - double *f_upL_x = (double*) malloc(4 * sizeof(double)); - double *f_upR_x = (double*) malloc(4 * sizeof(double)); - - double *umR_evol_x = (double*) malloc(4 * sizeof(double)); - double *uiL_evol_x = (double*) malloc(4 * sizeof(double)); - double *uiR_evol_x = (double*) malloc(4 * sizeof(double)); - double *upL_evol_x = (double*) malloc(4 * sizeof(double)); - - double *f_umR_evol_x = (double*) malloc(4 * sizeof(double)); - double *f_uiL_evol_x = (double*) malloc(4 * sizeof(double)); - double *f_uiR_evol_x = (double*) malloc(4 * sizeof(double)); - double *f_upL_evol_x = (double*) malloc(4 * sizeof(double)); - - double *fluxL_x = (double*) malloc(4 * sizeof(double)); - double *fluxR_x = (double*) malloc(4 * sizeof(double)); - - double *umL_y = (double*) malloc(4 * sizeof(double)); - double *umR_y = (double*) malloc(4 * sizeof(double)); - double *uiL_y = (double*) malloc(4 * sizeof(double)); - double *uiR_y = (double*) malloc(4 * sizeof(double)); - double *upL_y = (double*) malloc(4 * sizeof(double)); - double *upR_y = (double*) malloc(4 * sizeof(double)); - - double *f_umL_y = (double*) malloc(4 * sizeof(double)); - double *f_umR_y = (double*) malloc(4 * sizeof(double)); - double *f_uiL_y = (double*) malloc(4 * sizeof(double)); - double *f_uiR_y = (double*) malloc(4 * sizeof(double)); - double *f_upL_y = (double*) malloc(4 * sizeof(double)); - double *f_upR_y = (double*) malloc(4 * sizeof(double)); - - double *umR_evol_y = (double*) malloc(4 * sizeof(double)); - double *uiL_evol_y = (double*) malloc(4 * sizeof(double)); - double *uiR_evol_y = (double*) malloc(4 * sizeof(double)); - double *upL_evol_y = (double*) malloc(4 * sizeof(double)); - - double *f_umR_evol_y = (double*) malloc(4 * sizeof(double)); - double *f_uiL_evol_y = (double*) malloc(4 * sizeof(double)); - double *f_uiR_evol_y = (double*) malloc(4 * sizeof(double)); - double *f_upL_evol_y = (double*) malloc(4 * sizeof(double)); - - double *fluxL_y = (double*) malloc(4 * sizeof(double)); - double *fluxR_y = (double*) malloc(4 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(4 * sizeof(float**)); - float ***output_data = (float***) malloc(4 * sizeof(float**)); - - for (int i = 0; i < 4; i++) { - input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. - u[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. - - un[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. - un[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. - } - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(4 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(4 * sizeof(kann_t*)); - - for (int i = 0; i < 4; i++) { - t_net[i] = kann_layer_input(3); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - local_alpha_x[3] = ~a; // max-speed-exprs-x[3] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - local_alpha_y[3] = ~a; // max-speed-exprs-y[3] in C. - - for (int k = 0; k < 4; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 4; k++) { - double r = (u[i][(j * 4) + k] - u[i][((j - 1) * 4) + k]) / (u[i][((j + 1) * 4) + k] - u[i][(j * 4) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 4) + k] = limiter * (0.5 * ((u[i][(j * 4) + k] - u[i][((j - 1) * 4) + k]) + (u[i][((j + 1) * 4) + k] - u[i][(j * 4) + k]))); - } - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 4; k++) { - umL_y[k] = u[i][((j - 1) * 4) + k] - (0.5 * slope_y[i][((j - 1) * 4) + k]); - umR_y[k] = u[i][((j - 1) * 4) + k] + (0.5 * slope_y[i][((j - 1) * 4) + k]); - - uiL_y[k] = u[i][(j * 4) + k] - (0.5 * slope_y[i][(j * 4) + k]); - uiR_y[k] = u[i][(j * 4) + k] + (0.5 * slope_y[i][(j * 4) + k]); - - upL_y[k] = u[i][((j + 1) * 4) + k] - (0.5 * slope_y[i][((j + 1) * 4) + k]); - upR_y[k] = u[i][((j + 1) * 4) + k] + (0.5 * slope_y[i][((j + 1) * 4) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umL_y[3] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - f_umR_y[3] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiL_y[3] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - f_uiR_y[3] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upL_y[3] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - f_upR_y[3] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 4; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; - f_umR_evol_y[3] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; - f_uiL_evol_y[3] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; - f_uiR_evol_y[3] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; - f_upL_evol_y[3] = ~a; // F(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 4; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). - for (int k = 0; k < 4; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 4; k++) { - un[i][(j * 4) + k] = u[i][(j * 4) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 4; k++) { - u[i][(j * 4) + k] = un[i][(j * 4) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 4; k++) { - u[0][(j * 4) + k] = u[2][(j * 4) + k]; - u[1][(j * 4) + k] = u[2][(j * 4) + k]; - u[nx + 2][(j * 4) + k] = u[nx + 1][(j * 4) + k]; - u[nx + 3][(j * 4) + k] = u[nx + 1][(j * 4) + k]; - - un[0][(j * 4) + k] = un[2][(j * 4) + k]; - un[1][(j * 4) + k] = un[2][(j * 4) + k]; - un[nx + 2][(j * 4) + k] = un[nx + 1][(j * 4) + k]; - un[nx + 3][(j * 4) + k] = un[nx + 1][(j * 4) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 4; k++) { - u[i][(0 * 4) + k] = u[i][(2 * 4) + k]; - u[i][(1 * 4) + k] = u[i][(2 * 4) + k]; - u[i][((ny + 2) * 4) + k] = u[i][((ny + 1) * 4) + k]; - u[i][((ny + 3) * 4) + k] = u[i][((ny + 1) * 4) + k]; - - un[i][(0 * 4) + k] = un[i][(2 * 4) + k]; - un[i][(1 * 4) + k] = un[i][(2 * 4) + k]; - un[i][((ny + 2) * 4) + k] = un[i][((ny + 1) * 4) + k]; - un[i][((ny + 3) * 4) + k] = un[i][((ny + 1) * 4) + k]; - } - } - - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 4; k++) { - double r = (u[i][(j * 4) + k] - u[i - 1][(j * 4) + k]) / (u[i + 1][(j * 4) + k] - u[i][(j * 4) + k]); - double limiter = ~a; // limiter-r in C. - - slope_x[i][(j * 4) + k] = limiter * (0.5 * ((u[i][(j * 4) + k] - u[i - 1][(j * 4) + k]) + (u[i + 1][(j * 4) + k] - u[i][(j * 4) + k]))); - } - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 4; k++) { - umL_x[k] = u[i - 1][(j * 4) + k] - (0.5 * slope_x[i - 1][(j * 4) + k]); - umR_x[k] = u[i - 1][(j * 4) + k] + (0.5 * slope_x[i - 1][(j * 4) + k]); - - uiL_x[k] = u[i][(j * 4) + k] - (0.5 * slope_x[i][(j * 4) + k]); - uiR_x[k] = u[i][(j * 4) + k] + (0.5 * slope_x[i][(j * 4) + k]); - - upL_x[k] = u[i + 1][(j * 4) + k] - (0.5 * slope_x[i + 1][(j * 4) + k]); - upR_x[k] = u[i + 1][(j * 4) + k] + (0.5 * slope_x[i + 1][(j * 4) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_x[0] = ~a; - f_umL_x[1] = ~a; - f_umL_x[2] = ~a; - f_umL_x[3] = ~a; - f_umR_x[0] = ~a; - f_umR_x[1] = ~a; - f_umR_x[2] = ~a; - f_umR_x[3] = ~a; - - f_uiL_x[0] = ~a; - f_uiL_x[1] = ~a; - f_uiL_x[2] = ~a; - f_uiL_x[3] = ~a; - f_uiR_x[0] = ~a; - f_uiR_x[1] = ~a; - f_uiR_x[2] = ~a; - f_uiR_x[3] = ~a; - - f_upL_x[0] = ~a; - f_upL_x[1] = ~a; - f_upL_x[2] = ~a; - f_upL_x[3] = ~a; - f_upR_x[0] = ~a; - f_upR_x[1] = ~a; - f_upR_x[2] = ~a; - f_upR_x[3] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 4; k++) { - umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); - - uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - - upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_x[0] = ~a; - f_umR_evol_x[1] = ~a; - f_umR_evol_x[2] = ~a; - f_umR_evol_x[3] = ~a;// F(U_{i - 1, R+}) - f_uiL_evol_x[0] = ~a; - f_uiL_evol_x[1] = ~a; - f_uiL_evol_x[2] = ~a; - f_uiL_evol_x[3] = ~a; // F(U_{i, L+}) - - f_uiR_evol_x[0] = ~a; - f_uiR_evol_x[1] = ~a; - f_uiR_evol_x[2] = ~a; - f_uiR_evol_x[3] = ~a; // F(U_{i, R+}) - f_upL_evol_x[0] = ~a; - f_upL_evol_x[1] = ~a; - f_upL_evol_x[2] = ~a; - f_upL_evol_x[3] = ~a; // F(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha_x * (U_{i, L+} - U_{i - 1, R+}). - for (int k = 0; k < 4; k++) { - fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * alpha_x * (uiL_evol_x[k] - umR_evol_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha_x * (U_{i + 1, L+} - U_{i, R+}). - for (int k = 0; k < 4; k++) { - fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * alpha_x * (upL_evol_x[k] - uiR_evol_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 4; k++) { - un[i][(j * 4) + k] = u[i][(j * 4) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 4; k++) { - u[i][(j * 4) + k] = un[i][(j * 4) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 4; k++) { - u[0][(j * 4) + k] = u[2][(j * 4) + k]; - u[1][(j * 4) + k] = u[2][(j * 4) + k]; - u[nx + 2][(j * 4) + k] = u[nx + 1][(j * 4) + k]; - u[nx + 3][(j * 4) + k] = u[nx + 1][(j * 4) + k]; - - un[0][(j * 4) + k] = un[2][(j * 4) + k]; - un[1][(j * 4) + k] = un[2][(j * 4) + k]; - un[nx + 2][(j * 4) + k] = un[nx + 1][(j * 4) + k]; - un[nx + 3][(j * 4) + k] = un[nx + 1][(j * 4) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 4; k++) { - u[i][(0 * 4) + k] = u[i][(2 * 4) + k]; - u[i][(1 * 4) + k] = u[i][(2 * 4) + k]; - u[i][((ny + 2) * 4) + k] = u[i][((ny + 1) * 4) + k]; - u[i][((ny + 3) * 4) + k] = u[i][((ny + 1) * 4) + k]; - - un[i][(0 * 4) + k] = un[i][(2 * 4) + k]; - un[i][(1 * 4) + k] = un[i][(2 * 4) + k]; - un[i][((ny + 2) * 4) + k] = un[i][((ny + 1) * 4) + k]; - un[i][((ny + 3) * 4) + k] = un[i][((ny + 1) * 4) + k]; - } - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 4; k++) { - double r = (u[i][(j * 4) + k] - u[i][((j - 1) * 4) + k]) / (u[i][((j + 1) * 4) + k] - u[i][(j * 4) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 4) + k] = limiter * (0.5 * ((u[i][(j * 4) + k] - u[i][((j - 1) * 4) + k]) + (u[i][((j + 1) * 4) + k] - u[i][(j * 4) + k]))); - } - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 4; k++) { - umL_y[k] = u[i][((j - 1) * 4) + k] - (0.5 * slope_y[i][((j - 1) * 4) + k]); - umR_y[k] = u[i][((j - 1) * 4) + k] + (0.5 * slope_y[i][((j - 1) * 4) + k]); - - uiL_y[k] = u[i][(j * 4) + k] - (0.5 * slope_y[i][(j * 4) + k]); - uiR_y[k] = u[i][(j * 4) + k] + (0.5 * slope_y[i][(j * 4) + k]); - - upL_y[k] = u[i][((j + 1) * 4) + k] - (0.5 * slope_y[i][((j + 1) * 4) + k]); - upR_y[k] = u[i][((j + 1) * 4) + k] + (0.5 * slope_y[i][((j + 1) * 4) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umL_y[3] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - f_umR_y[3] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiL_y[3] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - f_uiR_y[3] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upL_y[3] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - f_upR_y[3] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 4; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; - f_umR_evol_y[3] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; - f_uiL_evol_y[3] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; - f_uiR_evol_y[3] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; - f_upL_evol_y[3] = ~a; // F(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 4; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). - for (int k = 0; k < 4; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 4; k++) { - un[i][(j * 4) + k] = u[i][(j * 4) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 4; k++) { - u[i][(j * 4) + k] = un[i][(j * 4) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 4; k++) { - u[0][(j * 4) + k] = u[2][(j * 4) + k]; - u[1][(j * 4) + k] = u[2][(j * 4) + k]; - u[nx + 2][(j * 4) + k] = u[nx + 1][(j * 4) + k]; - u[nx + 3][(j * 4) + k] = u[nx + 1][(j * 4) + k]; - - un[0][(j * 4) + k] = un[2][(j * 4) + k]; - un[1][(j * 4) + k] = un[2][(j * 4) + k]; - un[nx + 2][(j * 4) + k] = un[nx + 1][(j * 4) + k]; - un[nx + 3][(j * 4) + k] = un[nx + 1][(j * 4) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 4; k++) { - u[i][(0 * 4) + k] = u[i][(2 * 4) + k]; - u[i][(1 * 4) + k] = u[i][(2 * 4) + k]; - u[i][((ny + 2) * 4) + k] = u[i][((ny + 1) * 4) + k]; - u[i][((ny + 3) * 4) + k] = u[i][((ny + 1) * 4) + k]; - - un[i][(0 * 4) + k] = un[i][(2 * 4) + k]; - un[i][(1 * 4) + k] = un[i][(2 * 4) + k]; - un[i][((ny + 2) * 4) + k] = un[i][((ny + 1) * 4) + k]; - un[i][((ny + 3) * 4) + k] = un[i][((ny + 1) * 4) + k]; - } - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - for (int k = 0; k < 4; k++) { - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); - output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); - - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; - output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][(j * 4) + k]; - } - } - } - } - - // Output solution to disk. - for (int k = 0; k < 4; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 4) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 4; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 4; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - free(un[i]); - free(slope_x[i]); - free(slope_y[i]); - } - free(u); - free(un); - free(slope_x); - free(slope_y); - - free(local_alpha_x); - free(local_alpha_y); - - free(umL_x); - free(umR_x); - free(uiL_x); - free(uiR_x); - free(upL_x); - free(upR_x); - - free(f_umL_x); - free(f_umR_x); - free(f_uiL_x); - free(f_uiR_x); - free(f_upL_x); - free(f_upR_x); - - free(umR_evol_x); - free(uiL_evol_x); - free(uiR_evol_x); - free(upL_evol_x); - - free(f_umR_evol_x); - free(f_uiL_evol_x); - free(f_uiR_evol_x); - free(f_upL_evol_x); - - free(fluxL_x); - free(fluxR_x); - - free(umL_y); - free(umR_y); - free(uiL_y); - free(uiR_y); - free(upL_y); - free(upR_y); - - free(f_umL_y); - free(f_umR_y); - free(f_uiL_y); - free(f_uiR_y); - free(f_upL_y); - free(f_upR_y); - - free(umR_evol_y); - free(uiL_evol_y); - free(uiR_evol_y); - free(upL_evol_y); - - free(f_umR_evol_y); - free(f_uiL_evol_y); - free(f_uiR_evol_y); - free(f_upL_evol_y); - - free(fluxL_y); - free(fluxR_y); - - for (int i = 0; i < 4; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 4; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 3) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 3) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-x 3) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - (list-ref max-speed-locals-y 3) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umLs-y 3) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - (list-ref flux-umRs-y 3) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiLs-y 3) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - (list-ref flux-uiRs-y 3) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upLs-y 3) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - (list-ref flux-upRs-y 3) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-umR-evols-y 3) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - (list-ref flux-uiL-evols-y 3) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-uiR-evols-y 3) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - (list-ref flux-upL-evols-y 3) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). - (list-ref flux-umLs-x 0) - (list-ref flux-umLs-x 1) - (list-ref flux-umLs-x 2) - (list-ref flux-umLs-x 3) - (list-ref flux-umRs-x 0) - (list-ref flux-umRs-x 1) - (list-ref flux-umRs-x 2) - (list-ref flux-umRs-x 3) - ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). - (list-ref flux-uiLs-x 0) - (list-ref flux-uiLs-x 1) - (list-ref flux-uiLs-x 2) - (list-ref flux-uiLs-x 3) - (list-ref flux-uiRs-x 0) - (list-ref flux-uiRs-x 1) - (list-ref flux-uiRs-x 2) - (list-ref flux-uiRs-x 3) - ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). - (list-ref flux-upLs-x 0) - (list-ref flux-upLs-x 1) - (list-ref flux-upLs-x 2) - (list-ref flux-upLs-x 3) - (list-ref flux-upRs-x 0) - (list-ref flux-upRs-x 1) - (list-ref flux-upRs-x 2) - (list-ref flux-upRs-x 3) - ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). - (list-ref flux-umR-evols-x 0) - (list-ref flux-umR-evols-x 1) - (list-ref flux-umR-evols-x 2) - (list-ref flux-umR-evols-x 3) - (list-ref flux-uiL-evols-x 0) - (list-ref flux-uiL-evols-x 1) - (list-ref flux-uiL-evols-x 2) - (list-ref flux-uiL-evols-x 3) - ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). - (list-ref flux-uiR-evols-x 0) - (list-ref flux-uiR-evols-x 1) - (list-ref flux-uiR-evols-x 2) - (list-ref flux-uiR-evols-x 3) - (list-ref flux-upL-evols-x 0) - (list-ref flux-upL-evols-x 1) - (list-ref flux-upL-evols-x 2) - (list-ref flux-upL-evols-x 3) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umLs-y 3) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - (list-ref flux-umRs-y 3) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiLs-y 3) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - (list-ref flux-uiRs-y 3) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upLs-y 3) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - (list-ref flux-upRs-y 3) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-umR-evols-y 3) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - (list-ref flux-uiL-evols-y 3) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-uiR-evols-y 3) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - (list-ref flux-upL-evols-y 3) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_matrix_validation.rkt b/provable-algorithms/neural_networks/code_generator_matrix_validation.rkt deleted file mode 100644 index ba40a026..00000000 --- a/provable-algorithms/neural_networks/code_generator_matrix_validation.rkt +++ /dev/null @@ -1,1074 +0,0 @@ -#lang racket - -(require "code_generator_core_training.rkt") -(require "code_generator_core_validation.rkt") -(provide validate-vector3-1d - validate-vector3-1d-second-order - validate-vector4-2d - validate-vector4-2d-second-order) - -;; --------------------------------------------------------------------------------------------- -;; Validate an Arbitrary (First-Order) Surrogate Solver for a 1D Coupled Vector System of 3 PDEs -;; --------------------------------------------------------------------------------------------- -(define (validate-vector3-1d pde-system neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 0.0] - [else 0.0]) - `(cond - [(< x 0.5) 7.5] - [else 2.5]))]) - "Generate C code that validates a surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde` using any first-order method, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 3) + 0]") - (list-ref cons-codes 1) "u[(i * 3) + 1]") (list-ref cons-codes 2) "u[(i * 3) + 2]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a -// Validate any first-order surrogate solver for a coupled vector system of 3 PDEs in 1D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * 3 * sizeof(double)); - double *un = (double*) malloc((nx + 2) * 3 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(3 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[(i * 3) + 0] = ~a; // init-funcs[0] in C. - u[(i * 3) + 1] = ~a; // init-funcs[1] in C. - u[(i * 3) + 2] = ~a; // init-funcs[2] in C. - } - - // Load neural network architecture. - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann[i] = kann_load(file_nm); - - fclose(fptr); - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - local_alpha[2] = ~a; // max-speed-exprs[2] in C. - - for (int j = 0; j < 3; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 1; i <= nx; i++) { - for (int j = 0; j < 3; j++) { - double x = x0 + (i - 0.5) * dx; - - float *input_data = (float*) malloc(2 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - - output_data = kann_apply1(ann[j], input_data); - - u[(i * 3) + j] = output_data[0]; - - free(input_data); - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 3; j++) { - u[(0 * 3) + j] = u[(1 * 3) + j]; - u[((nx + 1) * 3) + j] = u[(nx * 3) + j]; - } - - // Output solution to disk. - for (int j = 0; j < 3; j++) { - const char *fmt = \"%s_validation_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr; - fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 3) + j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - free(u); - free(local_alpha); - - for (int i = 0; i < 3; i++) { - kann_delete(ann[i]); - } - free(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - (list-ref max-speed-locals 2) - ;; PDE name for file output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------- -;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 1D Coupled Vector System of 3 PDEs -;; ---------------------------------------------------------------------------------------------- -(define (validate-vector3-1d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 0.0] - [else 0.0]) - `(cond - [(< x 0.5) 7.5] - [else 2.5]))]) - "Generate C code that validates a surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde` using any first-order method - with any second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 3) + 0]") - (list-ref cons-codes 1) "u[(i * 3) + 1]") (list-ref cons-codes 2) "u[(i * 3) + 2]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Validate any first-order surrogate solver for a coupled vector system of 3 PDEs in 1D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * 3 * sizeof(double)); - double *un = (double*) malloc((nx + 4) * 3 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(3 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[(i * 3) + 0] = ~a; // init-funcs[0] in C. - u[(i * 3) + 1] = ~a; // init-funcs[1] in C. - u[(i * 3) + 2] = ~a; // init-funcs[2] in C. - } - - // Load neural network architecture. - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann[i] = kann_load(file_nm); - - fclose(fptr); - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx + 2; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - local_alpha[2] = ~a; // max-speed-exprs[2] in C. - - for (int j = 0; j < 3; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 0; j < 3; j++) { - double x = x0 + (i - 1.5) * dx; - - float *input_data = (float*) malloc(2 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - - output_data = kann_apply1(ann[j], input_data); - - u[(i * 3) + j] = output_data[0]; - - free(input_data); - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 3; j++) { - u[(0 * 3) + j] = u[(2 * 3) + j]; - u[(1 * 3) + j] = u[(2 * 3) + j]; - u[((nx + 2) * 3) + j] = u[((nx + 1) * 3) + j]; - u[((nx + 3) * 3) + j] = u[((nx + 1) * 3) + j]; - } - - // Output solution to disk. - for (int j = 0; j < 3; j++) { - const char *fmt = \"%s_validation_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr; - fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 3) + j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - free(u); - free(local_alpha); - - for (int i = 0; i < 3; i++) { - kann_delete(ann[i]); - } - free(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - (list-ref max-speed-locals 2) - ;; PDE name for file output. - name - name - )) - code) - -;; --------------------------------------------------------------------------------------------- -;; Validate an Arbitrary (First-Order) Surrogate Solver for a 2D Coupled Vector System of 4 PDEs -;; --------------------------------------------------------------------------------------------- -(define (validate-vector4-2d pde-system neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0 - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]))]) - "Generate C code that validates a surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde` using any first-order method, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 4) + 0]") - (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") - (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 4) + 0]") - (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") - (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a -// Validate any first-order surrogate solver for a coupled vector system of 4 PDEs in 2D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * 4 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(4 * sizeof(double)); - double *local_alpha_y = (double*) malloc(4 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. - u[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. - } - } - - // Load neural network architecture. - kann_t **ann = (kann_t**) malloc(4 * sizeof(kann_t*)); - - for (int i = 0; i < 4; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann[i] = kann_load(file_nm); - - fclose(fptr); - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - local_alpha_x[3] = ~a; // max-speed-exprs-x[3] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - local_alpha_y[3] = ~a; // max-speed-exprs-y[3] in C. - - for (int k = 0; k < 4; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 4; k++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - -.5) * dy; - - float *input_data = (float*) malloc(4 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - input_data[2] = y; - - output_data = kann_apply1(ann[k], input_data); - - u[i][(j * 4) + k] = output_data[0]; - - free(input_data); - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 4; k++) { - u[0][(j * 4) + k] = u[1][(j * 4) + k]; - u[nx + 1][(j * 4) + k] = u[nx][(j * 4) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 4; k++) { - u[i][(0 * 4) + k] = u[i][(1 * 4) + k]; - u[i][((ny + 1) * 4) + k] = u[i][(ny * 4) + k]; - } - } - - // Output solution to disk. - for (int k = 0; k < 4; k++) { - const char *fmt = \"%s_validation_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 4) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - } - free(u); - - free(local_alpha_x); - free(local_alpha_y); - - for (int i = 0; i < 4; i++) { - kann_delete(ann[i]); - } - free(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 3) - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-x 3) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - (list-ref max-speed-locals-y 3) - ;; PDE name for file output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------- -;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 2D Coupled Vector System of 4 PDEs -;; ---------------------------------------------------------------------------------------------- -(define (validate-vector4-2d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0 - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]))]) - "Generate C code that validates a surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde` using any first-order method - with any second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 4) + 0]") - (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") - (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 4) + 0]") - (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") - (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Validate any first-order surrogate solver for a coupled vector system of 4 PDEs in 2D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(4 * sizeof(double)); - double *local_alpha_y = (double*) malloc(4 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. - u[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. - } - } - - // Load neural network architecture. - kann_t **ann = (kann_t**) malloc(4 * sizeof(kann_t*)); - - for (int i = 0; i < 4; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann[i] = kann_load(file_nm); - - fclose(fptr); - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - local_alpha_x[3] = ~a; // max-speed-exprs-x[3] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - local_alpha_y[3] = ~a; // max-speed-exprs-y[3] in C. - - for (int k = 0; k < 4; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - for (int k = 0; k < 4; k++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - float *input_data = (float*) malloc(4 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - input_data[2] = y; - - output_data = kann_apply1(ann[k], input_data); - - u[i][(j * 4) + k] = output_data[0]; - - free(input_data); - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 4; k++) { - u[0][(j * 4) + k] = u[2][(j * 4) + k]; - u[1][(j * 4) + k] = u[2][(j * 4) + k]; - u[nx + 2][(j * 4) + k] = u[nx + 1][(j * 4) + k]; - u[nx + 3][(j * 4) + k] = u[nx + 1][(j * 4) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 4; k++) { - u[i][(0 * 4) + k] = u[i][(2 * 4) + k]; - u[i][(1 * 4) + k] = u[i][(2 * 4) + k]; - u[i][((ny + 2) * 4) + k] = u[i][((ny + 1) * 4) + k]; - u[i][((ny + 3) * 4) + k] = u[i][((ny + 1) * 4) + k]; - } - } - - // Output solution to disk. - for (int k = 0; k < 4; k++) { - const char *fmt = \"%s_validation_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 4) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 4; i++) { - free(u[i]); - } - free(u); - - free(local_alpha_x); - free(local_alpha_y); - - for (int i = 0; i < 4; i++) { - kann_delete(ann[i]); - } - free(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 3) - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-x 3) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - (list-ref max-speed-locals-y 3) - ;; PDE name for file output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_vector_training.rkt b/provable-algorithms/neural_networks/code_generator_vector_training.rkt deleted file mode 100644 index f7996c3d..00000000 --- a/provable-algorithms/neural_networks/code_generator_vector_training.rkt +++ /dev/null @@ -1,1888 +0,0 @@ -#lang racket - -(require "prover_vector.rkt") -(require "code_generator_core_training.rkt") -(provide train-lax-friedrichs-vector2-1d - train-lax-friedrichs-vector2-1d-second-order - train-roe-vector2-1d - train-roe-vector2-1d-second-order) - -;; ---------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs -;; ---------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-vector2-1d pde-system neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that trains a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") - (list-ref cons-codes 1) "um[1]")) flux-codes)) - (define flux-uis (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") - (list-ref cons-codes 1) "ui[1]")) flux-codes)) - (define flux-ups (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") - (list-ref cons-codes 1) "up[1]")) flux-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 2 PDEs in 1D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); - double *un = (double*) malloc((nx + 2) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - double *um = (double*) malloc(2 * sizeof(double)); - double *ui = (double*) malloc(2 * sizeof(double)); - double *up = (double*) malloc(2 * sizeof(double)); - - double *f_um = (double*) malloc(2 * sizeof(double)); - double *f_ui = (double*) malloc(2 * sizeof(double)); - double *f_up = (double*) malloc(2 * sizeof(double)); - - double *fluxL = (double*) malloc(2 * sizeof(double)); - double *fluxR = (double*) malloc(2 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(2 * sizeof(float**)); - float ***output_data = (float***) malloc(2 * sizeof(float**)); - - for (int i = 0; i < 2; i++) { - input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - un[(i * 2) + 0] = ~a; // init-funcs[0] in C. - un[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(2 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); - - for (int i = 0; i < 2; i++) { - t_net[i] = kann_layer_input(2); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. - for (int i = 1; i <= nx; i++) { - for (int j = 0; j < 2; j++) { - um[j] = u[((i - 1) * 2) + j]; - ui[j] = u[(i * 2) + j]; - up[j] = u[((i + 1) * 2) + j]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um[0] = ~a; - f_um[1] = ~a; // F(U_{i - 1}). - - f_ui[0] = ~a; - f_ui[1] = ~a; // F(U_i). - - f_up[0] = ~a; - f_up[1] = ~a; // F(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha * (U_i - U_{i - 1}). - for (int j = 0; j < 2; j++) { - fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * alpha * (ui[j] - um[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha * (U_{i + 1} - U_i). - for (int j = 0; j < 2; j++) { - fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * alpha * (up[j] - ui[j]); - } - - // Update the conserved variable vector. - for (int j = 0; j < 2; j++) { - un[(i * 2) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j < 2; j++) { - u[(i * 2) + j] = un[(i * 2) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(1 * 2) + j]; - u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - - for (int j = 0; j < 2; j++) { - input_data[j][(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); - output_data[j][(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); - - input_data[j][(n * nx) + (i - 1)][0] = t; - input_data[j][(n * nx) + (i - 1)][1] = x; - output_data[j][(n * nx) + (i - 1)][0] = u[(i * 2) + j]; - } - } - } - - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 2; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 2; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - free(u); - free(un); - - free(local_alpha); - - free(um); - free(ui); - free(up); - - free(f_um); - free(f_ui); - free(f_up); - - free(fluxL); - free(fluxR); - - for (int i = 0; i < 2; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 2; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; Left flux vector F(u_{i - 1}). - (list-ref flux-ums 0) - (list-ref flux-ums 1) - ;; Middle flux vector F(u_i). - (list-ref flux-uis 0) - (list-ref flux-uis 1) - ;; Right flux vector F(u_{i + 1}). - (list-ref flux-ups 0) - (list-ref flux-ups 1) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-vector2-1d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that trains a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method - with a second-order flux extrapolation using the limiter `limiter`, with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") - (list-ref cons-codes 1) "umL[1]")) flux-codes)) - (define flux-umRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") - (list-ref cons-codes 1) "umR[1]")) flux-codes)) - (define flux-uiLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") - (list-ref cons-codes 1) "uiL[1]")) flux-codes)) - (define flux-uiRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") - (list-ref cons-codes 1) "uiR[1]")) flux-codes)) - (define flux-upLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") - (list-ref cons-codes 1) "upL[1]")) flux-codes)) - (define flux-upRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") - (list-ref cons-codes 1) "upR[1]")) flux-codes)) - - (define flux-umR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") - (list-ref cons-codes 1) "umR_evol[1]")) flux-codes)) - (define flux-uiL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") - (list-ref cons-codes 1) "uiL_evol[1]")) flux-codes)) - (define flux-uiR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") - (list-ref cons-codes 1) "uiR_evol[1]")) flux-codes)) - (define flux-upL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") - (list-ref cons-codes 1) "upL_evol[1]")) flux-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Array for storing slopes. - double *slope = (double*) malloc((nx + 4) * 2 * sizeof(double)); - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); - double *un = (double*) malloc((nx + 4) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - double *umL = (double*) malloc(2 * sizeof(double)); - double *umR = (double*) malloc(2 * sizeof(double)); - double *uiL = (double*) malloc(2 * sizeof(double)); - double *uiR = (double*) malloc(2 * sizeof(double)); - double *upL = (double*) malloc(2 * sizeof(double)); - double *upR = (double*) malloc(2 * sizeof(double)); - - double *f_umL = (double*) malloc(2 * sizeof(double)); - double *f_umR = (double*) malloc(2 * sizeof(double)); - double *f_uiL = (double*) malloc(2 * sizeof(double)); - double *f_uiR = (double*) malloc(2 * sizeof(double)); - double *f_upL = (double*) malloc(2 * sizeof(double)); - double *f_upR = (double*) malloc(2 * sizeof(double)); - - double *umR_evol = (double*) malloc(2 * sizeof(double)); - double *uiL_evol = (double*) malloc(2 * sizeof(double)); - double *uiR_evol = (double*) malloc(2 * sizeof(double)); - double *upL_evol = (double*) malloc(2 * sizeof(double)); - - double *f_umR_evol = (double*) malloc(2 * sizeof(double)); - double *f_uiL_evol = (double*) malloc(2 * sizeof(double)); - double *f_uiR_evol = (double*) malloc(2 * sizeof(double)); - double *f_upL_evol = (double*) malloc(2 * sizeof(double)); - - double *fluxL = (double*) malloc(2 * sizeof(double)); - double *fluxR = (double*) malloc(2 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(2 * sizeof(float**)); - float ***output_data = (float***) malloc(2 * sizeof(float**)); - - for (int i = 0; i < 2; i++) { - input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - un[(i * 2) + 0] = ~a; // init-funcs[0] in C. - un[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(2 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); - - for (int i = 0; i < 2; i++) { - t_net[i] = kann_layer_input(2); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 0; j < 2; j++) { - double r = (u[(i * 2) + j] - u[((i - 1) * 2) + j]) / (u[((i + 1) * 2) + j] - u[(i * 2) + j]); - double limiter = ~a; // limiter-r in C. - - slope[(i * 2) + j] = limiter * (0.5 * ((u[(i * 2) + j] - u[((i - 1) * 2) + j]) + (u[((i + 1) * 2) + j] - u[(i * 2) + j]))); - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. - for (int i = 2; i <= nx + 1; i++) { - // Extrapolate boundary states. - for (int j = 0; j < 2; j++) { - umL[j] = u[((i - 1) * 2) + j] - (0.5 * slope[((i - 1) * 2) + j]); - umR[j] = u[((i - 1) * 2) + j] + (0.5 * slope[((i - 1) * 2) + j]); - - uiL[j] = u[(i * 2) + j] - (0.5 * slope[(i * 2) + j]); - uiR[j] = u[(i * 2) + j] + (0.5 * slope[(i * 2) + j]); - - upL[j] = u[((i + 1) * 2) + j] - (0.5 * slope[((i + 1) * 2) + j]); - upR[j] = u[((i + 1) * 2) + j] + (0.5 * slope[((i + 1) * 2) + j]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL[0] = ~a; - f_umL[1] = ~a; - f_umR[0] = ~a; - f_umR[1] = ~a; - - f_uiL[0] = ~a; - f_uiL[1] = ~a; - f_uiR[0] = ~a; - f_uiR[1] = ~a; - - f_upL[0] = ~a; - f_upL[1] = ~a; - f_upR[0] = ~a; - f_upR[1] = ~a; - - // Evolve each extrapolated boundary state. - for (int j = 0; j < 2; j++) { - umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); - - uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - - upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol[0] = ~a; - f_umR_evol[1] = ~a; // F(U_{i - 1, R+}) - f_uiL_evol[0] = ~a; - f_uiL_evol[1] = ~a; // F(U_{i, L+}) - - f_uiR_evol[0] = ~a; - f_uiR_evol[1] = ~a; // F(U_{i, R+}) - f_upL_evol[0] = ~a; - f_upL_evol[1] = ~a; // F(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha * (U_{i, L+} - U_{i - 1, R+}). - for (int j = 0; j < 2; j++) { - fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * alpha * (uiL_evol[j] - umR_evol[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha * (U_{i + 1, L+} - U_{i, R+}). - for (int j = 0; j < 2; j++) { - fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * alpha * (upL_evol[j] - uiR_evol[j]); - } - - // Update the conserved variable vector. - for (int j = 0; j < 2; j++) { - un[(i * 2) + j] = u[(i * 2) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j < 2; j++) { - u[(i * 2) + j] = un[(i * 2) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(2 * 2) + j]; - u[(1 * 2) + j] = u[(2 * 2) + j]; - u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; - u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - - for (int j = 0; j < 2; j++) { - input_data[j][(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); - output_data[j][(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); - - input_data[j][(n * nx) + (i - 2)][0] = t; - input_data[j][(n * nx) + (i - 2)][1] = x; - output_data[j][(n * nx) + (i - 2)][0] = u[(i * 2) + j]; - } - } - } - - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 2; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 2; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - free(u); - free(un); - free(slope); - - free(local_alpha); - - free(umL); - free(umR); - free(uiL); - free(uiR); - free(upL); - free(upR); - - free(f_umL); - free(f_umR); - free(f_uiL); - free(f_uiR); - free(f_upL); - free(f_upR); - - free(umR_evol); - free(uiL_evol); - free(uiR_evol); - free(upL_evol); - - free(f_umR_evol); - free(f_uiL_evol); - free(f_uiR_evol); - free(f_upL_evol); - - free(fluxL); - free(fluxR); - - for (int i = 0; i < 2; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 2; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; Expression for flux limiter function. - limiter-r - ;; Left negative flux vector F(U_{i - 1, L}). - (list-ref flux-umLs 0) - (list-ref flux-umLs 1) - ;; Right negative flux vector F(U_{i - 1, R}). - (list-ref flux-umRs 0) - (list-ref flux-umRs 1) - ;; Left central flux vector F(U_{i, L}). - (list-ref flux-uiLs 0) - (list-ref flux-uiLs 1) - ;; Right central flux vector F(U_{i, R}). - (list-ref flux-uiRs 0) - (list-ref flux-uiRs 1) - ;; Left positive flux vector F(U_{i + 1, L}). - (list-ref flux-upLs 0) - (list-ref flux-upLs 1) - ;; Right positive flux vector F(U_{i + 1, R}). - (list-ref flux-upRs 0) - (list-ref flux-upRs 1) - ;; Evolved right negative flux vector F(U_{i - 1, R+}). - (list-ref flux-umR-evols 0) - (list-ref flux-umR-evols 1) - ;; Evolved left central flux vector F(U_{i, L+}). - (list-ref flux-uiL-evols 0) - (list-ref flux-uiL-evols 1) - ;; Evolved right central flux vector F(U_{i, R+}). - (list-ref flux-uiR-evols 0) - (list-ref flux-uiR-evols 1) - ;; Evolved left positive flux vector F(U_{i + 1, L+}). - (list-ref flux-upL-evols 0) - (list-ref flux-upL-evols 1) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------- -;; Train a Roe (Finite-Volume) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------------------------- -(define (train-roe-vector2-1d pde-system neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that trains a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define flux-deriv-codes (map (lambda (flux-deriv-expr) - (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") - (list-ref cons-codes 1) "um[1]")) flux-codes)) - (define flux-uis (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") - (list-ref cons-codes 1) "ui[1]")) flux-codes)) - (define flux-ups (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") - (list-ref cons-codes 1) "up[1]")) flux-codes)) - - (define flux-deriv-ums (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "um[0]") - (list-ref cons-codes 1) "um[1]")) flux-deriv-codes)) - (define flux-deriv-uis (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "ui[0]") - (list-ref cons-codes 1) "ui[1]")) flux-deriv-codes)) - (define flux-deriv-ups (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "up[0]") - (list-ref cons-codes 1) "up[1]")) flux-deriv-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// Train a Roe higher-order finite-volume surrogate solver for a coupled vector system of 2 PDEs in 1D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); - double *un = (double*) malloc((nx + 2) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - double *um = (double*) malloc(2 * sizeof(double)); - double *ui = (double*) malloc(2 * sizeof(double)); - double *up = (double*) malloc(2 * sizeof(double)); - - double *f_um = (double*) malloc(2 * sizeof(double)); - double *f_ui = (double*) malloc(2 * sizeof(double)); - double *f_up = (double*) malloc(2 * sizeof(double)); - - double *f_deriv_um = (double*) malloc(2 * sizeof(double)); - double *f_deriv_ui = (double*) malloc(2 * sizeof(double)); - double *f_deriv_up = (double*) malloc(2 * sizeof(double)); - - double *aL_roe = (double*) malloc(2 * sizeof(double)); - double *aR_roe = (double*) malloc(2 * sizeof(double)); - - double *fluxL = (double*) malloc(2 * sizeof(double)); - double *fluxR = (double*) malloc(2 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(2 * sizeof(float**)); - float ***output_data = (float***) malloc(2 * sizeof(float**)); - - for (int i = 0; i < 2; i++) { - input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - un[(i * 2) + 0] = ~a; // init-funcs[0] in C. - un[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(2 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); - - for (int i = 0; i < 2; i++) { - t_net[i] = kann_layer_input(2); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Roe approximation and update the conserved variable vector. - for (int i = 1; i <= nx; i++) { - for (int j = 0; j < 2; j++) { - um[j] = u[((i - 1) * 2) + j]; - ui[j] = u[(i * 2) + j]; - up[j] = u[((i + 1) * 2) + j]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um[0] = ~a; - f_um[1] = ~a; // F(U_{i - 1}). - - f_ui[0] = ~a; - f_ui[1] = ~a; // F(U_i). - - f_up[0] = ~a; - f_up[1] = ~a; // F(U_{i + 1}). - - // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. - f_deriv_um[0] = ~a; - f_deriv_um[1] = ~a; // Eigenvalues of F'(U_{i - 1}). - - f_deriv_ui[0] = ~a; - f_deriv_ui[1] = ~a; // Eigenvalues of F'(U_i). - - f_deriv_up[0] = ~a; - f_deriv_up[1] = ~a; // Eigenvalues of F'(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * |aL_roe| * (U_i - U_{i - 1}). - for (int j = 0; j < 2; j++) { - aL_roe[j] = 0.5 * (f_deriv_um[j] + f_deriv_ui[j]); - } - for (int j = 0; j < 2; j++) { - fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * fabs(aL_roe[j]) * (ui[j] - um[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * |aR_roe| * (U_{i + 1} - u_i). - for (int j = 0; j < 2; j++) { - aR_roe[j] = 0.5 * (f_deriv_ui[j] + f_deriv_up[j]); - } - for (int j = 0; j < 2; j++) { - fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * fabs(aR_roe[j]) * (up[j] - ui[j]); - } - - // Update the conserved variable. - for (int j = 0; j < 2; j++) { - un[(i * 2) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j < 2; j++) { - u[(i * 2) + j] = un[(i * 2) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(1 * 2) + j]; - u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - - for (int j = 0; j < 2; j++) { - input_data[j][(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); - output_data[j][(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); - - input_data[j][(n * nx) + (i - 1)][0] = t; - input_data[j][(n * nx) + (i - 1)][1] = x; - output_data[j][(n * nx) + (i - 1)][0] = u[(i * 2) + j]; - } - } - } - - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 2; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 2; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - free(u); - free(un); - - free(local_alpha); - - free(um); - free(ui); - free(up); - - free(f_um); - free(f_ui); - free(f_up); - - free(f_deriv_um); - free(f_deriv_ui); - free(f_deriv_up); - - free(aL_roe); - free(aR_roe); - - free(fluxL); - free(fluxR); - - for (int i = 0; i < 2; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 2; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; Left flux vector F(u_{i - 1}). - (list-ref flux-ums 0) - (list-ref flux-ums 1) - ;; Middle flux vector F(u_i). - (list-ref flux-uis 0) - (list-ref flux-uis 1) - ;; Right flux vector F(u_{i + 1}). - (list-ref flux-ups 0) - (list-ref flux-ups 1) - ;; Eigenvalues of left flux Jacobian F'(u_{i - 1}). - (list-ref flux-deriv-ums 0) - (list-ref flux-deriv-ums 1) - ;; Eigenvalues of middle flux Jacobian F'(u_i). - (list-ref flux-deriv-uis 0) - (list-ref flux-deriv-uis 1) - ;; Eigenvalues of right flux Jacobian F'(u_{i + 1}). - (list-ref flux-deriv-ups 0) - (list-ref flux-deriv-ups 1) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------------------------------------- -;; Train a Roe (Finite-Volume) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs with a Second-Order Flux Extrapolation -;; ---------------------------------------------------------------------------------------------------------------------------- -(define (train-roe-vector2-1d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that trains a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method - with a second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define flux-deriv-codes (map (lambda (flux-deriv-expr) - (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") - (list-ref cons-codes 1) "umL[1]")) flux-codes)) - (define flux-umRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") - (list-ref cons-codes 1) "umR[1]")) flux-codes)) - (define flux-uiLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") - (list-ref cons-codes 1) "uiL[1]")) flux-codes)) - (define flux-uiRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") - (list-ref cons-codes 1) "uiR[1]")) flux-codes)) - (define flux-upLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") - (list-ref cons-codes 1) "upL[1]")) flux-codes)) - (define flux-upRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") - (list-ref cons-codes 1) "upR[1]")) flux-codes)) - - (define flux-umR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") - (list-ref cons-codes 1) "umR_evol[1]")) flux-codes)) - (define flux-uiL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") - (list-ref cons-codes 1) "uiL_evol[1]")) flux-codes)) - (define flux-uiR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") - (list-ref cons-codes 1) "uiR_evol[1]")) flux-codes)) - (define flux-upL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") - (list-ref cons-codes 1) "upL_evol[1]")) flux-codes)) - - (define flux-deriv-umR-evols (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "umR_evol[0]") - (list-ref cons-codes 1) "umR_evol[1]")) flux-deriv-codes)) - (define flux-deriv-uiL-evols (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "uiL_evol[0]") - (list-ref cons-codes 1) "uiL_evol[1]")) flux-deriv-codes)) - (define flux-deriv-uiR-evols (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "uiR_evol[0]") - (list-ref cons-codes 1) "uiR_evol[1]")) flux-deriv-codes)) - (define flux-deriv-upL-evols (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "upL_evol[0]") - (list-ref cons-codes 1) "upL_evol[1]")) flux-deriv-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Train a Roe higher-order finite-volume surrogate solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Array for storing slopes. - double *slope = (double*) malloc((nx + 4) * 2 * sizeof(double)); - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); - double *un = (double*) malloc((nx + 4) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - double *umL = (double*) malloc(2 * sizeof(double)); - double *umR = (double*) malloc(2 * sizeof(double)); - double *uiL = (double*) malloc(2 * sizeof(double)); - double *uiR = (double*) malloc(2 * sizeof(double)); - double *upL = (double*) malloc(2 * sizeof(double)); - double *upR = (double*) malloc(2 * sizeof(double)); - - double *f_umL = (double*) malloc(2 * sizeof(double)); - double *f_umR = (double*) malloc(2 * sizeof(double)); - double *f_uiL = (double*) malloc(2 * sizeof(double)); - double *f_uiR = (double*) malloc(2 * sizeof(double)); - double *f_upL = (double*) malloc(2 * sizeof(double)); - double *f_upR = (double*) malloc(2 * sizeof(double)); - - double *umR_evol = (double*) malloc(2 * sizeof(double)); - double *uiL_evol = (double*) malloc(2 * sizeof(double)); - double *uiR_evol = (double*) malloc(2 * sizeof(double)); - double *upL_evol = (double*) malloc(2 * sizeof(double)); - - double *f_umR_evol = (double*) malloc(2 * sizeof(double)); - double *f_uiL_evol = (double*) malloc(2 * sizeof(double)); - double *f_uiR_evol = (double*) malloc(2 * sizeof(double)); - double *f_upL_evol = (double*) malloc(2 * sizeof(double)); - - double *f_deriv_umR_evol = (double*) malloc(2 * sizeof(double)); - double *f_deriv_uiL_evol = (double*) malloc(2 * sizeof(double)); - double *f_deriv_uiR_evol = (double*) malloc(2 * sizeof(double)); - double *f_deriv_upL_evol = (double*) malloc(2 * sizeof(double)); - - double *aL_roe = (double*) malloc(2 * sizeof(double)); - double *aR_roe = (double*) malloc(2 * sizeof(double)); - - double *fluxL = (double*) malloc(2 * sizeof(double)); - double *fluxR = (double*) malloc(2 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(2 * sizeof(float**)); - float ***output_data = (float***) malloc(2 * sizeof(float**)); - - for (int i = 0; i < 2; i++) { - input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - un[(i * 2) + 0] = ~a; // init-funcs[0] in C. - un[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(2 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); - - for (int i = 0; i < 2; i++) { - t_net[i] = kann_layer_input(2); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 0; j < 2; j++) { - double r = (u[(i * 2) + j] - u[((i - 1) * 2) + j]) / (u[((i + 1) * 2) + j] - u[(i * 2) + j]); - double limiter = ~a; // limiter-r in C. - - slope[(i * 2) + j] = limiter * (0.5 * ((u[(i * 2) + j] - u[((i - 1) * 2) + j]) + (u[((i + 1) * 2) + j] - u[(i * 2) + j]))); - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector. - for (int i = 2; i <= nx + 1; i++) { - // Extrapolate boundary states. - for (int j = 0; j < 2; j++) { - umL[j] = u[((i - 1) * 2) + j] - (0.5 * slope[((i - 1) * 2) + j]); - umR[j] = u[((i - 1) * 2) + j] + (0.5 * slope[((i - 1) * 2) + j]); - - uiL[j] = u[(i * 2) + j] - (0.5 * slope[(i * 2) + j]); - uiR[j] = u[(i * 2) + j] + (0.5 * slope[(i * 2) + j]); - - upL[j] = u[((i + 1) * 2) + j] - (0.5 * slope[((i + 1) * 2) + j]); - upR[j] = u[((i + 1) * 2) + j] + (0.5 * slope[((i + 1) * 2) + j]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL[0] = ~a; - f_umL[1] = ~a; - f_umR[0] = ~a; - f_umR[1] = ~a; - - f_uiL[0] = ~a; - f_uiL[1] = ~a; - f_uiR[0] = ~a; - f_uiR[1] = ~a; - - f_upL[0] = ~a; - f_upL[1] = ~a; - f_upR[0] = ~a; - f_upR[1] = ~a; - - // Evolve each extrapolated boundary state. - for (int j = 0; j < 2; j++) { - umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); - - uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - - upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol[0] = ~a; - f_umR_evol[1] = ~a; // F(U_{i - 1, R+}) - f_uiL_evol[0] = ~a; - f_uiL_evol[1] = ~a; // F(U_{i, L+}) - - f_uiR_evol[0] = ~a; - f_uiR_evol[1] = ~a; // F(U_{i, R+}) - f_upL_evol[0] = ~a; - f_upL_evol[1] = ~a; // F(U_{i + 1, L+}) - - // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. - f_deriv_umR_evol[0] = ~a; - f_deriv_umR_evol[1] = ~a; // F'(U_{i - 1, R+}) - f_deriv_uiL_evol[0] = ~a; - f_deriv_uiL_evol[1] = ~a; // F'(U_{i, L+}) - - f_deriv_uiR_evol[0] = ~a; - f_deriv_uiR_evol[1] = ~a; // F'(U_{i, R+}) - f_deriv_upL_evol[0] = ~a; - f_deriv_upL_evol[1] = ~a; // F'(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * |aL_roe| * (U_{i, L+} - U_{i - 1, R+}). - for (int j = 0; j < 2; j++) { - aL_roe[j] = 0.5 * (f_deriv_umR_evol[j] + f_deriv_uiL_evol[j]); - } - for (int j = 0; j < 2; j++) { - fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * fabs(aL_roe[j]) * (uiL_evol[j] - umR_evol[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * |aR_roe| * (U_{i + 1, L+} - u_{i, R+}). - for (int j = 0; j < 2; j++) { - aR_roe[j] = 0.5 * (f_deriv_uiR_evol[j] + f_deriv_upL_evol[j]); - } - for (int j = 0; j < 2; j++) { - fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * fabs(aR_roe[j]) * (upL_evol[j] - uiR_evol[j]); - } - - // Update the conserved variable. - for (int j = 0; j < 2; j++) { - un[(i * 2) + j] = u[(i * 2) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j < 2; j++) { - u[(i * 2) + j] = un[(i * 2) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(2 * 2) + j]; - u[(1 * 2) + j] = u[(2 * 2) + j]; - u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; - u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - - for (int j = 0; j < 2; j++) { - input_data[j][(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); - output_data[j][(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); - - input_data[j][(n * nx) + (i - 2)][0] = t; - input_data[j][(n * nx) + (i - 2)][1] = x; - output_data[j][(n * nx) + (i - 2)][0] = u[(i * 2) + j]; - } - } - } - - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 2; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 2; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - free(u); - free(un); - free(slope); - - free(local_alpha); - - free(umL); - free(umR); - free(uiL); - free(uiR); - free(upL); - free(upR); - - free(f_umL); - free(f_umR); - free(f_uiL); - free(f_uiR); - free(f_upL); - free(f_upR); - - free(umR_evol); - free(uiL_evol); - free(uiR_evol); - free(upL_evol); - - free(f_umR_evol); - free(f_uiL_evol); - free(f_uiR_evol); - free(f_upL_evol); - - free(f_deriv_umR_evol); - free(f_deriv_uiL_evol); - free(f_deriv_uiR_evol); - free(f_deriv_upL_evol); - - free(fluxL); - free(fluxR); - - for (int i = 0; i < 2; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 2; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; Expression for flux limiter function. - limiter-r - ;; Left negative flux vector F(U_{i - 1, L}). - (list-ref flux-umLs 0) - (list-ref flux-umLs 1) - ;; Right negative flux vector F(U_{i - 1, R}). - (list-ref flux-umRs 0) - (list-ref flux-umRs 1) - ;; Left central flux vector F(U_{i, L}). - (list-ref flux-uiLs 0) - (list-ref flux-uiLs 1) - ;; Right central flux vector F(U_{i, R}). - (list-ref flux-uiRs 0) - (list-ref flux-uiRs 1) - ;; Left positive flux vector F(U_{i + 1, L}). - (list-ref flux-upLs 0) - (list-ref flux-upLs 1) - ;; Right positive flux vector F(U_{i + 1, R}). - (list-ref flux-upRs 0) - (list-ref flux-upRs 1) - ;; Evolved right negative flux vector F(U_{i - 1, R+}). - (list-ref flux-umR-evols 0) - (list-ref flux-umR-evols 1) - ;; Evolved left central flux vector F(U_{i, L+}). - (list-ref flux-uiL-evols 0) - (list-ref flux-uiL-evols 1) - ;; Evolved right central flux vector F(U_{i, R+}). - (list-ref flux-uiR-evols 0) - (list-ref flux-uiR-evols 1) - ;; Evolved left positive flux vector F(U_{i + 1, L+}). - (list-ref flux-upL-evols 0) - (list-ref flux-upL-evols 1) - ;; Eigenvalues of evolved right negative flux Jacobian F'(U_{i - 1, R+}). - (list-ref flux-deriv-umR-evols 0) - (list-ref flux-deriv-umR-evols 1) - ;; Eigenvalues of evolved left central flux Jacobian F'(U_{i, L+}). - (list-ref flux-deriv-uiL-evols 0) - (list-ref flux-deriv-uiL-evols 1) - ;; Eigenvalues of evolved right central flux Jacobian F'(U_{i, R+}). - (list-ref flux-deriv-uiR-evols 0) - (list-ref flux-deriv-uiR-evols 1) - ;; Eigenvalues of evolved left positive flux Jacobian F'(U_{i + 1, L+}). - (list-ref flux-deriv-upL-evols 0) - (list-ref flux-deriv-upL-evols 1) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_vector_training_2d.rkt b/provable-algorithms/neural_networks/code_generator_vector_training_2d.rkt deleted file mode 100644 index fb5bf07f..00000000 --- a/provable-algorithms/neural_networks/code_generator_vector_training_2d.rkt +++ /dev/null @@ -1,3717 +0,0 @@ -#lang racket - -(require "prover_vector.rkt") -(require "code_generator_core_training.rkt") -(provide train-lax-friedrichs-vector3-2d - train-lax-friedrichs-vector3-2d-second-order - train-roe-vector3-2d - train-roe-vector3-2d-second-order) - -;; ---------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs -;; ---------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-vector3-2d pde-system neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that trains a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") - (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-codes-x)) - (define flux-uis-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") - (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-codes-x)) - (define flux-ups-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") - (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-codes-x)) - - (define flux-ums-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") - (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-codes-y)) - (define flux-uis-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") - (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-codes-y)) - (define flux-ups-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") - (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 3 PDEs in 2D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - double **un = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); - un[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - double *um_x = (double*) malloc(3 * sizeof(double)); - double *ui_x = (double*) malloc(3 * sizeof(double)); - double *up_x = (double*) malloc(3 * sizeof(double)); - - double *f_um_x = (double*) malloc(3 * sizeof(double)); - double *f_ui_x = (double*) malloc(3 * sizeof(double)); - double *f_up_x = (double*) malloc(3 * sizeof(double)); - - double *fluxL_x = (double*) malloc(3 * sizeof(double)); - double *fluxR_x = (double*) malloc(3 * sizeof(double)); - - double *um_y = (double*) malloc(3 * sizeof(double)); - double *ui_y = (double*) malloc(3 * sizeof(double)); - double *up_y = (double*) malloc(3 * sizeof(double)); - - double *f_um_y = (double*) malloc(3 * sizeof(double)); - double *f_ui_y = (double*) malloc(3 * sizeof(double)); - double *f_up_y = (double*) malloc(3 * sizeof(double)); - - double *fluxL_y = (double*) malloc(3 * sizeof(double)); - double *fluxR_y = (double*) malloc(3 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(3 * sizeof(float**)); - float ***output_data = (float***) malloc(3 * sizeof(float**)); - - for (int i = 0; i < 3; i++) { - input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - - un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - t_net[i] = kann_layer_input(3); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_y[k] = u[i][((j - 1) * 3) + k]; - ui_y[k] = u[i][(j * 3) + k]; - up_y[k] = u[i][((j + 1) * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; // F(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_x[k] = u[i - 1][(j * 3) + k]; - ui_x[k] = u[i][(j * 3) + k]; - up_x[k] = u[i + 1][(j * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_x[0] = ~a; - f_um_x[1] = ~a; - f_um_x[2] = ~a; // F(U_{i - 1}). - - f_ui_x[0] = ~a; - f_ui_x[1] = ~a; - f_ui_x[2] = ~a; // F(U_i). - - f_up_x[0] = ~a; - f_up_x[1] = ~a; - f_up_x[2] = ~a; // F(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha_x * (U_i - U_{i - 1}). - for (int k = 0; k < 3; k++) { - fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * alpha_x * (ui_x[k] - um_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha_x * (U_{i + 1} - U_i). - for (int k = 0; k < 3; k++) { - fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * alpha_x * (up_x[k] - ui_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_y[k] = u[i][((j - 1) * 3) + k]; - ui_y[k] = u[i][(j * 3) + k]; - up_y[k] = u[i][((j + 1) * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; // F(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - for (int k = 0; k < 3; k++) { - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); - output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); - - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; - output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][(j * 3) + k]; - } - } - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 3; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - free(un[i]); - } - free(u); - free(un); - - free(local_alpha_x); - free(local_alpha_y); - - free(um_x); - free(ui_x); - free(up_x); - - free(f_um_x); - free(f_ui_x); - free(f_up_x); - - free(fluxL_x); - free(fluxR_x); - - free(um_y); - free(ui_y); - free(up_y); - - free(f_um_y); - free(f_ui_y); - free(f_up_y); - - free(fluxL_y); - free(fluxR_y); - - for (int i = 0; i < 3; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 3; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). - (list-ref flux-ums-x 0) - (list-ref flux-ums-x 1) - (list-ref flux-ums-x 2) - (list-ref flux-uis-x 0) - (list-ref flux-uis-x 1) - (list-ref flux-uis-x 2) - (list-ref flux-ups-x 0) - (list-ref flux-ups-x 1) - (list-ref flux-ups-x 2) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------------------------------------------------------- -;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------------------------------------------------------------- -(define (train-lax-friedrichs-vector3-2d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that trains a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method - with a second-order flux extrapolation using the limiter `limiter`, with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") - (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]")) flux-codes-x)) - (define flux-umRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_x[0]") - (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]")) flux-codes-x)) - (define flux-uiLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") - (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]")) flux-codes-x)) - (define flux-uiRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") - (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]")) flux-codes-x)) - (define flux-upLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") - (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]")) flux-codes-x)) - (define flux-upRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") - (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]")) flux-codes-x)) - - (define flux-umR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") - (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-codes-x)) - (define flux-uiL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") - (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-codes-x)) - (define flux-uiR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") - (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-codes-x)) - (define flux-upL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") - (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-codes-x)) - - (define flux-umLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") - (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]")) flux-codes-y)) - (define flux-umRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") - (list-ref cons-codes 1) "umR_y[1]") (list-ref cons-codes 2) "umR_y[2]")) flux-codes-y)) - (define flux-uiLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") - (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]")) flux-codes-y)) - (define flux-uiRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") - (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]")) flux-codes-y)) - (define flux-upLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") - (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]")) flux-codes-y)) - (define flux-upRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") - (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]")) flux-codes-y)) - - (define flux-umR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") - (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-codes-y)) - (define flux-uiL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") - (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-codes-y)) - (define flux-uiR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") - (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-codes-y)) - (define flux-upL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") - (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing slopes. - double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); - double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - slope_x[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - slope_y[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - } - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - double **un = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - un[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - double *umL_x = (double*) malloc(3 * sizeof(double)); - double *umR_x = (double*) malloc(3 * sizeof(double)); - double *uiL_x = (double*) malloc(3 * sizeof(double)); - double *uiR_x = (double*) malloc(3 * sizeof(double)); - double *upL_x = (double*) malloc(3 * sizeof(double)); - double *upR_x = (double*) malloc(3 * sizeof(double)); - - double *f_umL_x = (double*) malloc(3 * sizeof(double)); - double *f_umR_x = (double*) malloc(3 * sizeof(double)); - double *f_uiL_x = (double*) malloc(3 * sizeof(double)); - double *f_uiR_x = (double*) malloc(3 * sizeof(double)); - double *f_upL_x = (double*) malloc(3 * sizeof(double)); - double *f_upR_x = (double*) malloc(3 * sizeof(double)); - - double *umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *f_umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *fluxL_x = (double*) malloc(3 * sizeof(double)); - double *fluxR_x = (double*) malloc(3 * sizeof(double)); - - double *umL_y = (double*) malloc(3 * sizeof(double)); - double *umR_y = (double*) malloc(3 * sizeof(double)); - double *uiL_y = (double*) malloc(3 * sizeof(double)); - double *uiR_y = (double*) malloc(3 * sizeof(double)); - double *upL_y = (double*) malloc(3 * sizeof(double)); - double *upR_y = (double*) malloc(3 * sizeof(double)); - - double *f_umL_y = (double*) malloc(3 * sizeof(double)); - double *f_umR_y = (double*) malloc(3 * sizeof(double)); - double *f_uiL_y = (double*) malloc(3 * sizeof(double)); - double *f_uiR_y = (double*) malloc(3 * sizeof(double)); - double *f_upL_y = (double*) malloc(3 * sizeof(double)); - double *f_upR_y = (double*) malloc(3 * sizeof(double)); - - double *umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *f_umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *fluxL_y = (double*) malloc(3 * sizeof(double)); - double *fluxR_y = (double*) malloc(3 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(3 * sizeof(float**)); - float ***output_data = (float***) malloc(3 * sizeof(float**)); - - for (int i = 0; i < 3; i++) { - input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - - un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - t_net[i] = kann_layer_input(3); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); - umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); - - uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); - uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); - - upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); - upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) / (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_x[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) + (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_x[k] = u[i - 1][(j * 3) + k] - (0.5 * slope_x[i - 1][(j * 3) + k]); - umR_x[k] = u[i - 1][(j * 3) + k] + (0.5 * slope_x[i - 1][(j * 3) + k]); - - uiL_x[k] = u[i][(j * 3) + k] - (0.5 * slope_x[i][(j * 3) + k]); - uiR_x[k] = u[i][(j * 3) + k] + (0.5 * slope_x[i][(j * 3) + k]); - - upL_x[k] = u[i + 1][(j * 3) + k] - (0.5 * slope_x[i + 1][(j * 3) + k]); - upR_x[k] = u[i + 1][(j * 3) + k] + (0.5 * slope_x[i + 1][(j * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_x[0] = ~a; - f_umL_x[1] = ~a; - f_umL_x[2] = ~a; - f_umR_x[0] = ~a; - f_umR_x[1] = ~a; - f_umR_x[2] = ~a; - - f_uiL_x[0] = ~a; - f_uiL_x[1] = ~a; - f_uiL_x[2] = ~a; - f_uiR_x[0] = ~a; - f_uiR_x[1] = ~a; - f_uiR_x[2] = ~a; - - f_upL_x[0] = ~a; - f_upL_x[1] = ~a; - f_upL_x[2] = ~a; - f_upR_x[0] = ~a; - f_upR_x[1] = ~a; - f_upR_x[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); - - uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - - upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_x[0] = ~a; - f_umR_evol_x[1] = ~a; - f_umR_evol_x[2] = ~a; // F(U_{i - 1, R+}) - f_uiL_evol_x[0] = ~a; - f_uiL_evol_x[1] = ~a; - f_uiL_evol_x[2] = ~a; // F(U_{i, L+}) - - f_uiR_evol_x[0] = ~a; - f_uiR_evol_x[1] = ~a; - f_uiR_evol_x[2] = ~a; // F(U_{i, R+}) - f_upL_evol_x[0] = ~a; - f_upL_evol_x[1] = ~a; - f_upL_evol_x[2] = ~a; // F(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha_x * (U_{i, L+} - U_{i - 1, R+}). - for (int k = 0; k < 3; k++) { - fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * alpha_x * (uiL_evol_x[k] - umR_evol_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha_x * (U_{i + 1, L+} - U_{i, R+}). - for (int k = 0; k < 3; k++) { - fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * alpha_x * (upL_evol_x[k] - uiR_evol_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); - umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); - - uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); - uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); - - upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); - upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - for (int k = 0; k < 3; k++) { - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); - output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); - - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; - output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][(j * 3) + k]; - } - } - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 3; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - free(un[i]); - free(slope_x[i]); - free(slope_y[i]); - } - free(u); - free(un); - free(slope_x); - free(slope_y); - - free(local_alpha_x); - free(local_alpha_y); - - free(umL_x); - free(umR_x); - free(uiL_x); - free(uiR_x); - free(upL_x); - free(upR_x); - - free(f_umL_x); - free(f_umR_x); - free(f_uiL_x); - free(f_uiR_x); - free(f_upL_x); - free(f_upR_x); - - free(umR_evol_x); - free(uiL_evol_x); - free(uiR_evol_x); - free(upL_evol_x); - - free(f_umR_evol_x); - free(f_uiL_evol_x); - free(f_uiR_evol_x); - free(f_upL_evol_x); - - free(fluxL_x); - free(fluxR_x); - - free(umL_y); - free(umR_y); - free(uiL_y); - free(uiR_y); - free(upL_y); - free(upR_y); - - free(f_umL_y); - free(f_umR_y); - free(f_uiL_y); - free(f_uiR_y); - free(f_upL_y); - free(f_upR_y); - - free(umR_evol_y); - free(uiL_evol_y); - free(uiR_evol_y); - free(upL_evol_y); - - free(f_umR_evol_y); - free(f_uiL_evol_y); - free(f_uiR_evol_y); - free(f_upL_evol_y); - - free(fluxL_y); - free(fluxR_y); - - for (int i = 0; i < 3; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 3; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). - (list-ref flux-umLs-x 0) - (list-ref flux-umLs-x 1) - (list-ref flux-umLs-x 2) - (list-ref flux-umRs-x 0) - (list-ref flux-umRs-x 1) - (list-ref flux-umRs-x 2) - ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). - (list-ref flux-uiLs-x 0) - (list-ref flux-uiLs-x 1) - (list-ref flux-uiLs-x 2) - (list-ref flux-uiRs-x 0) - (list-ref flux-uiRs-x 1) - (list-ref flux-uiRs-x 2) - ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). - (list-ref flux-upLs-x 0) - (list-ref flux-upLs-x 1) - (list-ref flux-upLs-x 2) - (list-ref flux-upRs-x 0) - (list-ref flux-upRs-x 1) - (list-ref flux-upRs-x 2) - ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). - (list-ref flux-umR-evols-x 0) - (list-ref flux-umR-evols-x 1) - (list-ref flux-umR-evols-x 2) - (list-ref flux-uiL-evols-x 0) - (list-ref flux-uiL-evols-x 1) - (list-ref flux-uiL-evols-x 2) - ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). - (list-ref flux-uiR-evols-x 0) - (list-ref flux-uiR-evols-x 1) - (list-ref flux-uiR-evols-x 2) - (list-ref flux-upL-evols-x 0) - (list-ref flux-upL-evols-x 1) - (list-ref flux-upL-evols-x 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ------------------------------------------------------------------------------------- -;; Train a Roe (Finite-Volume) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs -;; ------------------------------------------------------------------------------------- -(define (train-roe-vector3-2d pde-system neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that trains a surrogate solver for the the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Roe finite-volume method, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define flux-jacobian-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) - (define flux-jacobian-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) - (define flux-jacobian-eigvals-simp-x (list (symbolic-simp (list-ref flux-jacobian-eigvals-x 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals-x 1)) - (symbolic-simp (list-ref flux-jacobian-eigvals-x 2)))) - (define flux-jacobian-eigvals-simp-y (list (symbolic-simp (list-ref flux-jacobian-eigvals-y 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals-y 1)) - (symbolic-simp (list-ref flux-jacobian-eigvals-y 2)))) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define flux-deriv-codes-x (map (lambda (flux-deriv-expr-x) - (convert-expr flux-deriv-expr-x)) flux-jacobian-eigvals-simp-x)) - (define flux-deriv-codes-y (map (lambda (flux-deriv-expr-y) - (convert-expr flux-deriv-expr-y)) flux-jacobian-eigvals-simp-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") - (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-codes-x)) - (define flux-uis-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") - (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-codes-x)) - (define flux-ups-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") - (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-codes-x)) - - (define flux-deriv-ums-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "um_x[0]") - (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-uis-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "ui_x[0]") - (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-ups-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "up_x[0]") - (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-deriv-codes-x)) - - (define flux-ums-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") - (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-codes-y)) - (define flux-uis-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") - (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-codes-y)) - (define flux-ups-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") - (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-codes-y)) - - (define flux-deriv-ums-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "um_y[0]") - (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-uis-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "ui_y[0]") - (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-ups-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "up_y[0]") - (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-deriv-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// Train a Roe higher-order finite-volume surrogate solver for a coupled vector system of 3 PDEs in 2D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - double **un = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); - un[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - double *um_x = (double*) malloc(3 * sizeof(double)); - double *ui_x = (double*) malloc(3 * sizeof(double)); - double *up_x = (double*) malloc(3 * sizeof(double)); - - double *f_um_x = (double*) malloc(3 * sizeof(double)); - double *f_ui_x = (double*) malloc(3 * sizeof(double)); - double *f_up_x = (double*) malloc(3 * sizeof(double)); - - double *f_deriv_um_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_ui_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_up_x = (double*) malloc(3 * sizeof(double)); - - double *aL_roe_x = (double*) malloc(3 * sizeof(double)); - double *aR_roe_x = (double*) malloc(3 * sizeof(double)); - - double *fluxL_x = (double*) malloc(3 * sizeof(double)); - double *fluxR_x = (double*) malloc(3 * sizeof(double)); - - double *um_y = (double*) malloc(3 * sizeof(double)); - double *ui_y = (double*) malloc(3 * sizeof(double)); - double *up_y = (double*) malloc(3 * sizeof(double)); - - double *f_um_y = (double*) malloc(3 * sizeof(double)); - double *f_ui_y = (double*) malloc(3 * sizeof(double)); - double *f_up_y = (double*) malloc(3 * sizeof(double)); - - double *f_deriv_um_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_ui_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_up_y = (double*) malloc(3 * sizeof(double)); - - double *aL_roe_y = (double*) malloc(3 * sizeof(double)); - double *aR_roe_y = (double*) malloc(3 * sizeof(double)); - - double *fluxL_y = (double*) malloc(3 * sizeof(double)); - double *fluxR_y = (double*) malloc(3 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(3 * sizeof(float**)); - float ***output_data = (float***) malloc(3 * sizeof(float**)); - - for (int i = 0; i < 3; i++) { - input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - - un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - t_net[i] = kann_layer_input(3); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_y[k] = u[i][((j - 1) * 3) + k]; - ui_y[k] = u[i][(j * 3) + k]; - up_y[k] = u[i][((j + 1) * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; // F(U_{j + 1}). - - // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. - f_deriv_um_y[0] = ~a; - f_deriv_um_y[1] = ~a; - f_deriv_um_y[2] = ~a; // Eigenvalues of F'(U_{j - 1}). - - f_deriv_ui_y[0] = ~a; - f_deriv_ui_y[1] = ~a; - f_deriv_ui_y[2] = ~a; // Eigenvalues of F'(U_j). - - f_deriv_up_y[0] = ~a; - f_deriv_up_y[1] = ~a; - f_deriv_up_y[2] = ~a; // Eigenvalues of F'(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * |aL_roe_y| * (U_j - U_{j - 1}). - for (int k = 0; k < 3; k++) { - aL_roe_y[k] = 0.5 * (f_deriv_um_y[k] + f_deriv_ui_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * |aR_roe_y| * (U_{j + 1} - U_j). - for (int k = 0; k < 3; k++) { - aR_roe_y[k] = 0.5 * (f_deriv_ui_y[k] + f_deriv_up_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the x-direction. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_x[k] = u[i - 1][(j * 3) + k]; - ui_x[k] = u[i][(j * 3) + k]; - up_x[k] = u[i + 1][(j * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_x[0] = ~a; - f_um_x[1] = ~a; - f_um_x[2] = ~a; // F(U_{i - 1}). - - f_ui_x[0] = ~a; - f_ui_x[1] = ~a; - f_ui_x[2] = ~a; // F(U_i). - - f_up_x[0] = ~a; - f_up_x[1] = ~a; - f_up_x[2] = ~a; // F(U_{i + 1}). - - // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. - f_deriv_um_x[0] = ~a; - f_deriv_um_x[1] = ~a; - f_deriv_um_x[2] = ~a; // Eigenvalues of F'(U_{i - 1}). - - f_deriv_ui_x[0] = ~a; - f_deriv_ui_x[1] = ~a; - f_deriv_ui_x[2] = ~a; // Eigenvalues of F'(U_i). - - f_deriv_up_x[0] = ~a; - f_deriv_up_x[1] = ~a; - f_deriv_up_x[2] = ~a; // Eigenvalues of F'(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * |aL_roe_x| * (U_i - U_{i - 1}). - for (int k = 0; k < 3; k++) { - aL_roe_x[k] = 0.5 * (f_deriv_um_x[k] + f_deriv_ui_x[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * fabs(aL_roe_x[k]) * (ui_x[k] - um_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * |aR_roe_x| * (U_{i + 1} - U_i). - for (int k = 0; k < 3; k++) { - aR_roe_x[k] = 0.5 * (f_deriv_ui_x[k] + f_deriv_up_x[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * fabs(aR_roe_x[k]) * (up_x[k] - ui_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - um_y[k] = u[i][((j - 1) * 3) + k]; - ui_y[k] = u[i][(j * 3) + k]; - up_y[k] = u[i][((j + 1) * 3) + k]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um_y[0] = ~a; - f_um_y[1] = ~a; - f_um_y[2] = ~a; // F(U_{j - 1}). - - f_ui_y[0] = ~a; - f_ui_y[1] = ~a; - f_ui_y[2] = ~a; // F(U_j). - - f_up_y[0] = ~a; - f_up_y[1] = ~a; - f_up_y[2] = ~a; // F(U_{j + 1}). - - // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. - f_deriv_um_y[0] = ~a; - f_deriv_um_y[1] = ~a; - f_deriv_um_y[2] = ~a; // Eigenvalues of F'(U_{j - 1}). - - f_deriv_ui_y[0] = ~a; - f_deriv_ui_y[1] = ~a; - f_deriv_ui_y[2] = ~a; // Eigenvalues of F'(U_j). - - f_deriv_up_y[0] = ~a; - f_deriv_up_y[1] = ~a; - f_deriv_up_y[2] = ~a; // Eigenvalues of F'(U_{j + 1}). - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * |aL_roe_y| * (U_j - U_{j - 1}). - for (int k = 0; k < 3; k++) { - aL_roe_y[k] = 0.5 * (f_deriv_um_y[k] + f_deriv_ui_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (ui_y[k] - um_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * |aR_roe_y| * (U_{j + 1} - U_j). - for (int k = 0; k < 3; k++) { - aR_roe_y[k] = 0.5 * (f_deriv_ui_y[k] + f_deriv_up_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (up_y[k] - ui_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - - un[0][(j * 3) + k] = un[1][(j * 3) + k]; - un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; - un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; - } - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - for (int k = 0; k < 3; k++) { - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); - output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); - - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; - input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; - output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][(j * 3) + k]; - } - } - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 3; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - free(un[i]); - } - free(u); - free(un); - - free(local_alpha_x); - free(local_alpha_y); - - free(um_x); - free(ui_x); - free(up_x); - - free(f_um_x); - free(f_ui_x); - free(f_up_x); - - free(f_deriv_um_x); - free(f_deriv_ui_x); - free(f_deriv_up_x); - - free(aL_roe_x); - free(aR_roe_x); - - free(fluxL_x); - free(fluxR_x); - - free(um_y); - free(ui_y); - free(up_y); - - free(f_um_y); - free(f_ui_y); - free(f_up_y); - - free(f_deriv_um_y); - free(f_deriv_ui_y); - free(f_deriv_up_y); - - free(aL_roe_y); - free(aR_roe_y); - - free(fluxL_y); - free(fluxR_y); - - for (int i = 0; i < 3; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 3; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - ;; Eigenvalues of left, middle, right flux Jacobians in y-direction F'(u_{j - 1}), F'(u_j), F'(u_{j + 1}). - (list-ref flux-deriv-ums-y 0) - (list-ref flux-deriv-ums-y 1) - (list-ref flux-deriv-ums-y 2) - (list-ref flux-deriv-uis-y 0) - (list-ref flux-deriv-uis-y 1) - (list-ref flux-deriv-uis-y 2) - (list-ref flux-deriv-ups-y 0) - (list-ref flux-deriv-ups-y 1) - (list-ref flux-deriv-ups-y 2) - ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). - (list-ref flux-ums-x 0) - (list-ref flux-ums-x 1) - (list-ref flux-ums-x 2) - (list-ref flux-uis-x 0) - (list-ref flux-uis-x 1) - (list-ref flux-uis-x 2) - (list-ref flux-ups-x 0) - (list-ref flux-ups-x 1) - (list-ref flux-ups-x 2) - ;; Eigenvalues of left, middle, right flux Jacobians in x-direction F'(u_{i - 1}), F'(u_i), F'(u_{i + 1}). - (list-ref flux-deriv-ums-x 0) - (list-ref flux-deriv-ums-x 1) - (list-ref flux-deriv-ums-x 2) - (list-ref flux-deriv-uis-x 0) - (list-ref flux-deriv-uis-x 1) - (list-ref flux-deriv-uis-x 2) - (list-ref flux-deriv-ups-x 0) - (list-ref flux-deriv-ups-x 1) - (list-ref flux-deriv-ups-x 2) - ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). - (list-ref flux-ums-y 0) - (list-ref flux-ums-y 1) - (list-ref flux-ums-y 2) - (list-ref flux-uis-y 0) - (list-ref flux-uis-y 1) - (list-ref flux-uis-y 2) - (list-ref flux-ups-y 0) - (list-ref flux-ups-y 1) - (list-ref flux-ups-y 2) - ;; Eigenvalues of left, middle, right flux Jacobians in y-direction F'(u_{j - 1}), F'(u_j), F'(u_{j + 1}). - (list-ref flux-deriv-ums-y 0) - (list-ref flux-deriv-ums-y 1) - (list-ref flux-deriv-ums-y 2) - (list-ref flux-deriv-uis-y 0) - (list-ref flux-deriv-uis-y 1) - (list-ref flux-deriv-uis-y 2) - (list-ref flux-deriv-ups-y 0) - (list-ref flux-deriv-ups-y 1) - (list-ref flux-deriv-ups-y 2) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------------------------------------- -;; Train a Roe (Finite-Volume) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation -;; ---------------------------------------------------------------------------------------------------------------------------- -(define (train-roe-vector3-2d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that trains a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Roe finite-volume method - with a second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define max-trains (hash-ref neural-net 'max-trains)) - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (define num-threads (hash-ref neural-net 'num-threads)) - (define mini-size (hash-ref neural-net 'mini-size)) - - (define flux-jacobian-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) - (define flux-jacobian-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) - (define flux-jacobian-eigvals-simp-x (list (symbolic-simp (list-ref flux-jacobian-eigvals-x 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals-x 1)) - (symbolic-simp (list-ref flux-jacobian-eigvals-x 2)))) - (define flux-jacobian-eigvals-simp-y (list (symbolic-simp (list-ref flux-jacobian-eigvals-y 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals-y 1)) - (symbolic-simp (list-ref flux-jacobian-eigvals-y 2)))) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes-x (map (lambda (flux-expr-x) - (convert-expr flux-expr-x)) flux-exprs-x)) - (define flux-codes-y (map (lambda (flux-expr-y) - (convert-expr flux-expr-y)) flux-exprs-y)) - (define flux-deriv-codes-x (map (lambda (flux-deriv-expr-x) - (convert-expr flux-deriv-expr-x)) flux-jacobian-eigvals-simp-x)) - (define flux-deriv-codes-y (map (lambda (flux-deriv-expr-y) - (convert-expr flux-deriv-expr-y)) flux-jacobian-eigvals-simp-y)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") - (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]")) flux-codes-x)) - (define flux-umRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_x[0]") - (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]")) flux-codes-x)) - (define flux-uiLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") - (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]")) flux-codes-x)) - (define flux-uiRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") - (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]")) flux-codes-x)) - (define flux-upLs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") - (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]")) flux-codes-x)) - (define flux-upRs-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") - (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]")) flux-codes-x)) - - (define flux-umR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") - (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-codes-x)) - (define flux-uiL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") - (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-codes-x)) - (define flux-uiR-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") - (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-codes-x)) - (define flux-upL-evols-x (map (lambda (flux-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") - (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-codes-x)) - - (define flux-deriv-umR-evols-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "umR_evol_x[0]") - (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-uiL-evols-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") - (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-uiR-evols-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") - (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-deriv-codes-x)) - (define flux-deriv-upL-evols-x (map (lambda (flux-deriv-code-x) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "upL_evol_x[0]") - (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-deriv-codes-x)) - - (define flux-umLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") - (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]")) flux-codes-y)) - (define flux-umRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") - (list-ref cons-codes 1) "umR_y[1]") (list-ref cons-codes 2) "umR_y[2]")) flux-codes-y)) - (define flux-uiLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") - (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]")) flux-codes-y)) - (define flux-uiRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") - (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]")) flux-codes-y)) - (define flux-upLs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") - (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]")) flux-codes-y)) - (define flux-upRs-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") - (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]")) flux-codes-y)) - - (define flux-umR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") - (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-codes-y)) - (define flux-uiL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") - (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-codes-y)) - (define flux-uiR-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") - (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-codes-y)) - (define flux-upL-evols-y (map (lambda (flux-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") - (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-codes-y)) - - (define flux-deriv-umR-evols-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "umR_evol_y[0]") - (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-uiL-evols-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") - (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-uiR-evols-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") - (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-deriv-codes-y)) - (define flux-deriv-upL-evols-y (map (lambda (flux-deriv-code-y) - (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "upL_evol_y[0]") - (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-deriv-codes-y)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Train a Roe higher-order finite-volume surrogate solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Neural network hyperparameters. - const double num_trains = ~a; - const int nn_width = ~a; - const int nn_depth = ~a; - - const int num_threads = ~a; - const int mini_size = ~a; - - // Arrays for storing slopes. - double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); - double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - slope_x[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - slope_y[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - } - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - double **un = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - un[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - double *umL_x = (double*) malloc(3 * sizeof(double)); - double *umR_x = (double*) malloc(3 * sizeof(double)); - double *uiL_x = (double*) malloc(3 * sizeof(double)); - double *uiR_x = (double*) malloc(3 * sizeof(double)); - double *upL_x = (double*) malloc(3 * sizeof(double)); - double *upR_x = (double*) malloc(3 * sizeof(double)); - - double *f_umL_x = (double*) malloc(3 * sizeof(double)); - double *f_umR_x = (double*) malloc(3 * sizeof(double)); - double *f_uiL_x = (double*) malloc(3 * sizeof(double)); - double *f_uiR_x = (double*) malloc(3 * sizeof(double)); - double *f_upL_x = (double*) malloc(3 * sizeof(double)); - double *f_upR_x = (double*) malloc(3 * sizeof(double)); - - double *umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *f_umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *f_deriv_umR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_uiL_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_uiR_evol_x = (double*) malloc(3 * sizeof(double)); - double *f_deriv_upL_evol_x = (double*) malloc(3 * sizeof(double)); - - double *aL_roe_x = (double*) malloc(3 * sizeof(double)); - double *aR_roe_x = (double*) malloc(3 * sizeof(double)); - - double *fluxL_x = (double*) malloc(3 * sizeof(double)); - double *fluxR_x = (double*) malloc(3 * sizeof(double)); - - double *umL_y = (double*) malloc(3 * sizeof(double)); - double *umR_y = (double*) malloc(3 * sizeof(double)); - double *uiL_y = (double*) malloc(3 * sizeof(double)); - double *uiR_y = (double*) malloc(3 * sizeof(double)); - double *upL_y = (double*) malloc(3 * sizeof(double)); - double *upR_y = (double*) malloc(3 * sizeof(double)); - - double *f_umL_y = (double*) malloc(3 * sizeof(double)); - double *f_umR_y = (double*) malloc(3 * sizeof(double)); - double *f_uiL_y = (double*) malloc(3 * sizeof(double)); - double *f_uiR_y = (double*) malloc(3 * sizeof(double)); - double *f_upL_y = (double*) malloc(3 * sizeof(double)); - double *f_upR_y = (double*) malloc(3 * sizeof(double)); - - double *umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *f_umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *f_deriv_umR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_uiL_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_uiR_evol_y = (double*) malloc(3 * sizeof(double)); - double *f_deriv_upL_evol_y = (double*) malloc(3 * sizeof(double)); - - double *aL_roe_y = (double*) malloc(3 * sizeof(double)); - double *aR_roe_y = (double*) malloc(3 * sizeof(double)); - - double *fluxL_y = (double*) malloc(3 * sizeof(double)); - double *fluxR_y = (double*) malloc(3 * sizeof(double)); - - // Arrays for storing training data. - float ***input_data = (float***) malloc(3 * sizeof(float**)); - float ***output_data = (float***) malloc(3 * sizeof(float**)); - - for (int i = 0; i < 3; i++) { - input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); - } - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - - un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - // Initialize neural network architecture. - kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - t_net[i] = kann_layer_input(3); - - for (int j = 0; j < nn_depth; j++) { - t_net[i] = kann_layer_dense(t_net[i], nn_width); - t_net[i] = kad_tanh(t_net[i]); - } - - t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); - ann[i] = kann_new(t_net[i], 0); - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); - umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); - - uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); - uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); - - upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); - upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) - - // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. - f_deriv_umR_evol_y[0] = ~a; - f_deriv_umR_evol_y[1] = ~a; - f_deriv_umR_evol_y[2] = ~a; // F'(U_{j - 1, R+}) - f_deriv_uiL_evol_y[0] = ~a; - f_deriv_uiL_evol_y[1] = ~a; - f_deriv_uiL_evol_y[2] = ~a; // F'(U_{j, L+}) - - f_deriv_uiR_evol_y[0] = ~a; - f_deriv_uiR_evol_y[1] = ~a; - f_deriv_uiR_evol_y[2] = ~a; // F'(U_{j, R+}) - f_deriv_upL_evol_y[0] = ~a; - f_deriv_upL_evol_y[1] = ~a; - f_deriv_upL_evol_y[2] = ~a; // F'(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * |aL_roe_y| * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 3; k++) { - aL_roe_y[k] = 0.5 * (f_deriv_umR_evol_y[k] + f_deriv_uiL_evol_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * |aR_roe_y| * (U_{j + 1, L+} - u_{j, R+}). - for (int k = 0; k < 3; k++) { - aR_roe_y[k] = 0.5 * (f_deriv_uiR_evol_y[k] + f_deriv_upL_evol_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) / (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_x[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) + (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the x-direction. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_x[k] = u[i - 1][(j * 3) + k] - (0.5 * slope_x[i - 1][(j * 3) + k]); - umR_x[k] = u[i - 1][(j * 3) + k] + (0.5 * slope_x[i - 1][(j * 3) + k]); - - uiL_x[k] = u[i][(j * 3) + k] - (0.5 * slope_x[i][(j * 3) + k]); - uiR_x[k] = u[i][(j * 3) + k] + (0.5 * slope_x[i][(j * 3) + k]); - - upL_x[k] = u[i + 1][(j * 3) + k] - (0.5 * slope_x[i + 1][(j * 3) + k]); - upR_x[k] = u[i + 1][(j * 3) + k] + (0.5 * slope_x[i + 1][(j * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_x[0] = ~a; - f_umL_x[1] = ~a; - f_umL_x[2] = ~a; - f_umR_x[0] = ~a; - f_umR_x[1] = ~a; - f_umR_x[2] = ~a; - - f_uiL_x[0] = ~a; - f_uiL_x[1] = ~a; - f_uiL_x[2] = ~a; - f_uiR_x[0] = ~a; - f_uiR_x[1] = ~a; - f_uiR_x[2] = ~a; - - f_upL_x[0] = ~a; - f_upL_x[1] = ~a; - f_upL_x[2] = ~a; - f_upR_x[0] = ~a; - f_upR_x[1] = ~a; - f_upR_x[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); - - uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); - - upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_x[0] = ~a; - f_umR_evol_x[1] = ~a; - f_umR_evol_x[2] = ~a; // F(U_{i - 1, R+}) - f_uiL_evol_x[0] = ~a; - f_uiL_evol_x[1] = ~a; - f_uiL_evol_x[2] = ~a; // F(U_{i, L+}) - - f_uiR_evol_x[0] = ~a; - f_uiR_evol_x[1] = ~a; - f_uiR_evol_x[2] = ~a; // F(U_{i, R+}) - f_upL_evol_x[0] = ~a; - f_upL_evol_x[1] = ~a; - f_upL_evol_x[2] = ~a; // F(U_{i + 1, L+}) - - // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. - f_deriv_umR_evol_x[0] = ~a; - f_deriv_umR_evol_x[1] = ~a; - f_deriv_umR_evol_x[2] = ~a; // F'(U_{i - 1, R+}) - f_deriv_uiL_evol_x[0] = ~a; - f_deriv_uiL_evol_x[1] = ~a; - f_deriv_uiL_evol_x[2] = ~a; // F'(U_{i, L+}) - - f_deriv_uiR_evol_x[0] = ~a; - f_deriv_uiR_evol_x[1] = ~a; - f_deriv_uiR_evol_x[2] = ~a; // F'(U_{i, R+}) - f_deriv_upL_evol_x[0] = ~a; - f_deriv_upL_evol_x[1] = ~a; - f_deriv_upL_evol_x[2] = ~a; // F'(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * |aL_roe_x| * (U_{i, L+} - U_{i - 1, R+}). - for (int k = 0; k < 3; k++) { - aL_roe_x[k] = 0.5 * (f_deriv_umR_evol_x[k] + f_deriv_uiL_evol_x[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * fabs(aL_roe_x[k]) * (uiL_evol_x[k] - umR_evol_x[k]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * |aR_roe_x| * (U_{i + 1, L+} - u_{i, R+}). - for (int k = 0; k < 3; k++) { - aR_roe_x[k] = 0.5 * (f_deriv_uiR_evol_x[k] + f_deriv_upL_evol_x[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * fabs(aR_roe_x[k]) * (upL_evol_x[k] - uiR_evol_x[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 1; j <= ny + 2; j++) { - for (int k = 0; k < 3; k++) { - double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); - double limiter = ~a; // limiter-r in C. - - slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); - } - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - // Extrapolate boundary states. - for (int k = 0; k < 3; k++) { - umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); - umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); - - uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); - uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); - - upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); - upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL_y[0] = ~a; - f_umL_y[1] = ~a; - f_umL_y[2] = ~a; - f_umR_y[0] = ~a; - f_umR_y[1] = ~a; - f_umR_y[2] = ~a; - - f_uiL_y[0] = ~a; - f_uiL_y[1] = ~a; - f_uiL_y[2] = ~a; - f_uiR_y[0] = ~a; - f_uiR_y[1] = ~a; - f_uiR_y[2] = ~a; - - f_upL_y[0] = ~a; - f_upL_y[1] = ~a; - f_upL_y[2] = ~a; - f_upR_y[0] = ~a; - f_upR_y[1] = ~a; - f_upR_y[2] = ~a; - - // Evolve each extrapolated boundary state. - for (int k = 0; k < 3; k++) { - umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); - - uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); - - upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol_y[0] = ~a; - f_umR_evol_y[1] = ~a; - f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) - f_uiL_evol_y[0] = ~a; - f_uiL_evol_y[1] = ~a; - f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) - - f_uiR_evol_y[0] = ~a; - f_uiR_evol_y[1] = ~a; - f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) - f_upL_evol_y[0] = ~a; - f_upL_evol_y[1] = ~a; - f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) - - // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. - f_deriv_umR_evol_y[0] = ~a; - f_deriv_umR_evol_y[1] = ~a; - f_deriv_umR_evol_y[2] = ~a; // F'(U_{j - 1, R+}) - f_deriv_uiL_evol_y[0] = ~a; - f_deriv_uiL_evol_y[1] = ~a; - f_deriv_uiL_evol_y[2] = ~a; // F'(U_{j, L+}) - - f_deriv_uiR_evol_y[0] = ~a; - f_deriv_uiR_evol_y[1] = ~a; - f_deriv_uiR_evol_y[2] = ~a; // F'(U_{j, R+}) - f_deriv_upL_evol_y[0] = ~a; - f_deriv_upL_evol_y[1] = ~a; - f_deriv_upL_evol_y[2] = ~a; // F'(U_{j + 1, L+}) - - // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * |aL_roe_y| * (U_{j, L+} - U_{j - 1, R+}). - for (int k = 0; k < 3; k++) { - aL_roe_y[k] = 0.5 * (f_deriv_umR_evol_y[k] + f_deriv_uiL_evol_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (uiL_evol_y[k] - umR_evol_y[k]); - } - - // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * |aR_roe_y| * (U_{j + 1, L+} - u_{j, R+}). - for (int k = 0; k < 3; k++) { - aR_roe_y[k] = 0.5 * (f_deriv_uiR_evol_y[k] + f_deriv_upL_evol_y[k]); - } - for (int k = 0; k < 3; k++) { - fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (upL_evol_y[k] - uiR_evol_y[k]); - } - - // Update the conserved variable vector. - for (int k = 0; k < 3; k++) { - un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); - } - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[i][(j * 3) + k] = un[i][(j * 3) + k]; - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - - un[0][(j * 3) + k] = un[2][(j * 3) + k]; - un[1][(j * 3) + k] = un[2][(j * 3) + k]; - un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - - un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; - un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; - un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; - un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; - } - } - - // Accumulate to training data. - if (n < num_trains) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - for (int k = 0; k < 3; k++) { - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); - output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); - - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; - input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; - output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][(j * 3) + k]; - } - } - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_output_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - // Train neural network. - for (int i = 0; i < 3; i++) { - kann_mt(ann[i], num_threads, mini_size); - kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); - } - - // Output neural network to disk. - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - kann_save(file_nm, ann[i]); - } - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - free(un[i]); - free(slope_x[i]); - free(slope_y[i]); - } - free(u); - free(un); - free(slope_x); - free(slope_y); - - free(local_alpha_x); - free(local_alpha_y); - - free(umL_x); - free(umR_x); - free(uiL_x); - free(uiR_x); - free(upL_x); - free(upR_x); - - free(f_umL_x); - free(f_umR_x); - free(f_uiL_x); - free(f_uiR_x); - free(f_upL_x); - free(f_upR_x); - - free(umR_evol_x); - free(uiL_evol_x); - free(uiR_evol_x); - free(upL_evol_x); - - free(f_umR_evol_x); - free(f_uiL_evol_x); - free(f_uiR_evol_x); - free(f_upL_evol_x); - - free(f_deriv_umR_evol_x); - free(f_deriv_uiL_evol_x); - free(f_deriv_uiR_evol_x); - free(f_deriv_upL_evol_x); - - free(aL_roe_x); - free(aR_roe_x); - - free(fluxL_x); - free(fluxR_x); - - free(umL_y); - free(umR_y); - free(uiL_y); - free(uiR_y); - free(upL_y); - free(upR_y); - - free(f_umL_y); - free(f_umR_y); - free(f_uiL_y); - free(f_uiR_y); - free(f_upL_y); - free(f_upR_y); - - free(umR_evol_y); - free(uiL_evol_y); - free(uiR_evol_y); - free(upL_evol_y); - - free(f_umR_evol_y); - free(f_uiL_evol_y); - free(f_uiR_evol_y); - free(f_upL_evol_y); - - free(f_deriv_umR_evol_y); - free(f_deriv_uiL_evol_y); - free(f_deriv_uiR_evol_y); - free(f_deriv_upL_evol_y); - - free(aL_roe_y); - free(aR_roe_y); - - free(fluxL_y); - free(fluxR_y); - - for (int i = 0; i < 3; i++) { - kann_delete(ann[i]); - } - free(ann); - free(t_net); - - for (int i = 0; i < 3; i++) { - for (int j = 0; j < nx * num_trains; j++) { - free(input_data[i][j]); - free(output_data[i][j]); - } - - free(input_data[i]); - free(output_data[i]); - } - - free(input_data); - free(output_data); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Maximum number of time-steps to train on. - max-trains - ;; Neural network width. - width - ;; Neural network depth. - depth - ;; Number of threads to use during training. - num-threads - ;; Mini-batch training size. - mini-size - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - ;; Evolved right negative/left central flux Jacobian eigenvalues in y-direction F'(U_{j - 1, R+}), F'(U_{j, L+}). - (list-ref flux-deriv-umR-evols-y 0) - (list-ref flux-deriv-umR-evols-y 1) - (list-ref flux-deriv-umR-evols-y 2) - (list-ref flux-deriv-uiL-evols-y 0) - (list-ref flux-deriv-uiL-evols-y 1) - (list-ref flux-deriv-uiL-evols-y 2) - ;; Evolved right central/left positive flux Jacobian eigenvalues in y-direction F'(U_{j, R+}), F'(U_{j + 1, L+}). - (list-ref flux-deriv-uiR-evols-y 0) - (list-ref flux-deriv-uiR-evols-y 1) - (list-ref flux-deriv-uiR-evols-y 2) - (list-ref flux-deriv-upL-evols-y 0) - (list-ref flux-deriv-upL-evols-y 1) - (list-ref flux-deriv-upL-evols-y 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). - (list-ref flux-umLs-x 0) - (list-ref flux-umLs-x 1) - (list-ref flux-umLs-x 2) - (list-ref flux-umRs-x 0) - (list-ref flux-umRs-x 1) - (list-ref flux-umRs-x 2) - ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). - (list-ref flux-uiLs-x 0) - (list-ref flux-uiLs-x 1) - (list-ref flux-uiLs-x 2) - (list-ref flux-uiRs-x 0) - (list-ref flux-uiRs-x 1) - (list-ref flux-uiRs-x 2) - ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). - (list-ref flux-upLs-x 0) - (list-ref flux-upLs-x 1) - (list-ref flux-upLs-x 2) - (list-ref flux-upRs-x 0) - (list-ref flux-upRs-x 1) - (list-ref flux-upRs-x 2) - ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). - (list-ref flux-umR-evols-x 0) - (list-ref flux-umR-evols-x 1) - (list-ref flux-umR-evols-x 2) - (list-ref flux-uiL-evols-x 0) - (list-ref flux-uiL-evols-x 1) - (list-ref flux-uiL-evols-x 2) - ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). - (list-ref flux-uiR-evols-x 0) - (list-ref flux-uiR-evols-x 1) - (list-ref flux-uiR-evols-x 2) - (list-ref flux-upL-evols-x 0) - (list-ref flux-upL-evols-x 1) - (list-ref flux-upL-evols-x 2) - ;; Evolved right negative/left central flux Jacobian eigenvalues in x-direction F'(U_{i - 1, R+}), F'(U_{i, L+}). - (list-ref flux-deriv-umR-evols-x 0) - (list-ref flux-deriv-umR-evols-x 1) - (list-ref flux-deriv-umR-evols-x 2) - (list-ref flux-deriv-uiL-evols-x 0) - (list-ref flux-deriv-uiL-evols-x 1) - (list-ref flux-deriv-uiL-evols-x 2) - ;; Evolved right central/left positive flux Jacobian eigenvalues in x-direction F'(U_{i, R+}), F'(U_{i + 1, L+}). - (list-ref flux-deriv-uiR-evols-x 0) - (list-ref flux-deriv-uiR-evols-x 1) - (list-ref flux-deriv-uiR-evols-x 2) - (list-ref flux-deriv-upL-evols-x 0) - (list-ref flux-deriv-upL-evols-x 1) - (list-ref flux-deriv-upL-evols-x 2) - ;; Expression for flux limiter function. - limiter-r - ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). - (list-ref flux-umLs-y 0) - (list-ref flux-umLs-y 1) - (list-ref flux-umLs-y 2) - (list-ref flux-umRs-y 0) - (list-ref flux-umRs-y 1) - (list-ref flux-umRs-y 2) - ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). - (list-ref flux-uiLs-y 0) - (list-ref flux-uiLs-y 1) - (list-ref flux-uiLs-y 2) - (list-ref flux-uiRs-y 0) - (list-ref flux-uiRs-y 1) - (list-ref flux-uiRs-y 2) - ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). - (list-ref flux-upLs-y 0) - (list-ref flux-upLs-y 1) - (list-ref flux-upLs-y 2) - (list-ref flux-upRs-y 0) - (list-ref flux-upRs-y 1) - (list-ref flux-upRs-y 2) - ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). - (list-ref flux-umR-evols-y 0) - (list-ref flux-umR-evols-y 1) - (list-ref flux-umR-evols-y 2) - (list-ref flux-uiL-evols-y 0) - (list-ref flux-uiL-evols-y 1) - (list-ref flux-uiL-evols-y 2) - ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). - (list-ref flux-uiR-evols-y 0) - (list-ref flux-uiR-evols-y 1) - (list-ref flux-uiR-evols-y 2) - (list-ref flux-upL-evols-y 0) - (list-ref flux-upL-evols-y 1) - (list-ref flux-upL-evols-y 2) - ;; Evolved right negative/left central flux Jacobian eigenvalues in y-direction F'(U_{j - 1, R+}), F'(U_{j, L+}). - (list-ref flux-deriv-umR-evols-y 0) - (list-ref flux-deriv-umR-evols-y 1) - (list-ref flux-deriv-umR-evols-y 2) - (list-ref flux-deriv-uiL-evols-y 0) - (list-ref flux-deriv-uiL-evols-y 1) - (list-ref flux-deriv-uiL-evols-y 2) - ;; Evolved right central/left positive flux Jacobian eigenvalues in y-direction F'(U_{j, R+}), F'(U_{j + 1, L+}). - (list-ref flux-deriv-uiR-evols-y 0) - (list-ref flux-deriv-uiR-evols-y 1) - (list-ref flux-deriv-uiR-evols-y 2) - (list-ref flux-deriv-upL-evols-y 0) - (list-ref flux-deriv-upL-evols-y 1) - (list-ref flux-deriv-upL-evols-y 2) - ;; PDE name for file output. - name - name - ;; PDE name for neural network output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_vector_validation.rkt b/provable-algorithms/neural_networks/code_generator_vector_validation.rkt deleted file mode 100644 index 8f45b382..00000000 --- a/provable-algorithms/neural_networks/code_generator_vector_validation.rkt +++ /dev/null @@ -1,1036 +0,0 @@ -#lang racket - -(require "code_generator_core_training.rkt") -(require "code_generator_core_validation.rkt") -(provide validate-vector2-1d - validate-vector2-1d-second-order - validate-vector3-2d - validate-vector3-2d-second-order) - -;; --------------------------------------------------------------------------------------------- -;; Validate an Arbitrary (First-Order) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs -;; --------------------------------------------------------------------------------------------- -(define (validate-vector2-1d pde-system neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that validates a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde` using any first-order method, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a -// Validate any first-order surrogate solver for a coupled vector system of 2 PDEs in 1D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - // Load neural network architecture. - kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); - - for (int i = 0; i < 2; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann[i] = kann_load(file_nm); - - fclose(fptr); - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 1; i <= nx; i++) { - for (int j = 0; j < 2; j++) { - double x = x0 + (i - 0.5) * dx; - - float *input_data = (float*) malloc(2 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - - output_data = kann_apply1(ann[j], input_data); - - u[(i * 2) + j] = output_data[0]; - - free(input_data); - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(1 * 2) + j]; - u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; - } - - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_validation_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr; - fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - free(u); - free(local_alpha); - - for (int i = 0; i < 2; i++) { - kann_delete(ann[i]); - } - free(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; PDE name for file output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------- -;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs -;; ---------------------------------------------------------------------------------------------- -(define (validate-vector2-1d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that validates a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde` using any first-order method - with any second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Validate any first-order surrogate solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - // Load neural network architecture. - kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); - - for (int i = 0; i < 2; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann[i] = kann_load(file_nm); - - fclose(fptr); - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx + 2; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 0; j < 2; j++) { - double x = x0 + (i - 1.5) * dx; - - float *input_data = (float*) malloc(2 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - - output_data = kann_apply1(ann[j], input_data); - - u[(i * 2) + j] = output_data[0]; - - free(input_data); - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(2 * 2) + j]; - u[(1 * 2) + j] = u[(2 * 2) + j]; - u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; - u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; - } - - // Output solution to disk. - for (int j = 0; j < 2; j++) { - const char *fmt = \"%s_validation_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", j, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); - - FILE *fptr; - fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); - } - } - - fclose(fptr); - } - - // Increment time. - t += dt; - n += 1; - } - - free(u); - free(local_alpha); - - for (int i = 0; i < 2; i++) { - kann_delete(ann[i]); - } - free(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; PDE name for file output. - name - name - )) - code) - -;; --------------------------------------------------------------------------------------------- -;; Validate an Arbitrary (First-Order) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs -;; --------------------------------------------------------------------------------------------- -(define (validate-vector3-2d pde-system neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that validates a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde` using any first-order method, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a -// Validate any first-order surrogate solver for a coupled vector system of 3 PDEs in 2D. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 2) * sizeof(double*)); - for (int i = 0; i <= nx + 1; i++) { - u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j <= ny + 1; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - // Load neural network architecture. - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann[i] = kann_load(file_nm); - - fclose(fptr); - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - for (int k = 0; k < 3; k++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - -.5) * dy; - - float *input_data = (float*) malloc(3 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - input_data[2] = y; - - output_data = kann_apply1(ann[k], input_data); - - u[i][(j * 3) + k] = output_data[0]; - - free(input_data); - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[1][(j * 3) + k]; - u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 1; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; - u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_validation_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - double x = x0 + (i - 0.5) * dx; - double y = y0 + (j - 0.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 1; i++) { - free(u[i]); - } - free(u); - - free(local_alpha_x); - free(local_alpha_y); - - for (int i = 0; i < 3; i++) { - kann_delete(ann[i]); - } - free(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; PDE name for file output. - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------- -;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs -;; ---------------------------------------------------------------------------------------------- -(define (validate-vector3-2d-second-order pde-system limiter neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Generate C code that validates a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde` using any first-order method - with any second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) - (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define max-speed-codes-x (map (lambda (max-speed-expr-x) - (convert-expr max-speed-expr-x)) max-speed-exprs-x)) - (define max-speed-codes-y (map (lambda (max-speed-expr-y) - (convert-expr max-speed-expr-y)) max-speed-exprs-y)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define max-speed-locals-x (map (lambda (max-speed-code-x) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) - (define max-speed-locals-y (map (lambda (max-speed-code-y) - (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") - (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Validate any first-order surrogate solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. - -#include -#include -#include -#include \"kann.h\" - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const int ny = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double y0 = ~a; - const double y1 = ~a; - const double Lx = (x1 - x0); - const double Ly = (y1 - y0); - const double dx = Lx / nx; - const double dy = Ly / ny; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double **u = (double**) malloc((nx + 4) * sizeof(double*)); - for (int i = 0; i <= nx + 3; i++) { - u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); - } - - // Arrays for storing other intermediate values. - double *local_alpha_x = (double*) malloc(3 * sizeof(double)); - double *local_alpha_y = (double*) malloc(3 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j <= ny + 3; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. - u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. - u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. - } - } - - // Load neural network architecture. - kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); - - for (int i = 0; i < 3; i++) { - const char *fmt = \"%s_%d_neural_net.dat\"; - int sz = snprintf(0, 0, fmt, \"~a\", i); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); - - FILE *fptr; - fptr = fopen(file_nm, \"r\"); - if (fptr != NULL) { - ann[i] = kann_load(file_nm); - - fclose(fptr); - } - } - - double t = 0.0; - int n = 0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha_x = 0.0; - double alpha_y = 0.0; - - for (int i = 1; i <= nx; i++) { - for (int j = 1; j <= ny; j++) { - local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. - local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. - local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. - - local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. - local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. - local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. - - for (int k = 0; k < 3; k++) { - if (local_alpha_x[k] > alpha_x) { - alpha_x = local_alpha_x[k]; - } - if (local_alpha_y[k] > alpha_y) { - alpha_y = local_alpha_y[k]; - } - } - } - } - - // Avoid division by zero. - if (alpha_x < 1e-14) { - alpha_x = 1e-14; - } - if (alpha_y < 1e-14) { - alpha_y = 1e-14; - } - - // Compute stable time step from alpha. - double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - for (int k = 0; k < 3; k++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - - float *input_data = (float*) malloc(3 * sizeof(float)); - const float *output_data; - - input_data[0] = t; - input_data[1] = x; - input_data[2] = y; - - output_data = kann_apply1(ann[k], input_data); - - u[i][(j * 3) + k] = output_data[0]; - - free(input_data); - } - } - } - - // Apply simple boundary conditions in the x-direction (transmissive). - for (int j = 0; j <= ny + 3; j++) { - for (int k = 0; k < 3; k++) { - u[0][(j * 3) + k] = u[2][(j * 3) + k]; - u[1][(j * 3) + k] = u[2][(j * 3) + k]; - u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; - } - } - - // Apply simple boundary conditions in the y-direction (transmissive). - for (int i = 0; i <= nx + 3; i++) { - for (int k = 0; k < 3; k++) { - u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; - u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; - u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; - u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; - } - } - - // Output solution to disk. - for (int k = 0; k < 3; k++) { - const char *fmt = \"%s_validation_%d_%d.csv\"; - int sz = snprintf(0, 0, fmt, \"~a\", k, n); - char file_nm[sz + 1]; - snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); - - FILE *fptr = fopen(file_nm, \"w\"); - if (fptr != NULL) { - for (int i = 2; i <= nx + 1; i++) { - for (int j = 2; j <= ny + 1; j++) { - double x = x0 + (i - 1.5) * dx; - double y = y0 + (j - 1.5) * dy; - fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); - } - } - - fclose(fptr); - } - } - - // Increment time. - t += dt; - n += 1; - } - - for (int i = 0; i <= nx + 3; i++) { - free(u[i]); - } - free(u); - - free(local_alpha_x); - free(local_alpha_y); - - for (int i = 0; i < 3; i++) { - kann_delete(ann[i]); - } - free(ann); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells in each coordinate direction. - nx - ny - ;; Left/right boundaries. - x0 - x1 - ;; Up/down boundaries - y0 - y1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - (list-ref init-func-codes 2) - ;; PDE name for neural network input. - name - name - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals-x 0) - (list-ref max-speed-locals-x 1) - (list-ref max-speed-locals-x 2) - (list-ref max-speed-locals-y 0) - (list-ref max-speed-locals-y 1) - (list-ref max-speed-locals-y 2) - ;; PDE name for file output. - name - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/prover_core.rkt b/provable-algorithms/neural_networks/prover_core.rkt deleted file mode 100644 index b0770283..00000000 --- a/provable-algorithms/neural_networks/prover_core.rkt +++ /dev/null @@ -1,624 +0,0 @@ -#lang racket - -(require racket/trace) -(current-prefix-in " ") -(current-prefix-out " ") - -(provide symbolic-diff - symbolic-simp-rule - symbolic-simp - is-real - symbolic-diff-order - prove-scalar-1d-smooth - prove-scalar-1d-non-smooth - prove-scalar-2d-smooth - prove-scalar-2d-non-smooth) - -;; Lightweight symbolic differentiator (differentiates expr with respect to var). -(define (symbolic-diff expr var) - (match expr - ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. - [(? symbol? symb) (cond - [(eq? symb var) 1.0] - [else 0.0])] - - ;; If expr is a numerical constant, then it differentiates to 0. - [(? number?) 0.0] - - ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] - ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] - - ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. - [`(* . ,terms) - (define n (length terms)) - (define (mult xs) (cons '* xs)) ; Multiplication helper function. - - ((lambda (sums) (cond - [(null? (cdr sums)) (car sums)] - [else (cons '+ sums)])) - (let loop ([i 0]) - (cond - [(= i n) `()] - [else - ;; Evaluate the derivative of the i-th term in the product. - (let ([di (symbolic-diff (list-ref terms i) var)]) - (cons - (mult (for/list ([j (in-range n)]) - (cond - [(= j i) di] - [else (list-ref terms j)]))) - (loop (add1 i))))])))] - - ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. - [`(/ ,x ,y) - `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] - - ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). - [`(abs ,arg) - `(* (sgn ,arg) ,(symbolic-diff arg var))] - - ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. - [`(sgn ,arg) 0.0] - - ;; Otherwise, return false. - [else #f])) - -;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). -(define (symbolic-simp-rule expr) - (match expr - ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. - [`(+ 0 ,x) `,x] - [`(+ 0.0 ,x) `,x] - [`(+ -0.0 ,x) `,x] - - ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. - [`(* 1 ,x) `,x] - [`(* 1.0 ,x) `,x] - - ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. - [`(* 0 ,x) 0] - [`(* 0.0 ,x) 0.0] - [`(* -0.0 ,x) 0.0] - - ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. - [`(- ,x 0) `,x] - [`(- ,x 0.0) `,x] - [`(- ,x -0.0) `,x] - - ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). - [`(- 0 ,x) `(* -1 ,x)] - [`(- 0.0 ,x) `(* -1.0 ,x)] - [`(- -0.0 ,x) `(* -1.0 ,x)] - - ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. - [`(/ ,x 1) `,x] - [`(/ ,x 1.0) `,x] - - ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). - [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] - [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] - - ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). - [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] - [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] - - ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. - [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] - [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] - - ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients - [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] - [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] - - ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. - [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] - - ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). - [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] - - ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). - [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] - - ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). - [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] - - ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). - [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] - - ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). - [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] - - ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). - [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] - ;; Likewise for differences. - [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] - - ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. - [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] - - ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). - [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] - - ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). - [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] - - ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. - [`(sqrt (* ,x ,x)) `,x] - [`(* (sqrt ,x) (sqrt ,x)) `,x] - - ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). - [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] - ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). - [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] - - ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). - [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] - - ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. - [`(sqrt ,(and x (? number?))) (sqrt x)] - - ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. - [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] - [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] - - ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., - [`(abs ,(and x (? number?))) (abs x)] - - ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). - [`(abs (* -1 ,x)) `(abs ,x)] - [`(abs (* -1.0 ,x)) `(abs ,x)] - - ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). - [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] - [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - - ;; If expr is of the form (x + x), thens implify to (2.0 * x). - [`(+ ,x ,x) `(* 2.0 ,x)] - - ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). - [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] - - ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). - [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] - - ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). - [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] - - ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). - [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] - - ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). - [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] - [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] - - ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). - [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] - - ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). - [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] - - ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). - [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] - [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - - ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). - [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] - - ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). - [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] - - ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. - [`(/ 0 ,x) 0] - [`(/ 0.0 ,x) 0.0] - [`(/ -0.0 ,x) 0.0] - - ;; If expr is of the form (x / x), then simplify to 1.0 - [`(/ ,x ,x) 1.0] - - ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). - [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] - ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). - [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] - - ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). - [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] - - ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). - [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] - [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] - - ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). - [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] - [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] - - ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for differences. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. - [`(* . ,terms) - `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for quotients. - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. - [`(sqrt ,arg) - `(sqrt ,(symbolic-simp-rule arg))] - - ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. - [`(abs ,arg) - `(abs ,(symbolic-simp-rule arg))] - - ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). - [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] - [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] - - ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). - [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). - [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] - - ;; If expr is of the form expt(x, y) for numeric x and y, then just evaluate the exponential. - [`(expt ,(and x (? number?)) ,(and y (? number?))) (expt x y)] - ;; If expr is of the form expt(expr1, expr2), then apply symbolic simplification to the interior expr1 and expr2. - [`(expt ,x ,y) `(expt ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] - - ;; If expr is of the form (x < y) for numeric x and y, then just evaluate the comparison operator. - [`( < ,(and x (? number?)) ,(and y (? number?))) (< x y)] - ;; If expr is of the form (expr1 < expr2), then apply symbolic simplification to the interior expr1 and expr2. - [`(< ,x ,y) `(< ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] - - ;; Otherwise, return the expression. - [else expr])) - -;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). -(define (symbolic-simp expr) - (define simp-expr (symbolic-simp-rule expr)) - - (cond - [(equal? simp-expr expr) expr] - [else (symbolic-simp simp-expr)])) - -;; Recursively determine whether an expression corresponds to a real number. -(define (is-real expr cons-vars parameters) - (match expr - ;; Real numbers are trivially real. - [(? real?) #t] - - ;; Conserved variables are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (not (equal? (member arg cons-vars) #f)))) #t] - - ;; Simulation parameters are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (equal? arg (list-ref parameter 1))) parameters)))) #t] - - ;; The outcome of a conditional operation is real if both branches yield real numbers. - [`(cond - [,cond1 ,expr1] - [else ,expr2]) - (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] - - ;; The sum, difference, product, or quotient of two real numbers is always real. - [`(+ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(- . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(* . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(/ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - - ;; Otherwise, assume false. - [else #f])) - -;; Recursively differentiate expr with respect to var until the result is 0, and return the necessary order of differentiation. -(define (symbolic-diff-order expr var order) - (define diff-expr (symbolic-simp (symbolic-diff expr var))) - - (cond - [(or (equal? diff-expr 0.0) (equal? diff-expr 0)) (+ order 1)] - [(> order 1) +inf.0] - [else (symbolic-diff-order diff-expr var (+ order 1))])) - -;; -------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Scalar PDE -;; -------------------------------------------------------------------------------------------- -(define (prove-scalar-1d-smooth pde neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 1D scalar PDE specified by `pde`, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - - (define flux-deriv-order (symbolic-diff-order flux-expr cons-expr 0)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the neural network depth is at least equal to 2 + the order of the derivative of the flux function (otherwise, return infinity). - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,flux-deriv-order))) #f)) +inf.0] - - ;; Otherwise, return the bound. - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,flux-deriv-order)))))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - - out) -(trace prove-scalar-1d-smooth) - -;; ------------------------------------------------------------------------------------------------ -;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------------------------------ -(define (prove-scalar-1d-non-smooth pde neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 1D scalar PDE specified by `pde`, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - - (define flux-deriv-order (symbolic-diff-order flux-expr cons-expr 0)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the neural network depth is at least equal to 2 * the order of the derivative of the flux function (otherwise, return infinity). - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,flux-deriv-order))) #f)) +inf.0] - - ;; Otherwise, return the bound. - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,flux-deriv-order)))))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - - out) -(trace prove-scalar-1d-non-smooth) - -;; -------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Scalar PDE -;; -------------------------------------------------------------------------------------------- -(define (prove-scalar-2d-smooth pde neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 2D scalar PDE specified by `pde`, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - - (define flux-deriv-order-x (symbolic-diff-order flux-expr-x cons-expr 0)) - (define flux-deriv-order-y (symbolic-diff-order flux-expr-y cons-expr 0)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the neural network depth is at least equal to 3 + the order of the derivative of the flux function (otherwise, return infinity). - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,flux-deriv-order-x))) #f)) +inf.0] - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,flux-deriv-order-y))) #f)) +inf.0] - - ;; Otherwise, return the bound. - [else (max (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,flux-deriv-order-x))))) - (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,flux-deriv-order-y))))))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - - out) -(trace prove-scalar-2d-smooth) - -;; ------------------------------------------------------------------------------------------------ -;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Scalar PDE -;; ------------------------------------------------------------------------------------------------ -(define (prove-scalar-2d-non-smooth pde neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 2D scalar PDE specified by `pde`, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - - (define flux-deriv-order-x (symbolic-diff-order flux-expr-x cons-expr 0)) - (define flux-deriv-order-y (symbolic-diff-order flux-expr-y cons-expr 0)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the neural network depth is at least equal to 3 * the order of the derivative of the flux function (otherwise, return infinity). - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,flux-deriv-order-x))) #f)) +inf.0] - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,flux-deriv-order-y))) #f)) +inf.0] - - ;; Otherwise, return the bound. - [else (max (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,flux-deriv-order-x))))) - (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,flux-deriv-order-y))))))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - - out) -(trace prove-scalar-2d-non-smooth) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/prover_matrix.rkt b/provable-algorithms/neural_networks/prover_matrix.rkt deleted file mode 100644 index 4f152502..00000000 --- a/provable-algorithms/neural_networks/prover_matrix.rkt +++ /dev/null @@ -1,901 +0,0 @@ -#lang racket - -(require racket/trace) -(current-prefix-in " ") -(current-prefix-out " ") - -(provide symbolic-diff - symbolic-simp-rule - symbolic-simp - is-real - symbolic-diff-order - symbolic-jacobian-order - prove-vector3-1d-smooth - prove-vector3-1d-non-smooth - prove-vector4-2d-smooth - prove-vector4-2d-non-smooth) - -;; Lightweight symbolic differentiator (differentiates expr with respect to var). -(define (symbolic-diff expr var) - (match expr - ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. - [(? symbol? symb) (cond - [(eq? symb var) 1.0] - [else 0.0])] - - ;; If expr is a numerical constant, then it differentiates to 0. - [(? number?) 0.0] - - ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] - ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] - - ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. - [`(* . ,terms) - (define n (length terms)) - (define (mult xs) (cons '* xs)) ; Multiplication helper function. - - ((lambda (sums) (cond - [(null? (cdr sums)) (car sums)] - [else (cons '+ sums)])) - (let loop ([i 0]) - (cond - [(= i n) `()] - [else - ;; Evaluate the derivative of the i-th term in the product. - (let ([di (symbolic-diff (list-ref terms i) var)]) - (cons - (mult (for/list ([j (in-range n)]) - (cond - [(= j i) di] - [else (list-ref terms j)]))) - (loop (add1 i))))])))] - - ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. - [`(/ ,x ,y) - `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] - - ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). - [`(abs ,arg) - `(* (sgn ,arg) ,(symbolic-diff arg var))] - - ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. - [`(sgn ,arg) 0.0] - - ;; Otherwise, return false. - [else #f])) - -;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). -(define (symbolic-simp-rule expr) - (match expr - ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. - [`(+ 0 ,x) `,x] - [`(+ 0.0 ,x) `,x] - [`(+ -0.0 ,x) `,x] - - ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. - [`(* 1 ,x) `,x] - [`(* 1.0 ,x) `,x] - - ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. - [`(* 0 ,x) 0] - [`(* 0.0 ,x) 0.0] - [`(* -0.0 ,x) 0.0] - - ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. - [`(- ,x 0) `,x] - [`(- ,x 0.0) `,x] - [`(- ,x -0.0) `,x] - - ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). - [`(- 0 ,x) `(* -1 ,x)] - [`(- 0.0 ,x) `(* -1.0 ,x)] - [`(- -0.0 ,x) `(* -1.0 ,x)] - - ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. - [`(/ ,x 1) `,x] - [`(/ ,x 1.0) `,x] - - ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). - [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] - [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] - - ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). - [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] - [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] - - ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. - [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] - [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] - - ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients - [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] - [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] - - ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. - [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] - - ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). - [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] - - ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). - [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] - - ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). - [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] - - ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). - [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] - - ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). - [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] - - ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). - [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] - ;; Likewise for differences. - [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] - - ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. - [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] - - ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). - [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] - - ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). - [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] - - ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. - [`(sqrt (* ,x ,x)) `,x] - [`(* (sqrt ,x) (sqrt ,x)) `,x] - - ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). - [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] - ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). - [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] - - ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). - [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] - - ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. - [`(sqrt ,(and x (? number?))) (sqrt x)] - - ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. - [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] - [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] - - ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., - [`(abs ,(and x (? number?))) (abs x)] - - ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). - [`(abs (* -1 ,x)) `(abs ,x)] - [`(abs (* -1.0 ,x)) `(abs ,x)] - - ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). - [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] - [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - - ;; If expr is of the form (x + x), thens implify to (2.0 * x). - [`(+ ,x ,x) `(* 2.0 ,x)] - - ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). - [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] - - ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). - [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] - - ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). - [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] - - ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). - [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] - - ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). - [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] - [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] - - ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). - [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] - - ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). - [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] - - ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). - [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] - [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - - ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). - [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] - - ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). - [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] - - ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. - [`(/ 0 ,x) 0] - [`(/ 0.0 ,x) 0.0] - [`(/ -0.0 ,x) 0.0] - - ;; If expr is of the form (x / x), then simplify to 1.0 - [`(/ ,x ,x) 1.0] - - ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). - [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] - ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). - [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] - - ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). - [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] - - ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). - [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] - [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] - - ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). - [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] - [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] - - ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for differences. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. - [`(* . ,terms) - `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for quotients. - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. - [`(sqrt ,arg) - `(sqrt ,(symbolic-simp-rule arg))] - - ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. - [`(abs ,arg) - `(abs ,(symbolic-simp-rule arg))] - - ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). - [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] - [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] - - ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). - [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). - [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] - - ;; If expr is of the form expt(x, y) for numeric x and y, then just evaluate the exponential. - [`(expt ,(and x (? number?)) ,(and y (? number?))) (expt x y)] - ;; If expr is of the form expt(expr1, expr2), then apply symbolic simplification to the interior expr1 and expr2. - [`(expt ,x ,y) `(expt ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] - - ;; If expr is of the form (x < y) for numeric x and y, then just evaluate the comparison operator. - [`( < ,(and x (? number?)) ,(and y (? number?))) (< x y)] - ;; If expr is of the form (expr1 < expr2), then apply symbolic simplification to the interior expr1 and expr2. - [`(< ,x ,y) `(< ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] - - ;; Otherwise, return the expression. - [else expr])) - -;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). -(define (symbolic-simp expr) - (define simp-expr (symbolic-simp-rule expr)) - - (cond - [(equal? simp-expr expr) expr] - [else (symbolic-simp simp-expr)])) - -;; Recursively determine whether an expression corresponds to a real number. -(define (is-real expr cons-vars parameters) - (match expr - ;; Real numbers are trivially real. - [(? real?) #t] - - ;; Conserved variables are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (not (equal? (member arg cons-vars) #f)))) #t] - - ;; Simulation parameters are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (equal? arg (list-ref parameter 1))) parameters)))) #t] - - ;; The outcome of a conditional operation is real if both branches yield real numbers. - [`(cond - [,cond1 ,expr1] - [else ,expr2]) - (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] - - ;; The sum, difference, product, or quotient of two real numbers is always real. - [`(+ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(- . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(* . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(/ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - - ;; Otherwise, assume false. - [else #f])) - -;; Recursively differentiate expr with respect to var until the result is 0, and return the necessary order of differentiation. -(define (symbolic-diff-order expr var order) - (define diff-expr (symbolic-simp (symbolic-diff expr var))) - - (cond - [(or (equal? diff-expr 0.0) (equal? diff-expr 0)) (+ order 1)] - [(> order 1) #f] - [else (symbolic-diff-order diff-expr var (+ order 1))])) - -;; Recursively differentiate each component of exprs with respect to each component of vars until the results are 0, and return the necessary orders of differentiation. -(define (symbolic-jacobian-order exprs vars) - (map (lambda (expr) - (map (lambda (var) - (symbolic-diff-order expr var 0)) - vars)) - exprs)) - -;; ----------------------------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Coupled Vector System of 3 PDEs -;; ----------------------------------------------------------------------------------------------------------------- -(define (prove-vector3-1d-smooth pde-system neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 0.0] - [else 0.0]) - `(cond - [(< x 0.5) 7.5] - [else 2.5]))]) - "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde-system`, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - (trace symbolic-jacobian-order) - - (define flux-jacobian-order (symbolic-jacobian-order flux-exprs cons-exprs)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the neural network depth is at least equal to 2 + the order of each component of the Jacobian of the flux function: if so, return the bounds; - ;; otherwise, return false. - [else (list (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 2))))))]))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - (untrace symbolic-jacobian-order) - - out) -(trace prove-vector3-1d-smooth) - -;; --------------------------------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Coupled Vector System of 3 PDEs -;; --------------------------------------------------------------------------------------------------------------------- -(define (prove-vector3-1d-non-smooth pde-system neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 0.0] - [else 0.0]) - `(cond - [(< x 0.5) 7.5] - [else 2.5]))]) - "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde-system`, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - (trace symbolic-jacobian-order) - - (define flux-jacobian-order (symbolic-jacobian-order flux-exprs cons-exprs)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the neural network depth is at least equal to 2 * the order of each component of the Jacobian of the flux function: if so, return the bounds; - ;; otherwise, return false. - [else (list (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 2))))))]))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - (untrace symbolic-jacobian-order) - - out) -(trace prove-vector3-1d-non-smooth) - -;; ----------------------------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Coupled Vector System of 4 PDEs -;; ----------------------------------------------------------------------------------------------------------------- -(define (prove-vector4-2d-smooth pde-system neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde-system`, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - (trace symbolic-jacobian-order) - - (define flux-jacobian-order-x (symbolic-jacobian-order flux-exprs-x cons-exprs)) - (define flux-jacobian-order-y (symbolic-jacobian-order flux-exprs-y cons-exprs)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 3) cons-exprs parameters))) #f] - - ;; Check whether the neural network depth is at least equal to 3 + the order of each component of the Jacobian of the flux function: if so, return the bounds; - ;; otherwise, return false. - [else (list (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 3))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 3))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 3))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 3))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 3))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 3))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 3))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 3))))))])))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - (untrace symbolic-jacobian-order) - - out) -(trace prove-vector4-2d-smooth) - -;; ----------------------------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Coupled Vector System of 4 PDEs -;; ----------------------------------------------------------------------------------------------------------------- -(define (prove-vector4-2d-non-smooth pde-system neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde-system`, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - (trace symbolic-jacobian-order) - - (define flux-jacobian-order-x (symbolic-jacobian-order flux-exprs-x cons-exprs)) - (define flux-jacobian-order-y (symbolic-jacobian-order flux-exprs-y cons-exprs)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 3) cons-exprs parameters))) #f] - - ;; Check whether the neural network depth is at least equal to 3 * the order of each component of the Jacobian of the flux function: if so, return the bounds; - ;; otherwise, return false. - [else (list (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 3))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 3))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 3))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 3))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 3))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 3))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 3))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 3)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 3))))))])))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - (untrace symbolic-jacobian-order) - - out) -(trace prove-vector4-2d-non-smooth) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/prover_vector.rkt b/provable-algorithms/neural_networks/prover_vector.rkt deleted file mode 100644 index 87661b59..00000000 --- a/provable-algorithms/neural_networks/prover_vector.rkt +++ /dev/null @@ -1,826 +0,0 @@ -#lang racket - -(require racket/trace) -(current-prefix-in " ") -(current-prefix-out " ") - -(provide symbolic-diff - symbolic-simp-rule - symbolic-simp - is-real - symbolic-diff-order - symbolic-jacobian-order - symbolic-jacobian - symbolic-eigvals2 - symbolic-eigvals3 - prove-vector2-1d-smooth - prove-vector2-1d-non-smooth - prove-vector3-2d-smooth - prove-vector3-2d-non-smooth) - -;; Lightweight symbolic differentiator (differentiates expr with respect to var). -(define (symbolic-diff expr var) - (match expr - ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. - [(? symbol? symb) (cond - [(eq? symb var) 1.0] - [else 0.0])] - - ;; If expr is a numerical constant, then it differentiates to 0. - [(? number?) 0.0] - - ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] - ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] - - ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. - [`(* . ,terms) - (define n (length terms)) - (define (mult xs) (cons '* xs)) ; Multiplication helper function. - - ((lambda (sums) (cond - [(null? (cdr sums)) (car sums)] - [else (cons '+ sums)])) - (let loop ([i 0]) - (cond - [(= i n) `()] - [else - ;; Evaluate the derivative of the i-th term in the product. - (let ([di (symbolic-diff (list-ref terms i) var)]) - (cons - (mult (for/list ([j (in-range n)]) - (cond - [(= j i) di] - [else (list-ref terms j)]))) - (loop (add1 i))))])))] - - ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. - [`(/ ,x ,y) - `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] - - ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). - [`(abs ,arg) - `(* (sgn ,arg) ,(symbolic-diff arg var))] - - ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. - [`(sgn ,arg) 0.0] - - ;; Otherwise, return false. - [else #f])) - -;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). -(define (symbolic-simp-rule expr) - (match expr - ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. - [`(+ 0 ,x) `,x] - [`(+ 0.0 ,x) `,x] - [`(+ -0.0 ,x) `,x] - - ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. - [`(* 1 ,x) `,x] - [`(* 1.0 ,x) `,x] - - ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. - [`(* 0 ,x) 0] - [`(* 0.0 ,x) 0.0] - [`(* -0.0 ,x) 0.0] - - ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. - [`(- ,x 0) `,x] - [`(- ,x 0.0) `,x] - [`(- ,x -0.0) `,x] - - ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). - [`(- 0 ,x) `(* -1 ,x)] - [`(- 0.0 ,x) `(* -1.0 ,x)] - [`(- -0.0 ,x) `(* -1.0 ,x)] - - ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. - [`(/ ,x 1) `,x] - [`(/ ,x 1.0) `,x] - - ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). - [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] - [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] - - ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). - [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] - [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] - - ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. - [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] - [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] - - ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients - [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] - [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] - - ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. - [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] - - ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). - [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] - - ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). - [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] - - ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). - [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] - - ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). - [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] - - ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). - [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] - - ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). - [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] - ;; Likewise for differences. - [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] - - ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. - [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] - - ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). - [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] - - ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). - [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] - - ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. - [`(sqrt (* ,x ,x)) `,x] - [`(* (sqrt ,x) (sqrt ,x)) `,x] - - ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). - [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] - ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). - [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] - - ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). - [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] - - ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. - [`(sqrt ,(and x (? number?))) (sqrt x)] - - ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. - [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] - [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] - - ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., - [`(abs ,(and x (? number?))) (abs x)] - - ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). - [`(abs (* -1 ,x)) `(abs ,x)] - [`(abs (* -1.0 ,x)) `(abs ,x)] - - ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). - [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] - [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - - ;; If expr is of the form (x + x), thens implify to (2.0 * x). - [`(+ ,x ,x) `(* 2.0 ,x)] - - ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). - [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] - - ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). - [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] - - ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). - [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] - - ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). - [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] - - ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). - [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] - [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] - - ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). - [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] - - ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). - [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] - - ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). - [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] - [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - - ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). - [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] - - ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). - [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] - - ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. - [`(/ 0 ,x) 0] - [`(/ 0.0 ,x) 0.0] - [`(/ -0.0 ,x) 0.0] - - ;; If expr is of the form (x / x), then simplify to 1.0 - [`(/ ,x ,x) 1.0] - - ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). - [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] - ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). - [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] - - ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). - [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] - - ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). - [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] - [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] - - ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). - [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] - [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] - - ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for differences. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. - [`(* . ,terms) - `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for quotients. - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. - [`(sqrt ,arg) - `(sqrt ,(symbolic-simp-rule arg))] - - ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. - [`(abs ,arg) - `(abs ,(symbolic-simp-rule arg))] - - ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). - [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] - [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] - - ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). - [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). - [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] - - ;; If expr is of the form expt(x, y) for numeric x and y, then just evaluate the exponential. - [`(expt ,(and x (? number?)) ,(and y (? number?))) (expt x y)] - ;; If expr is of the form expt(expr1, expr2), then apply symbolic simplification to the interior expr1 and expr2. - [`(expt ,x ,y) `(expt ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] - - ;; If expr is of the form (x < y) for numeric x and y, then just evaluate the comparison operator. - [`( < ,(and x (? number?)) ,(and y (? number?))) (< x y)] - ;; If expr is of the form (expr1 < expr2), then apply symbolic simplification to the interior expr1 and expr2. - [`(< ,x ,y) `(< ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] - - ;; Otherwise, return the expression. - [else expr])) - -;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). -(define (symbolic-simp expr) - (define simp-expr (symbolic-simp-rule expr)) - - (cond - [(equal? simp-expr expr) expr] - [else (symbolic-simp simp-expr)])) - -;; Recursively determine whether an expression corresponds to a real number. -(define (is-real expr cons-vars parameters) - (match expr - ;; Real numbers are trivially real. - [(? real?) #t] - - ;; Conserved variables are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (not (equal? (member arg cons-vars) #f)))) #t] - - ;; Simulation parameters are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (equal? arg (list-ref parameter 1))) parameters)))) #t] - - ;; The outcome of a conditional operation is real if both branches yield real numbers. - [`(cond - [,cond1 ,expr1] - [else ,expr2]) - (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] - - ;; The sum, difference, product, or quotient of two real numbers is always real. - [`(+ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(- . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(* . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(/ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - - ;; Otherwise, assume false. - [else #f])) - -;; Recursively differentiate expr with respect to var until the result is 0, and return the necessary order of differentiation. -(define (symbolic-diff-order expr var order) - (define diff-expr (symbolic-simp (symbolic-diff expr var))) - - (cond - [(or (equal? diff-expr 0.0) (equal? diff-expr 0)) (+ order 1)] - [(> order 1) +inf.0] - [else (symbolic-diff-order diff-expr var (+ order 1))])) - -;; Recursively differentiate each component of exprs with respect to each component of vars until the results are 0, and return the necessary orders of differentiation. -(define (symbolic-jacobian-order exprs vars) - (map (lambda (expr) - (map (lambda (var) - (symbolic-diff-order expr var 0)) - vars)) - exprs)) - -;; Compute symbolic Jacobian matrix by mapping symbolic differentiation over exprs with respect to vars. -(define (symbolic-jacobian exprs vars) - (map (lambda (expr) - (map (lambda (var) - (symbolic-simp (symbolic-diff expr var))) - vars)) - exprs)) - -;; Compute symbolic eigenvalues of a 2x2 symbolic matrix via explicit solution of the characteristic polynomial. -(define (symbolic-eigvals2 matrix) - (let ([a (list-ref (list-ref matrix 0) 0)] - [b (list-ref (list-ref matrix 0) 1)] - [c (list-ref (list-ref matrix 1) 0)] - [d (list-ref (list-ref matrix 1) 1)]) - (cond - ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a pair of zeroes. - [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0)) (list 0.0 0.0)] - - ;; Otherwise, calculate the eigenvalues explicitly. - [else (list `(* 0.5 (+ (- ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)) - `(* 0.5 (+ (+ ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)))]))) - -;; Compute symbolic eigenvalues of a 3x3 symbolic matrix (in restricted cases) via explicit solution of the characteristic polynomial. -(define (symbolic-eigvals3 matrix) - (let ([a (list-ref (list-ref matrix 0) 0)] - [b (list-ref (list-ref matrix 0) 1)] - [c (list-ref (list-ref matrix 0) 2)] - [d (list-ref (list-ref matrix 1) 0)] - [e (list-ref (list-ref matrix 1) 1)] - [f (list-ref (list-ref matrix 1) 2)] - [g (list-ref (list-ref matrix 2) 0)] - [h (list-ref (list-ref matrix 2) 1)] - [i (list-ref (list-ref matrix 2) 2)]) - (cond - ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a triple of zeroes. - [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0) (equal? e 0.0) (equal? f 0.0) (equal? g 0.0) (equal? h 0.0) (equal? i 0.0)) (list 0.0 0.0 0.0)] - - ;; If the matrix is in a restricted (tractable) form, calculate the eigenvalues explicitly. - [(and (equal? a 0.0) (equal? b 1.0) (equal? c 0.0) (equal? f 0.0)) - (list `(* 0.5 (- ,e (sqrt (+ (* 4.0 ,d) (* ,e ,e))))) `(* 0.5 (+ ,e (sqrt (+ (* 4.0 ,d) (* ,e ,e))))) i)] - [(and (equal? a 0.0) (equal? b 0.0) (equal? c 1.0) (equal? h 0.0)) - (list e `(* 0.5 (- ,i (sqrt (+ (* 4.0 ,g) (* ,i ,i))))) `(* 0.5 (+ ,i (sqrt (+ (* 4.0 ,g) (* ,i ,i))))))] - - ;; Otherwise, return false(s). - [else (list #f #f #f)]))) - -;; ----------------------------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Coupled Vector System of 2 PDEs -;; ----------------------------------------------------------------------------------------------------------------- -(define (prove-vector2-1d-smooth pde-system neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system`, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - (trace symbolic-jacobian-order) - - (define flux-jacobian-order (symbolic-jacobian-order flux-exprs cons-exprs)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the neural network depth is at least equal to 2 + the order of each component of the Jacobian of the flux function: if so, return the bounds; - ;; otherwise, return false. - [else (list (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 1))))))]))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - (untrace symbolic-jacobian-order) - - out) -(trace prove-vector2-1d-smooth) - -;; --------------------------------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Coupled Vector System of 2 PDEs -;; --------------------------------------------------------------------------------------------------------------------- -(define (prove-vector2-1d-non-smooth pde-system neural-net - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system`, - with neural network architecture `neural-net`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - (trace symbolic-jacobian-order) - - (define flux-jacobian-order (symbolic-jacobian-order flux-exprs cons-exprs)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the neural network depth is at least equal to 2 * the order of each component of the Jacobian of the flux function: if so, return the bounds; - ;; otherwise, return false. - [else (list (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 1))))))]))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - (untrace symbolic-jacobian-order) - - out) -(trace prove-vector2-1d-non-smooth) - -;; ----------------------------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Coupled Vector System of 3 PDEs -;; ----------------------------------------------------------------------------------------------------------------- -(define (prove-vector3-2d-smooth pde-system neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system`, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - (trace symbolic-jacobian-order) - - (define flux-jacobian-order-x (symbolic-jacobian-order flux-exprs-x cons-exprs)) - (define flux-jacobian-order-y (symbolic-jacobian-order flux-exprs-y cons-exprs)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the neural network depth is at least equal to 3 + the order of each component of the Jacobian of the flux function: if so, return the bounds; - ;; otherwise, return false. - [else (list (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2))))))])))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - (untrace symbolic-jacobian-order) - - out) -(trace prove-vector3-2d-smooth) - -;; --------------------------------------------------------------------------------------------------------------------- -;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Coupled Vector System of 3 PDEs -;; --------------------------------------------------------------------------------------------------------------------- -(define (prove-vector3-2d-non-smooth pde-system neural-net - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] - [else 1.0]) - `0.0 - `0.0)]) - "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system`, - with neural network architecture `neural-net`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) - (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) - (define parameters (hash-ref pde-system 'parameters)) - - (define width (hash-ref neural-net 'width)) - (define depth (hash-ref neural-net 'depth)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-diff-order) - (trace symbolic-jacobian-order) - - (define flux-jacobian-order-x (symbolic-jacobian-order flux-exprs-x cons-exprs)) - (define flux-jacobian-order-y (symbolic-jacobian-order flux-exprs-y cons-exprs)) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] - - ;; Check whether the neural network depth is at least equal to 3 * the order of each component of the Jacobian of the flux function: if so, return the bounds; - ;; otherwise, return false. - [else (list (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1))))))])) - (max (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2))))))]) - (cond - [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2)))) #f)) +inf.0] - [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2))))))])))])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-diff-order) - (untrace symbolic-jacobian-order) - - out) -(trace prove-vector3-2d-non-smooth) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/test_euler_shallow.rkt b/provable-algorithms/neural_networks/test_euler_shallow.rkt deleted file mode 100644 index 04a8b96d..00000000 --- a/provable-algorithms/neural_networks/test_euler_shallow.rkt +++ /dev/null @@ -1,450 +0,0 @@ -#lang racket - -(require "code_generator_core_training.rkt") -(require "code_generator_matrix_training.rkt") -(require "code_generator_matrix_training_2d.rkt") -(require "code_generator_matrix_validation.rkt") -(require "prover_matrix.rkt") -(provide (all-from-out "code_generator_core_training.rkt")) -(provide (all-from-out "code_generator_matrix_training.rkt")) -(provide (all-from-out "code_generator_matrix_training_2d.rkt")) -(provide (all-from-out "code_generator_matrix_validation.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D Euler equations (density, x-momentum, and total energy components). -(define pde-system-euler - (hash - 'name "euler" - 'cons-exprs (list - `rho - `mom_x - `energy) ; conserved variables: density, x-momentum, total energy - 'flux-exprs (list - `mom_x - `(+ (/ (* mom_x mom_x) rho) (* (- gamma 1.0) (- energy (* 0.5 (/ (* mom_x mom_x) rho))))) - `(* (+ energy (* (- gamma 1.0) (- energy (* 0.5 (/ (* mom_x mom_x) rho))))) (/ mom_x rho))) - ; flux vector - 'max-speed-exprs (list - `(abs (- (/ mom_x rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (/ (* mom_x mom_x) rho))))) rho)))) - `(abs (/ mom_x rho)) - `(abs (+ (/ mom_x rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (/ (* mom_x mom_x) rho))))) rho))))) - ; local wave-speeds - 'parameters (list - `(define gamma 1.4)) ; adiabatic index: gamma = 1.4 - )) - -;; Define simulation parameters. -(define nx 800) -(define x0 0.0) -(define x1 1.0) -(define t-final 0.1) -(define cfl 0.95) -(define init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 0.0] - [else 0.0]) - `(cond - [(< x 0.5) 7.5] - [else 2.5]))) - -;; Define (shallow) neural network hyperparameters. -(define neural-net-shallow - (hash - 'max-trains 10000 ; maximum number of training steps: 10000 - 'width 64 ; number of neurons in each layer: 64 - 'depth 6 ; total number of layers: 6 - 'num-threads 12 ; number of threads to use in training: 12 - 'mini-size 100 ; size of training mini-batch: 100 - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D Euler equations using a shallow neural network. -(define code-euler-lax-train - (train-lax-friedrichs-vector3-1d pde-system-euler neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/euler_lax_train.c" - #:exists 'replace - (lambda () - (display code-euler-lax-train))) - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-euler-lax-minmod-train - (train-lax-friedrichs-vector3-1d-second-order pde-system-euler limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/euler_lax_minmod_train.c" - #:exists 'replace - (lambda () - (display code-euler-lax-minmod-train))) - -(display "1D compressible Euler properties: \n\n") - -;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 1D Euler equations. -(define proof-euler-smooth - (call-with-output-file "proofs/proof_euler_smooth.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-vector3-1d-smooth pde-system-euler neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_euler_smooth.rkt") - -;; Show the error bounds (if applicable) on smooth solutions. -(display "Error bound on rho (smooth solutions): ") -(display (max (list-ref proof-euler-smooth 0) (list-ref proof-euler-smooth 1) (list-ref proof-euler-smooth 2))) -(display "\n") - -(display "Error bound on mom_x (smooth solutions): ") -(display (max (list-ref proof-euler-smooth 3) (list-ref proof-euler-smooth 4) (list-ref proof-euler-smooth 5))) -(display "\n") - -(display "Error bound on energy (smooth solutions): ") -(display (max (list-ref proof-euler-smooth 6) (list-ref proof-euler-smooth 7) (list-ref proof-euler-smooth 8))) -(display "\n") - -;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 1D Euler equations. -(define proof-euler-non-smooth - (call-with-output-file "proofs/proof_euler_non_smooth.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-vector3-1d-non-smooth pde-system-euler neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_euler_non_smooth.rkt") - -;; Show the error bounds (if applicable) on non-smooth solutions. -(display "Error bound on rho (non-smooth solutions): ") -(display (max (list-ref proof-euler-non-smooth 0) (list-ref proof-euler-non-smooth 1) (list-ref proof-euler-non-smooth 2))) -(display "\n") - -(display "Error bound on mom_x (non-smooth solutions): ") -(display (max (list-ref proof-euler-non-smooth 3) (list-ref proof-euler-non-smooth 4) (list-ref proof-euler-non-smooth 5))) -(display "\n") - -(display "Error bound on energy (non-smooth solutions): ") -(display (max (list-ref proof-euler-non-smooth 6) (list-ref proof-euler-non-smooth 7) (list-ref proof-euler-non-smooth 8))) -(display "\n\n\n") - -;; Synthesize the code to validate any first-order surrogate solver for the 1D Euler equations using a shallow neural network. -(define code-euler-validate - (validate-vector3-1d pde-system-euler neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/euler_validate.c" - #:exists 'replace - (lambda () - (display code-euler-validate))) - -;; Synthesize the code to validate any first-order surrogate solver for the 1D Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-euler-minmod-validate - (validate-vector3-1d-second-order pde-system-euler limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/euler_minmod_validate.c" - #:exists 'replace - (lambda () - (display code-euler-minmod-validate))) - -;; Define the 2D Euler equations (density, x-momentum and y-momentum, and total energy components). -(define pde-system-euler-2d - (hash - 'name "euler-2d" - 'cons-exprs (list - `rho - `mom_x - `mom_y - `energy) ; conserved variables: density, x-momentum, y-momentum, total energy - 'flux-exprs-x (list - `mom_x - `(+ (/ (* mom_x mom_x) rho) (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) - `(* mom_y (/ mom_x rho)) - `(* (+ energy (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) (/ mom_x rho))) - ; flux vector (x-direction) - 'flux-exprs-y (list - `mom_y - `(* mom_x (/ mom_y rho)) - `(+ (/ (* mom_y mom_y) rho) (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) - `(* (+ energy (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) (/ mom_y rho))) - ; flux vector (y-direction) - 'max-speed-exprs-x (list - `(abs (- (/ mom_x rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) rho)))) - `(abs (/ mom_x rho)) - `(abs (/ mom_x rho)) - `(abs (+ (/ mom_x rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) rho))))) - ; local wave-speeds (x-direction) - 'max-speed-exprs-y (list - `(abs (- (/ mom_y rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) rho)))) - `(abs (/ mom_y rho)) - `(abs (/ mom_y rho)) - `(abs (+ (/ mom_y rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) rho))))) - ; local wave-speeds (y-direction) - 'parameters (list - `(define gamma 1.4)) ; adiabatic index: gamma = 1.4 - )) - -;; Define 2D simulation parameters. -(define nx-2d 50) -(define ny-2d 50) -(define x0-2d 0.0) -(define x1-2d 1.0) -(define y0-2d 0.0) -(define y1-2d 1.0) -(define t-final-2d 0.8) -(define cfl-2d 0.95) -(define init-funcs-2d (list - `(cond - [(> y 0.8) - (cond - [(< x 0.8) 0.5323] - [else 1.5])] - [else - (cond - [(< x 0.8) 0.138] - [else 0.5323])]) - `(cond - [(> y 0.8) - (cond - [(< x 0.8) 0.641954] - [else 0.0])] - [else - (cond - [(< x 0.8) 0.166428] - [else 0.0])]) - `(cond - [(> y 0.8) - (cond - [(< x 0.8) 0.0] - [else 0.0])] - [else - (cond - [(< x 0.8) 0.166428] - [else 0.641954])]) - `(cond - [(> y 0.8) - (cond - [(< x 0.8) 1.137098] - [else 3.75])] - [else - (cond - [(< x 0.8) 0.273212] - [else 1.137098])]))) - -;; Define (shallow) neural network hyperparameters for 2D. -(define neural-net-shallow-2d - (hash - 'max-trains 10000 ; maximum number of training steps: 10000 - 'width 64 ; number of neurons in each layer: 64 - 'depth 6 ; total number of layers: 6 - 'num-threads 12 ; number of threads to use in training: 12 - 'mini-size 100 ; size of training mini-batch: 100 - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D Euler equations using a shallow neural network. -(define code-euler-lax-train-2d - (train-lax-friedrichs-vector4-2d pde-system-euler-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/euler_lax_train_2d.c" - #:exists 'replace - (lambda () - (display code-euler-lax-train-2d))) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-euler-lax-minmod-train-2d - (train-lax-friedrichs-vector4-2d-second-order pde-system-euler-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/euler_lax_minmod_train_2d.c" - #:exists 'replace - (lambda () - (display code-euler-lax-minmod-train-2d))) - -(display "2D compressible Euler properties: \n\n") - -;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 2D Euler equations. -(define proof-euler-smooth-2d - (call-with-output-file "proofs/proof_euler_smooth_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-vector4-2d-smooth pde-system-euler-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_euler_smooth_2d.rkt") - -;; Show the error bounds (if applicable) on smooth solutions. -(display "Error bound on rho (smooth solutions): ") -(display (max (list-ref proof-euler-smooth-2d 0) (list-ref proof-euler-smooth-2d 1) (list-ref proof-euler-smooth-2d 2) (list-ref proof-euler-smooth-2d 3))) -(display "\n") - -(display "Error bound on mom_x (smooth solutions): ") -(display (max (list-ref proof-euler-smooth-2d 4) (list-ref proof-euler-smooth-2d 5) (list-ref proof-euler-smooth-2d 6) (list-ref proof-euler-smooth-2d 7))) -(display "\n") - -(display "Error bound on mom_y (smooth solutions): ") -(display (max (list-ref proof-euler-smooth-2d 8) (list-ref proof-euler-smooth-2d 9) (list-ref proof-euler-smooth-2d 10) (list-ref proof-euler-smooth-2d 11))) -(display "\n") - -(display "Error bound on energy (smooth solutions): ") -(display (max (list-ref proof-euler-smooth-2d 12) (list-ref proof-euler-smooth-2d 13) (list-ref proof-euler-smooth-2d 14) (list-ref proof-euler-smooth-2d 15))) -(display "\n") - -;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 2D Euler equations. -(define proof-euler-non-smooth-2d - (call-with-output-file "proofs/proof_euler_non_smooth_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-vector4-2d-non-smooth pde-system-euler-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_euler_non_smooth_2d.rkt") - -;; Show the error bounds (if applicable) on non-smooth solutions. -(display "Error bound on rho (non-smooth solutions): ") -(display (max (list-ref proof-euler-non-smooth-2d 0) (list-ref proof-euler-non-smooth-2d 1) (list-ref proof-euler-non-smooth-2d 2) (list-ref proof-euler-non-smooth-2d 3))) -(display "\n") - -(display "Error bound on mom_x (non-smooth solutions): ") -(display (max (list-ref proof-euler-non-smooth-2d 4) (list-ref proof-euler-non-smooth-2d 5) (list-ref proof-euler-non-smooth-2d 6) (list-ref proof-euler-non-smooth-2d 7))) -(display "\n") - -(display "Error bound on mom_y (non-smooth solutions): ") -(display (max (list-ref proof-euler-non-smooth-2d 8) (list-ref proof-euler-non-smooth-2d 9) (list-ref proof-euler-non-smooth-2d 10) (list-ref proof-euler-non-smooth-2d 11))) -(display "\n") - -(display "Error bound on energy (non-smooth solutions): ") -(display (max (list-ref proof-euler-non-smooth-2d 12) (list-ref proof-euler-non-smooth-2d 13) (list-ref proof-euler-non-smooth-2d 14) (list-ref proof-euler-non-smooth-2d 15))) -(display "\n") - -;; Synthesize the code to validate any first-order surrogate solver for the 2D Euler equations using a shallow neural network. -(define code-euler-validate-2d - (validate-vector4-2d pde-system-euler-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/euler_validate_2d.c" - #:exists 'replace - (lambda () - (display code-euler-validate-2d))) - -;; Synthesize the code to validate any first-order surrogate solver for the 2D Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-euler-minmod-validate-2d - (validate-vector4-2d-second-order pde-system-euler-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/euler_minmod_validate_2d.c" - #:exists 'replace - (lambda () - (display code-euler-minmod-validate-2d))) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/test_inviscid_burgers_shallow.rkt b/provable-algorithms/neural_networks/test_inviscid_burgers_shallow.rkt deleted file mode 100644 index f8904a5d..00000000 --- a/provable-algorithms/neural_networks/test_inviscid_burgers_shallow.rkt +++ /dev/null @@ -1,403 +0,0 @@ -#lang racket - -(require "code_generator_core_training.rkt") -(require "code_generator_core_training_2d.rkt") -(require "code_generator_core_validation.rkt") -(require "prover_core.rkt") -(provide (all-from-out "code_generator_core_training.rkt")) -(provide (all-from-out "code_generator_core_training_2d.rkt")) -(provide (all-from-out "code_generator_core_validation.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D inviscid Burgers' equation: du/dt + u du/dx = 0. -(define pde-inviscid-burgers - (hash - 'name "burgers" - 'cons-expr `u ; conserved variable: u - 'flux-expr `(* 0.5 u u) ; flux function: f(u) = 0.5 * u^2 - 'max-speed-expr `(abs u) ; local wave-speed: alpha = |u| - 'parameters `() - )) - -;; Define simulation parameters. -(define nx 400) -(define x0 -3.0) -(define x1 3.0) -(define t-final 0.5) -(define cfl 0.95) -(define init-func `(cond - [(< (abs x) 1.0) 3.0] - [else -1.0])) - -;; Define (shallow) neural network hyperparameters. -(define neural-net-shallow - (hash - 'max-trains 10000 ; maximum number of training steps: 10000 - 'width 64 ; number of neurons in each layer: 64 - 'depth 6 ; total number of layers: 8 - 'num-threads 12 ; number of threads to use in training: 12 - 'mini-size 100 ; size of training mini-batch: 100 - )) - - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D inviscid Burgers' equation using a shallow neural network. -(define code-inviscid-burgers-lax-train - (train-lax-friedrichs-scalar-1d pde-inviscid-burgers neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax_train.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-train))) - -;; Synthesize the code to train a Roe surrogate solver for the 1D inviscid Burgers' equation using a shallow neural network. -(define code-inviscid-burgers-roe-train - (train-roe-scalar-1d pde-inviscid-burgers neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe_train.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-train))) - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-inviscid-burgers-lax-minmod-train - (train-lax-friedrichs-scalar-1d-second-order pde-inviscid-burgers limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax_minmod_train.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-minmod-train))) - -;; Synthesize the code to train a Roe surrogate solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-inviscid-burgers-roe-minmod-train - (train-roe-scalar-1d-second-order pde-inviscid-burgers limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe_minmod_train.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-minmod-train))) - -(display "1D inviscid Burgers' properties: \n\n") - -;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-smooth - (call-with-output-file "proofs/proof_inviscid_burgers_smooth.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-scalar-1d-smooth pde-inviscid-burgers neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_smooth.rkt") - -;; Show the error bound (if applicable) on smooth solutions. -(display "Error bound (smooth solutions): ") -(display proof-inviscid-burgers-smooth) -(display "\n") - -;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-non-smooth - (call-with-output-file "proofs/proof_inviscid_burgers_non_smooth.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-scalar-1d-non-smooth pde-inviscid-burgers neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_non_smooth.rkt") - -;; Show the error bound (if applicable) on non-smooth solutions. -(display "Error bound (non-smooth solutions): ") -(display proof-inviscid-burgers-non-smooth) -(display "\n\n\n") - -;; Synthesize the code to validate any first-order surrogate solver for the 1D inviscid Burgers' equation using a shallow neural network. -(define code-inviscid-burgers-validate - (validate-scalar-1d pde-inviscid-burgers neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_validate.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-validate))) - -;; Synthesize the code to validate any first-order surrogate solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-inviscid-burgers-minmod-validate - (validate-scalar-1d-second-order pde-inviscid-burgers limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_minmod_validate.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-minmod-validate))) - -;; Define the 2D inviscid Burgers' equation: du/dt + u du/dx + u du/dy = 0. -(define pde-inviscid-burgers-2d - (hash - 'name "burgers-2d" - 'cons-expr `u ; conserved variable: u - 'flux-expr-x `(* 0.5 u u) ; x-flux function: f(u) = 0.5 * u^2 - 'flux-expr-y `(* 0.5 u u) ; y-flux function: f(u) = 0.5 * u^2 - 'max-speed-expr-x `(abs u) ; local wave-speed: alpha_x = |u| - 'max-speed-expr-y `(abs u) ; local wave-speed: alpha_y = |u| - 'parameters `() - )) - -;; Define 2D simulation parameters. -(define nx-2d 100) -(define ny-2d 100) -(define x0-2d 0.0) -(define x1-2d 2.0) -(define y0-2d 0.0) -(define y1-2d 2.0) -(define t-final-2d 0.5) -(define cfl-2d 0.95) -(define init-func-2d `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 2.0] - [else 0.0])) - -;; Define (shallow) neural network hyperparameters for 2D. -(define neural-net-shallow-2d - (hash - 'max-trains 10000 ; maximum number of training steps: 10000 - 'width 64 ; number of neurons in each layer: 64 - 'depth 6 ; total number of layers: 6 - 'num-threads 12 ; number of threads to use in training: 12 - 'mini-size 100 ; size of training mini-batch: 100 - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D inviscid Burgers' equation using a shallow neural network. -(define code-inviscid-burgers-lax-train-2d - (train-lax-friedrichs-scalar-2d pde-inviscid-burgers-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax_train_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-train-2d))) - -;; Synthesize the code to train a Roe surrogate solver for the 2D inviscid Burgers' equation using a shallow neural network. -(define code-inviscid-burgers-roe-train-2d - (train-roe-scalar-2d pde-inviscid-burgers-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe_train_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-train-2d))) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-inviscid-burgers-lax-minmod-train-2d - (train-lax-friedrichs-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax_minmod_train_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-minmod-train-2d))) - -;; Synthesize the code to train a Roe surrogate solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-inviscid-burgers-roe-minmod-train-2d - (train-roe-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe_minmod_train_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-minmod-train-2d))) - -(display "2D inviscid Burgers' properties: \n\n") - -;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 2D inviscid Burgers' equation. -(define proof-inviscid-burgers-smooth-2d - (call-with-output-file "proofs/proof_inviscid_burgers_smooth_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-scalar-2d-smooth pde-inviscid-burgers-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_smooth_2d.rkt") - -;; Show the error bound (if applicable) on smooth solutions. -(display "Error bound (smooth solutions): ") -(display proof-inviscid-burgers-smooth-2d) -(display "\n") - -;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 2D inviscid Burgers' equation. -(define proof-inviscid-burgers-non-smooth-2d - (call-with-output-file "proofs/proof_inviscid_burgers_non_smooth_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-scalar-2d-non-smooth pde-inviscid-burgers-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_non_smooth_2d.rkt") - -;; Show the error bound (if applicable) on non-smooth solutions. -(display "Error bound (non-smooth solutions): ") -(display proof-inviscid-burgers-non-smooth-2d) -(display "\n") - -;; Synthesize the code to validate any first-order surrogate solver for the 2D inviscid Burgers' equation using a shallow neural network. -(define code-inviscid-burgers-validate-2d - (validate-scalar-2d pde-inviscid-burgers-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_validate_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-validate-2d))) - -;; Synthesize the code to validate any first-order surrogate solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-inviscid-burgers-minmod-validate-2d - (validate-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_minmod_validate_2d.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-minmod-validate-2d))) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/test_isothermal_euler_shallow.rkt b/provable-algorithms/neural_networks/test_isothermal_euler_shallow.rkt deleted file mode 100644 index 69000e2d..00000000 --- a/provable-algorithms/neural_networks/test_isothermal_euler_shallow.rkt +++ /dev/null @@ -1,480 +0,0 @@ -#lang racket - -(require "code_generator_core_training.rkt") -(require "code_generator_vector_training.rkt") -(require "code_generator_vector_training_2d.rkt") -(require "code_generator_vector_validation.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "code_generator_core_training.rkt")) -(provide (all-from-out "code_generator_vector_training.rkt")) -(provide (all-from-out "code_generator_vector_training_2d.rkt")) -(provide (all-from-out "code_generator_vector_validation.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D isothermal Euler equations (density and x-momentum components). -(define pde-system-isothermal-euler - (hash - 'name "isothermal-euler" - 'cons-exprs (list - `rho - `mom_x) ; conserved variables: density, x-momentum - 'flux-exprs (list - `mom_x - `(+ (/ (* mom_x mom_x) rho) (* rho vt vt))) ; flux vector - 'max-speed-exprs (list - `(abs (- (/ mom_x rho) vt)) - `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds - 'parameters (list - `(define vt 1.0)) ; thermal velocity: vt = 1.0 - )) - -;; Define simulation parameters. -(define nx 400) -(define x0 0.0) -(define x1 1.0) -(define t-final 0.1) -(define cfl 0.95) -(define init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))) - -;; Define (shallow) neural network hyperparameters. -(define neural-net-shallow - (hash - 'max-trains 10000 ; maximum number of training steps: 10000 - 'width 64 ; number of neurons in each layer: 64 - 'depth 6 ; total number of layers: 6 - 'num-threads 12 ; number of threads to use in training: 12 - 'mini-size 100 ; size of training mini-batch: 100 - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D isothermal Euler equations using a shallow neural network. -(define code-isothermal-euler-lax-train - (train-lax-friedrichs-vector2-1d pde-system-isothermal-euler neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_lax_train.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-lax-train))) - -;; Synthesize the code to train a Roe surrogate solver for the 1D isothermal Euler equations using a shallow neural network. -(define code-isothermal-euler-roe-train - (train-roe-vector2-1d pde-system-isothermal-euler neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_roe_train.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-roe-train))) - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-isothermal-euler-lax-minmod-train - (train-lax-friedrichs-vector2-1d-second-order pde-system-isothermal-euler limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_lax_minmod_train.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-lax-minmod-train))) - -;; Synthesize the code to train a Roe surrogate solver for the 1D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-isothermal-euler-roe-minmod-train - (train-roe-vector2-1d-second-order pde-system-isothermal-euler limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_roe_minmod_train.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-roe-minmod-train))) - -(display "1D isothermal Euler properties: \n\n") - -;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 1D isothermal Euler equations. -(define proof-isothermal-euler-smooth - (call-with-output-file "proofs/proof_isothermal_euler_smooth.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-vector2-1d-smooth pde-system-isothermal-euler neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_smooth.rkt") - -;; Show the error bounds (if applicable) on smooth solutions. -(display "Error bound on rho (smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-smooth 0) (list-ref proof-isothermal-euler-smooth 1))) -(display "\n") - -(display "Error bound on mom_x (smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-smooth 2) (list-ref proof-isothermal-euler-smooth 3))) -(display "\n") - -;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 1D isothermal Euler equations. -(define proof-isothermal-euler-non-smooth - (call-with-output-file "proofs/proof_isothermal_euler_non_smooth.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-vector2-1d-non-smooth pde-system-isothermal-euler neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_non_smooth.rkt") - -;; Show the error bounds (if applicable) on non-smooth solutions. -(display "Error bound on rho (non-smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-non-smooth 0) (list-ref proof-isothermal-euler-non-smooth 1))) -(display "\n") - -(display "Error bound on mom_x (non-smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-non-smooth 2) (list-ref proof-isothermal-euler-non-smooth 3))) -(display "\n\n\n") - -;; Synthesize the code to validate any first-order surrogate solver for the 1D isothermal Euler equations using a shallow neural network. -(define code-isothermal-euler-validate - (validate-vector2-1d pde-system-isothermal-euler neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_validate.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-validate))) - -;; Synthesize the code to validate any first-order surrogate solver for the 1D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-isothermal-euler-minmod-validate - (validate-vector2-1d-second-order pde-system-isothermal-euler limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_minmod_validate.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-minmod-validate))) - -;; Define the 2D isothermal Euler equations (density, x-momentum and y-momentum components). -(define pde-system-isothermal-euler-2d - (hash - 'name "isothermal-euler-2d" - 'cons-exprs (list - `rho - `mom_x - `mom_y) ; conserved variables: density, x-momentum, y-momentum - 'flux-exprs-x (list - `mom_x - `(+ (/ (* mom_x mom_x) rho) (* rho vt vt)) - `(* mom_y (/ mom_x rho))) ; x-flux vector - 'flux-exprs-y (list - `mom_y - `(* mom_x (/ mom_y rho)) - `(+ (/ (* mom_y mom_y) rho) (* rho vt vt))) ; y-flux vector - 'max-speed-exprs-x (list - `(abs (- (/ mom_x rho) vt)) - `(/ mom_x rho) - `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds (x-direction) - 'max-speed-exprs-y (list - `(abs (- (/ mom_y rho) vt)) - `(/ mom_y rho) - `(abs (+ (/ mom_y rho) vt))) ; local wave-speeds (y-direction) - 'parameters (list - `(define vt 1.0)) ; thermal velocity: vt = 1.0 - )) - -;; Define 2D simulation parameters. -(define nx-2d 50) -(define ny-2d 50) -(define x0-2d 0.0) -(define x1-2d 2.0) -(define y0-2d 0.0) -(define y1-2d 2.0) -(define t-final-2d 0.2) -(define cfl-2d 0.9) -(define init-funcs-2d (list - `(cond - [(> y 1.0) - (cond - [(< x 1.0) 0.5323] - [else 1.5])] - [else - (cond - [(< x 1.0) 0.138] - [else 0.5323])]) - `(cond - [(> y 1.0) - (cond - [(< x 1.0) 1.206] - [else 0.0])] - [else - (cond - [(< x 1.0) 1.206] - [else 0.0])]) - `(cond - [(> y 1.0) - (cond - [(< x 1.0) 0.0] - [else 0.0])] - [else - (cond - [(< x 1.0) 1.206] - [else 1.206])]))) - -;; Define (shallow) neural network hyperparameters for 2D. -(define neural-net-shallow-2d - (hash - 'max-trains 10000 ; maximum number of training steps: 10000 - 'width 64 ; number of neurons in each layer: 64 - 'depth 6 ; total number of layers: 6 - 'num-threads 12 ; number of threads to use in training: 12 - 'mini-size 100 ; size of training mini-batch: 100 - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D isothermal Euler equations using a shallow neural network. -(define code-isothermal-euler-lax-train-2d - (train-lax-friedrichs-vector3-2d pde-system-isothermal-euler-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_lax_train_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-lax-train-2d))) - -;; Synthesize the code to train a Roe surrogate solver for the 2D isothermal Euler equations using a shallow neural network. -(define code-isothermal-euler-roe-train-2d - (train-roe-vector3-2d pde-system-isothermal-euler-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_roe_train_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-roe-train-2d))) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-isothermal-euler-lax-minmod-train-2d - (train-lax-friedrichs-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_lax_minmod_train_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-lax-minmod-train-2d))) - -;; Synthesize the code to train a Roe surrogate solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-isothermal-euler-roe-minmod-train-2d - (train-roe-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_roe_minmod_train_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-roe-minmod-train-2d))) - -(display "2D isothermal Euler properties: \n\n") - -;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 2D isothermal Euler equations. -(define proof-isothermal-euler-smooth-2d - (call-with-output-file "proofs/proof_isothermal_euler_smooth_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-vector3-2d-smooth pde-system-isothermal-euler-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_smooth_2d.rkt") - -;; Show the error bounds (if applicable) on smooth solutions. -(display "Error bound on rho (smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-smooth-2d 0) (list-ref proof-isothermal-euler-smooth-2d 1) (list-ref proof-isothermal-euler-smooth-2d 2))) -(display "\n") - -(display "Error bound on mom_x (smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-smooth-2d 3) (list-ref proof-isothermal-euler-smooth-2d 4) (list-ref proof-isothermal-euler-smooth-2d 5))) -(display "\n") - -(display "Error bound on mom_y (smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-smooth-2d 6) (list-ref proof-isothermal-euler-smooth-2d 7) (list-ref proof-isothermal-euler-smooth-2d 8))) -(display "\n") - -;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 2D isothermal Euler equations. -(define proof-isothermal-euler-non-smooth-2d - (call-with-output-file "proofs/proof_isothermal_euler_non_smooth_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-vector3-2d-non-smooth pde-system-isothermal-euler-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_non_smooth_2d.rkt") - -;; Show the error bounds (if applicable) on non-smooth solutions. -(display "Error bound on rho (non-smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-non-smooth-2d 0) (list-ref proof-isothermal-euler-non-smooth-2d 1) (list-ref proof-isothermal-euler-non-smooth-2d 2))) -(display "\n") - -(display "Error bound on mom_x (non-smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-non-smooth-2d 3) (list-ref proof-isothermal-euler-non-smooth-2d 4) (list-ref proof-isothermal-euler-non-smooth-2d 5))) -(display "\n") - -(display "Error bound on mom_y (non-smooth solutions): ") -(display (max (list-ref proof-isothermal-euler-non-smooth-2d 6) (list-ref proof-isothermal-euler-non-smooth-2d 7) (list-ref proof-isothermal-euler-non-smooth-2d 8))) -(display "\n") - -;; Synthesize the code to validate any first-order surrogate solver for the 2D isothermal Euler equations using a shallow neural network. -(define code-isothermal-euler-validate-2d - (validate-vector3-2d pde-system-isothermal-euler-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_validate_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-validate-2d))) - -;; Synthesize the code to validate any first-order surrogate solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-isothermal-euler-minmod-validate-2d - (validate-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-funcs init-funcs-2d)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_minmod_validate_2d.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-minmod-validate-2d))) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/test_linear_advection_shallow.rkt b/provable-algorithms/neural_networks/test_linear_advection_shallow.rkt deleted file mode 100644 index c72dc05a..00000000 --- a/provable-algorithms/neural_networks/test_linear_advection_shallow.rkt +++ /dev/null @@ -1,405 +0,0 @@ -#lang racket - -(require "code_generator_core_training.rkt") -(require "code_generator_core_training_2d.rkt") -(require "code_generator_core_validation.rkt") -(require "prover_core.rkt") -(provide (all-from-out "code_generator_core_training.rkt")) -(provide (all-from-out "code_generator_core_training_2d.rkt")) -(provide (all-from-out "code_generator_core_validation.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D linear advection equation: du/dt + d(au)/dx = 0. -(define pde-linear-advection - (hash - 'name "linear-advection" - 'cons-expr `u ; conserved variable: u - 'flux-expr `(* a u) ; flux function: f(u) = a * u - 'max-speed-expr `(abs a) ; local wave-speed: alpha = |a| - 'parameters (list - `(define a 1.0)) ; advection speed: a = 1.0 - )) - -;; Define simulation parameters. -(define nx 400) -(define x0 0.0) -(define x1 2.0) -(define t-final 0.5) -(define cfl 0.95) -(define init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])) - -;; Define (shallow) neural network hyperparameters. -(define neural-net-shallow - (hash - 'max-trains 10000 ; maximum number of training steps: 10000 - 'width 64 ; number of neurons in each layer: 64 - 'depth 6 ; total number of layers: 6 - 'num-threads 12 ; number of threads to use in training: 12 - 'mini-size 100 ; size of training mini-batch: 100 - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D linear advection equation using a shallow neural network. -(define code-linear-advection-lax-train - (train-lax-friedrichs-scalar-1d pde-linear-advection neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax_train.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-train))) - -;; Synthesize the code to train a Roe surrogate solver for the 1D linear advection equation using a shallow neural network. -(define code-linear-advection-roe-train - (train-roe-scalar-1d pde-linear-advection neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe_train.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-train))) - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-linear-advection-lax-minmod-train - (train-lax-friedrichs-scalar-1d-second-order pde-linear-advection limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax_minmod_train.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-minmod-train))) - -;; Synthesize the code to train a Roe surrogate solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-linear-advection-roe-minmod-train - (train-roe-scalar-1d-second-order pde-linear-advection limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe_minmod_train.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-minmod-train))) - -(display "1D linear advection properties: \n\n") - -;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 1D linear advection equation. -(define proof-linear-advection-smooth - (call-with-output-file "proofs/proof_linear_advection_smooth.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-scalar-1d-smooth pde-linear-advection neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_smooth.rkt") - -;; Show the error bound (if applicable) on smooth solutions. -(display "Error bound (smooth solutions): ") -(display proof-linear-advection-smooth) -(display "\n") - -;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 1D linear advection equation. -(define proof-linear-advection-non-smooth - (call-with-output-file "proofs/proof_linear_advection_non_smooth.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-scalar-1d-non-smooth pde-linear-advection neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_non_smooth.rkt") - -;; Show the error bound (if applicable) on non-smooth solutions. -(display "Error bound (non-smooth solutions): ") -(display proof-linear-advection-non-smooth) -(display "\n\n\n") - -;; Synthesize the code to validate any first-order surrogate solver for the 1D linear advection equation using a shallow neural network. -(define code-linear-advection-validate - (validate-scalar-1d pde-linear-advection neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_validate.c" - #:exists 'replace - (lambda () - (display code-linear-advection-validate))) - -;; Synthesize the code to validate any first-order surrogate solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-linear-advection-minmod-validate - (validate-scalar-1d-second-order pde-linear-advection limiter-minmod neural-net-shallow - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_minmod_validate.c" - #:exists 'replace - (lambda () - (display code-linear-advection-minmod-validate))) - -;; Define the 2D linear advection equation: du/dt + d(au)/dx + d(bu)/dy = 0. -(define pde-linear-advection-2d - (hash - 'name "linear-advection-2d" - 'cons-expr `u ; conserved variable: u - 'flux-expr-x `(* a u) ; x-flux function: f(u) = a * u - 'flux-expr-y `(* b u) ; y-flux function: f(u) = b * u - 'max-speed-expr-x `(abs a) ; local x wave-speed: alpha_x = |a| - 'max-speed-expr-y `(abs b) ; local y wave-speed: alpha_y = |b| - 'parameters (list - `(define a 1.0) - `(define b 1.0)) ; advection speesd: a = 1.0, b = 1.0 - )) - -;; Define 2D simulation parameters. -(define nx-2d 100) -(define ny-2d 100) -(define x0-2d 0.0) -(define x1-2d 2.0) -(define y0-2d 0.0) -(define y1-2d 2.0) -(define t-final-2d 0.5) -(define cfl-2d 0.95) -(define init-func-2d `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 1.0] - [else 0.0])) - -;; Define (shallow) neural network hyperparameters for 2D. -(define neural-net-shallow-2d - (hash - 'max-trains 10000 ; maximum number of training steps: 10000 - 'width 64 ; number of neurons in each layer: 64 - 'depth 6 ; total number of layers: 6 - 'num-threads 12 ; number of threads to use in training: 12 - 'mini-size 100 ; size of training mini-batch: 100 - )) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D linear advection equation using a shallow neural network. -(define code-linear-advection-lax-train-2d - (train-lax-friedrichs-scalar-2d pde-linear-advection-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax_train_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-train-2d))) - -;; Synthesize the code to train a Roe surrogate solver for the 2D linear advection equation using a shallow neural network. -(define code-linear-advection-roe-train-2d - (train-roe-scalar-2d pde-linear-advection-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe_train_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-train-2d))) - -;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-linear-advection-lax-minmod-train-2d - (train-lax-friedrichs-scalar-2d-second-order pde-linear-advection-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax_minmod_train_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-minmod-train-2d))) - -;; Synthesize the code to train a Roe surrogate solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-linear-advection-roe-minmod-train-2d - (train-roe-scalar-2d-second-order pde-linear-advection-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe_minmod_train_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-minmod-train-2d))) - -(display "2D linear advection properties: \n\n") - -;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 2D linear advection equation. -(define proof-linear-advection-smooth-2d - (call-with-output-file "proofs/proof_linear_advection_smooth_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-scalar-2d-smooth pde-linear-advection-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_smooth_2d.rkt") - -;; Show the error bound (if applicable) on smooth solutions. -(display "Error bound (smooth solutions): ") -(display proof-linear-advection-smooth-2d) -(display "\n") - -;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 2D linear advection equation. -(define proof-linear-advection-non-smooth-2d - (call-with-output-file "proofs/proof_linear_advection_non_smooth_2d.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover.rkt\")\n\n") - (prove-scalar-2d-non-smooth pde-linear-advection-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_non_smooth_2d.rkt") - -;; Show the error bound (if applicable) on non-smooth solutions. -(display "Error bound (non-smooth solutions): ") -(display proof-linear-advection-non-smooth-2d) -(display "\n") - -;; Synthesize the code to validate any first-order surrogate solver for the 2D linear advection equation using a shallow neural network. -(define code-linear-advection-validate-2d - (validate-scalar-2d pde-linear-advection-2d neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_validate_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-validate-2d))) - -;; Synthesize the code to validate any first-order surrogate solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) -;; using a shallow neural network. -(define code-linear-advection-minmod-validate-2d - (validate-scalar-2d-second-order pde-linear-advection-2d limiter-minmod neural-net-shallow-2d - #:nx nx-2d - #:ny ny-2d - #:x0 x0-2d - #:x1 x1-2d - #:y0 y0-2d - #:y1 y1-2d - #:t-final t-final-2d - #:cfl cfl-2d - #:init-func init-func-2d)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_minmod_validate_2d.c" - #:exists 'replace - (lambda () - (display code-linear-advection-minmod-validate-2d))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/prover_core.rkt b/provable-algorithms/prover_core.rkt similarity index 69% rename from provable-algorithms/finite_volume/prover_core.rkt rename to provable-algorithms/prover_core.rkt index 23c39345..a8dd71f9 100644 --- a/provable-algorithms/finite_volume/prover_core.rkt +++ b/provable-algorithms/prover_core.rkt @@ -19,13 +19,8 @@ prove-lax-friedrichs-scalar-1d-hyperbolicity prove-lax-friedrichs-scalar-1d-cfl-stability prove-lax-friedrichs-scalar-1d-local-lipschitz - prove-lax-friedrichs-scalar-2d-hyperbolicity - prove-lax-friedrichs-scalar-2d-cfl-stability - prove-lax-friedrichs-scalar-2d-local-lipschitz prove-roe-scalar-1d-hyperbolicity prove-roe-scalar-1d-flux-conservation - prove-roe-scalar-2d-hyperbolicity - prove-roe-scalar-2d-flux-conservation prove-flux-limiter-symmetry prove-flux-limiter-tvd) @@ -695,209 +690,6 @@ out) (trace prove-lax-friedrichs-scalar-1d-local-lipschitz) -;; ---------------------------------------------------------------------------------------- -;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 2D Scalar PDE -;; ---------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-scalar-2d-hyperbolicity pde - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 2D scalar PDE specified by `pde`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the derivatives of the flux function are real (otherwise, return false). - [(not (is-real (symbolic-simp (symbolic-diff flux-expr-x cons-expr)) (list cons-expr) parameters)) #f] - [(not (is-real (symbolic-simp (symbolic-diff flux-expr-y cons-expr)) (list cons-expr) parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - - out) -(trace prove-lax-friedrichs-scalar-2d-hyperbolicity) - -;; ---------------------------------------------------------------------------------------- -;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for 2D Scalar PDE -;; ---------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-scalar-2d-cfl-stability pde - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 2D scalar PDE specified by `pde`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) - (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the absolute value sof the derivatives of the flux function are symbolically equivalent to the maximum wave-speed estimates (otherwise, return false). - [(not (equal? (symbolic-simp `(abs ,(symbolic-diff flux-expr-x cons-expr))) - (symbolic-simp max-speed-expr-x))) #f] - [(not (equal? (symbolic-simp `(abs ,(symbolic-diff flux-expr-y cons-expr))) - (symbolic-simp max-speed-expr-y))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - - out) -(trace prove-lax-friedrichs-scalar-2d-cfl-stability) - -;; ------------------------------------------------------------------------------------------------------------------------------------ -;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 2D Scalar PDE -;; ------------------------------------------------------------------------------------------------------------------------------------ -(define (prove-lax-friedrichs-scalar-2d-local-lipschitz pde - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 2D scalar PDE specified by `pde`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace is-non-negative) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the flux functions are convex, i.e. that the second derivatives of the flux functions are strictly non-negative (otherwise, return false). - [(let ([deriv (symbolic-simp (symbolic-diff (symbolic-simp (symbolic-diff flux-expr-x cons-expr)) cons-expr))]) - (not (is-non-negative deriv parameters))) #f] - [(let ([deriv (symbolic-simp (symbolic-diff (symbolic-simp (symbolic-diff flux-expr-y cons-expr)) cons-expr))]) - (not (is-non-negative deriv parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace is-non-negative) - - out) -(trace prove-lax-friedrichs-scalar-2d-local-lipschitz) - ;; ------------------------------------------------------------------------- ;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Scalar PDE ;; ------------------------------------------------------------------------- @@ -1035,163 +827,6 @@ out) (trace prove-roe-scalar-1d-flux-conservation) -;; ------------------------------------------------------------------------- -;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 2D Scalar PDE -;; ------------------------------------------------------------------------- -(define (prove-roe-scalar-2d-hyperbolicity pde - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Prove that the Roe finite-volume method preserves hyperbolicity for the 2D scalar PDE specified by `pde`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-roe-function) - (trace flux-deriv-replace) - - (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) - (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the Roe functions are real (otherwise, return false). - [(not (is-real (symbolic-roe-function flux-deriv-x cons-expr) (list - (string->symbol (string-append (symbol->string cons-expr) "L")) - (string->symbol (string-append (symbol->string cons-expr) "R"))) parameters)) #f] - [(not (is-real (symbolic-roe-function flux-deriv-y cons-expr) (list - (string->symbol (string-append (symbol->string cons-expr) "L")) - (string->symbol (string-append (symbol->string cons-expr) "R"))) parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-roe-function) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-scalar-2d-hyperbolicity) - -;; ----------------------------------------------------------------------------------------------- -;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 2D Scalar PDE -;; ----------------------------------------------------------------------------------------------- -(define (prove-roe-scalar-2d-flux-conservation pde - #:nx [nx 200] - #:ny [ny 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:y0 [y0 0.0] - #:y1 [y1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] - [else 0.0])]) - "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 2D scalar PDE specified by `pde`. - - `nx`, `ny` : Number of spatial cells in each coordinate direction. - - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr-x (hash-ref pde 'flux-expr-x)) - (define flux-expr-y (hash-ref pde 'flux-expr-y)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-roe-function) - (trace flux-deriv-replace) - - (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) - (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) - - (define roe-jump-x (symbolic-simp `(* ,(symbolic-roe-function flux-deriv-x cons-expr) (- ,(string->symbol (string-append (symbol->string cons-expr) "L")) - ,(string->symbol (string-append (symbol->string cons-expr) "R")))))) - (define roe-jump-y (symbolic-simp `(* ,(symbolic-roe-function flux-deriv-y cons-expr) (- ,(string->symbol (string-append (symbol->string cons-expr) "L")) - ,(string->symbol (string-append (symbol->string cons-expr) "R")))))) - (define flux-jump-x (symbolic-simp `(- ,(flux-deriv-replace flux-expr-x cons-expr (string->symbol (string-append (symbol->string cons-expr) "L"))) - ,(flux-deriv-replace flux-expr-x cons-expr (string->symbol (string-append (symbol->string cons-expr) "R")))))) - (define flux-jump-y (symbolic-simp `(- ,(flux-deriv-replace flux-expr-y cons-expr (string->symbol (string-append (symbol->string cons-expr) "L"))) - ,(flux-deriv-replace flux-expr-y cons-expr (string->symbol (string-append (symbol->string cons-expr) "R")))))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - [(or (< ny 1) (>= y0 y1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the jumps in the flux functions are equal to the product of the Roe functions and the jumps in the conserved variable (otherwise, return false). - [(not (equal? roe-jump-x flux-jump-x)) #f] - [(not (equal? roe-jump-y flux-jump-y)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-roe-function) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-scalar-2d-flux-conservation) - ;; ------------------------------------------------- ;; Prove symmetry for a High-Resolution Flux Limiter ;; ------------------------------------------------- diff --git a/provable-algorithms/prover_vector.rkt b/provable-algorithms/prover_vector.rkt new file mode 100644 index 00000000..1b0006a6 --- /dev/null +++ b/provable-algorithms/prover_vector.rkt @@ -0,0 +1,1052 @@ +#lang racket + +(require racket/trace) +(current-prefix-in " ") +(current-prefix-out " ") + +(provide symbolic-jacobian + symbolic-gradient + symbolic-hessian + symbolic-eigvals2 + is-non-zero + are-distinct + symbolic-roe-matrix + prove-lax-friedrichs-vector2-1d-hyperbolicity + prove-lax-friedrichs-vector2-1d-strict-hyperbolicity + prove-lax-friedrichs-vector2-1d-cfl-stability + prove-lax-friedrichs-vector2-1d-local-lipschitz + prove-roe-vector2-1d-hyperbolicity + prove-roe-vector2-1d-strict-hyperbolicity + prove-roe-vector2-1d-flux-conservation) + +;; Lightweight symbolic differentiator (differentiates expr with respect to var). +(define (symbolic-diff expr var) + (match expr + ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. + [(? symbol? symb) (cond + [(eq? symb var) 1.0] + [else 0.0])] + + ;; If expr is a numerical constant, then it differentiates to 0. + [(? number?) 0.0] + + ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] + ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] + + ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. + [`(* . ,terms) + (define n (length terms)) + (define (mult xs) (cons '* xs)) ; Multiplication helper function. + + ((lambda (sums) (cond + [(null? (cdr sums)) (car sums)] + [else (cons '+ sums)])) + (let loop ([i 0]) + (cond + [(= i n) `()] + [else + ;; Evaluate the derivative of the i-th term in the product. + (let ([di (symbolic-diff (list-ref terms i) var)]) + (cons + (mult (for/list ([j (in-range n)]) + (cond + [(= j i) di] + [else (list-ref terms j)]))) + (loop (add1 i))))])))] + + ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. + [`(/ ,x ,y) + `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] + + ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). + [`(abs ,arg) + `(* (sgn ,arg) ,(symbolic-diff arg var))] + + ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. + [`(sgn ,arg) 0.0] + + ;; Otherwise, return false. + [else #f])) + +;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). +(define (symbolic-simp-rule expr) + (match expr + ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. + [`(+ 0 ,x) `,x] + [`(+ 0.0 ,x) `,x] + [`(+ -0.0 ,x) `,x] + + ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. + [`(* 1 ,x) `,x] + [`(* 1.0 ,x) `,x] + + ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. + [`(* 0 ,x) 0] + [`(* 0.0 ,x) 0.0] + [`(* -0.0 ,x) 0.0] + + ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. + [`(- ,x 0) `,x] + [`(- ,x 0.0) `,x] + [`(- ,x -0.0) `,x] + + ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). + [`(- 0 ,x) `(* -1 ,x)] + [`(- 0.0 ,x) `(* -1.0 ,x)] + [`(- -0.0 ,x) `(* -1.0 ,x)] + + ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. + [`(/ ,x 1) `,x] + [`(/ ,x 1.0) `,x] + + ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). + [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] + [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] + + ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). + [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] + [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] + + ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. + [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] + [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] + + ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients + [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] + [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] + + ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. + [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] + + ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). + [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] + + ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). + [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] + + ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). + [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] + + ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). + [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] + + ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). + [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] + + ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). + [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] + ;; Likewise for differences. + [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] + + ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. + [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] + + ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). + [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] + + ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). + [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] + + ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. + [`(sqrt (* ,x ,x)) `,x] + [`(* (sqrt ,x) (sqrt ,x)) `,x] + + ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). + [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] + ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). + [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] + + ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). + [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] + + ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. + [`(sqrt ,(and x (? number?))) (sqrt x)] + + ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. + [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] + [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] + + ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., + [`(abs ,(and x (? number?))) (abs x)] + + ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). + [`(abs (* -1 ,x)) `(abs ,x)] + [`(abs (* -1.0 ,x)) `(abs ,x)] + + ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). + [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] + [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + + ;; If expr is of the form (x + x), thens implify to (2.0 * x). + [`(+ ,x ,x) `(* 2.0 ,x)] + + ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). + [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] + + ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). + [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] + + ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). + [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] + + ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). + [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] + + ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). + [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] + [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] + + ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). + [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] + + ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). + [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] + + ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). + [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] + [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + + ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). + [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] + + ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). + [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] + + ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. + [`(/ 0 ,x) 0] + [`(/ 0.0 ,x) 0.0] + [`(/ -0.0 ,x) 0.0] + + ;; If expr is of the form (x / x), then simplify to 1.0 + [`(/ ,x ,x) 1.0] + + ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). + [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] + ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). + [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] + + ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). + [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] + + ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). + [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] + [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] + + ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). + [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] + [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] + + ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for differences. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. + [`(* . ,terms) + `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for quotients. + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. + [`(sqrt ,arg) + `(sqrt ,(symbolic-simp-rule arg))] + + ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. + [`(abs ,arg) + `(abs ,(symbolic-simp-rule arg))] + + ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). + [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] + [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] + + ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). + [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). + [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] + + ;; Otherwise, return the expression. + [else expr])) + +;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). +(define (symbolic-simp expr) + (define simp-expr (symbolic-simp-rule expr)) + + (cond + [(equal? simp-expr expr) expr] + [else (symbolic-simp simp-expr)])) + +;; Recursively determine whether an expression corresponds to a real number. +(define (is-real expr cons-vars parameters) + (match expr + ;; Real numbers are trivially real. + [(? real?) #t] + + ;; Conserved variables are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (not (equal? (member arg cons-vars) #f)))) #t] + + ;; Simulation parameters are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (equal? arg (list-ref parameter 1))) parameters)))) #t] + + ;; The outcome of a conditional operation is real if both branches yield real numbers. + [`(cond + [,cond1 ,expr1] + [else ,expr2]) + (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] + + ;; The sum, difference, product, or quotient of two real numbers is always real. + [`(+ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(- . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(* . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(/ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + + ;; Otherwise, assume false. + [else #f])) + +;; Recursively replace conserved variable expressions within the flux derivative expression (for Roe functions). +(define (flux-deriv-replace flux-deriv-expr cons-expr new-cons-expr) + (match flux-deriv-expr + ;; If the flux derivative expression is just the conserved variable expression, then return the new conserved variable expression. + [(? (lambda (arg) + (equal? arg cons-expr))) new-cons-expr] + + ;; If the flux derivative expression consists of a sum, difference, product, or quotient, then recursively apply replacement to each term. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + [`(- . ,terms) + `(- ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + [`(* . ,terms) + `(* ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + + ;; Otherwise, return the flux derivative expression. + [else flux-deriv-expr])) + +;; Compute symbolic Jacobian matrix by mapping symbolic differentiation over exprs with respect to vars. +(define (symbolic-jacobian exprs vars) + (map (lambda (expr) + (map (lambda (var) + (symbolic-simp (symbolic-diff expr var))) + vars)) + exprs)) + +;; Compute symbolic gradient vector by applying symbolic differentiation to expr, mapped over vars. +(define (symbolic-gradient expr vars) + (map (lambda (var) + (symbolic-simp (symbolic-diff expr var))) + vars)) + +;; Compute symbolic Hessian matrix by computing the symbolic Jacobian matrix of the symbolic gradient vector of expr with respect to vars. +(define (symbolic-hessian expr vars) + (symbolic-jacobian (symbolic-gradient expr vars) vars)) + +;; Compute symbolic eigenvalues of a 2x2 symbolic matrix via explicit solution of the characteristic polynomial. +(define (symbolic-eigvals2 matrix) + (let ([a (list-ref (list-ref matrix 0) 0)] + [b (list-ref (list-ref matrix 0) 1)] + [c (list-ref (list-ref matrix 1) 0)] + [d (list-ref (list-ref matrix 1) 1)]) + (cond + ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a pair of zeroes. + [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0)) (list 0.0 0.0)] + + ;; Otherwise, calculate the eigenvalues explicitly. + [else (list `(* 0.5 (+ (- ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)) + `(* 0.5 (+ (+ ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)))]))) + +;; Determine whether an expression is non-zero. +(define (is-non-zero expr parameters) + (match expr + ;; A non-zero number is, trivially, non-zero. + [(? (lambda (arg) + (and (number? arg) (not (equal? arg 0)) (not (equal? arg 0.0))))) #t] + + ;; Simulation parameters that are non-zero are, trivially, non-zero. + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (and (equal? arg (list-ref parameter 1)) + (or (not (equal? (list-ref parameter 2) 0)) + (not (equal? (list-ref parameter 2) 0.0))))) parameters)))) #t] + + ;; The product of two non-zero numbers is always non-zero. + [`(* ,x ,y) (and (is-non-zero x parameters) (is-non-zero y parameters))] + + ;; Otherwise, assume false. + [else #f])) + +;; Recursively determine whether two expressions are distinct. +(define (are-distinct expr parameters) + (match expr + ;; Two numbers that are unequal are, trivially, distinct. + [(? (lambda (arg) + (and (number? (list-ref arg 0)) (number? (list-ref arg 1)) (not (equal? (list-ref arg 0) (list-ref arg 1)))))) #t] + + ;; Expressions of the form (expr, -expr) or (-expr, expr) are distinct, so long as expr is non-zero. + [`(,x (* -1 ,x)) (is-non-zero x parameters)] + [`(,x (* -1.0 ,x)) (is-non-zero x parameters)] + [`((* -1 ,x) ,x) (is-non-zero x parameters)] + [`((* -1.0 ,x) ,x) (is-non-zero x parameters)] + + ;; Expressions of the form ((x + y), (x - y)) or ((x - y), (x + y)) are distinct, so long as y is non-zero. + [`((+ ,x ,y) (- ,x ,y)) (is-non-zero y parameters)] + [`((- ,x ,y) (+ ,x ,y)) (is-non-zero y parameters)] + + ;; Otherwise, assume false. + [else #f])) + +;; Compute the symbolic Roe matrix (averaged flux Jacobian). +(define (symbolic-roe-matrix flux-jacobian cons-exprs) + (map (lambda (row) + (map (lambda (column) + (symbolic-simp `(+ (* 0.5 ,(flux-deriv-replace (flux-deriv-replace column (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")))) + (* 0.5 ,(flux-deriv-replace (flux-deriv-replace column (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))))) + row)) + flux-jacobian)) + +;; Determine whether an expression is non-negative. +(define (is-non-negative expr parameters) + (match expr + ;; A non-negative number is, trivially, non-negative. + [(? (lambda (arg) + (and (number? arg) (or (>= arg 0) (>= arg 0.0))))) #t] + + ;; Simulation parameters that are non-negative are, trivially, non-negative. + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (and (equal? arg (list-ref parameter 1)) + (or (>= (list-ref parameter 2) 0) + (>= (list-ref parameter 2) 0.0)))) parameters)))) #t] + + ;; The sum, product, or quotient of two non-negative numbers is always non-negative. + [`(+ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] + [`(* ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] + [`(/ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] + + ;; Otherwise, assume false. + [else #f])) + +;; ------------------------------------------------------------------------------------------------------------- +;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + + (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define flux-eigvals-simp (list + (symbolic-simp (list-ref flux-eigvals 0)) + (symbolic-simp (list-ref flux-eigvals 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the flux Jacobian are all real (otherwise, return false). + [(or (not (is-real (list-ref flux-eigvals-simp 0) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp 1) cons-exprs parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + + out) +(trace prove-lax-friedrichs-vector2-1d-hyperbolicity) + +;; -------------------------------------------------------------------------------------------------------------------- +;; Prove strict hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; -------------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Lax-Friedrichs finite-difference method preserves strict hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + (trace is-non-zero) + (trace are-distinct) + + (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define flux-eigvals-simp (list + (symbolic-simp (list-ref flux-eigvals 0)) + (symbolic-simp (list-ref flux-eigvals 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the flux Jacobian are all real (otherwise, return false). + [(or (not (is-real (list-ref flux-eigvals-simp 0) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the flux Jacobian are all distinct (otherwise, return false). + [(not (are-distinct flux-eigvals-simp parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + (untrace is-non-zero) + (untrace are-distinct) + + out) +(trace prove-lax-friedrichs-vector2-1d-strict-hyperbolicity) + +;; ------------------------------------------------------------------------------------------------------------- +;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + + (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define max-speed-exprs-simp (list + (symbolic-simp (list-ref max-speed-exprs 0)) + (symbolic-simp (list-ref max-speed-exprs 1)))) + (define flux-eigvals-simp (list + (symbolic-simp `(abs ,(list-ref flux-eigvals 0))) + (symbolic-simp `(abs ,(list-ref flux-eigvals 1))))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the absolute eigenvalues of the flux Jacobian are symbolically equivalent to the maximum wave-speed estimates (otherwise, return false). + [(or (equal? (member (list-ref flux-eigvals-simp 0) max-speed-exprs-simp) #f) + (equal? (member (list-ref flux-eigvals-simp 1) max-speed-exprs-simp) #f)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + + out) +(trace prove-lax-friedrichs-vector2-1d-cfl-stability) + +;; --------------------------------------------------------------------------------------------------------------------------------------------------------- +;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; --------------------------------------------------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + (trace symbolic-gradient) + (trace symbolic-hessian) + (trace is-non-negative) + + (define hessian-mats (list + (symbolic-hessian (list-ref flux-exprs 0) cons-exprs) + (symbolic-hessian (list-ref flux-exprs 1) cons-exprs))) + (define hessian-eigvals (list + (symbolic-eigvals2 (list-ref hessian-mats 0)) + (symbolic-eigvals2 (list-ref hessian-mats 1)))) + (define hessian-eigvals-simp (list + (symbolic-simp (list-ref (list-ref hessian-eigvals 0) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals 0) 1)) + (symbolic-simp (list-ref (list-ref hessian-eigvals 1) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals 1) 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the flux function is convex, i.e. that the Hessian matrix for each flux component is positive semidefinite (otherwise, return false). + [(or (not (is-non-negative (list-ref hessian-eigvals-simp 0) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp 1) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp 2) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp 3) parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + (untrace symbolic-gradient) + (untrace symbolic-hessian) + (untrace is-non-negative) + + out) +(trace prove-lax-friedrichs-vector2-1d-local-lipschitz) + +;; ---------------------------------------------------------------------------------------------- +;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; ---------------------------------------------------------------------------------------------- +(define (prove-roe-vector2-1d-hyperbolicity pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Roe finite-volume method preserves hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + (trace symbolic-roe-matrix) + (trace flux-deriv-replace) + + (define roe-matrix-eigvals (symbolic-eigvals2 (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs))) + (define roe-matrix-eigvals-simp (list + (symbolic-simp (list-ref roe-matrix-eigvals 0)) + (symbolic-simp (list-ref roe-matrix-eigvals 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the Roe matrix are all real (otherwise, return false). + [(or (not (is-real (list-ref roe-matrix-eigvals-simp 0) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters)) + (not (is-real (list-ref roe-matrix-eigvals-simp 1) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + (untrace symbolic-roe-matrix) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-vector2-1d-hyperbolicity) + +;; ----------------------------------------------------------------------------------------------------- +;; Prove strict hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; ----------------------------------------------------------------------------------------------------- +(define (prove-roe-vector2-1d-strict-hyperbolicity pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Roe finite-volume method preserves strict hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + (trace symbolic-roe-matrix) + (trace flux-deriv-replace) + (trace is-non-zero) + (trace are-distinct) + + (define roe-matrix-eigvals (symbolic-eigvals2 (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs))) + (define roe-matrix-eigvals-simp (list + (symbolic-simp (list-ref roe-matrix-eigvals 0)) + (symbolic-simp (list-ref roe-matrix-eigvals 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the Roe matrix are all real (otherwise, return false). + [(or (not (is-real (list-ref roe-matrix-eigvals-simp 0) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters)) + (not (is-real (list-ref roe-matrix-eigvals-simp 1) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters))) #f] + + ;; Check whether the eigenvalues of the Roe matrix are all distinct (otherwise, return false). + [(not (are-distinct roe-matrix-eigvals-simp parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + (untrace symbolic-roe-matrix) + (untrace flux-deriv-replace) + (untrace is-non-zero) + (untrace are-distinct) + + out) +(trace prove-roe-vector2-1d-strict-hyperbolicity) + +;; -------------------------------------------------------------------------------------------------------------------- +;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; -------------------------------------------------------------------------------------------------------------------- +(define (prove-roe-vector2-1d-flux-conservation pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-roe-matrix) + (trace flux-deriv-replace) + + (define roe-matrix (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs)) + (define cons-jump (list (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")))) + (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")))))) + + (define roe-jump (list (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix 0) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix 0) 1) ,(list-ref cons-jump 1)))) + (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix 1) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix 1) 1) ,(list-ref cons-jump 1)))))) + (define flux-jump (list (symbolic-simp `(- ,(flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs 0) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + ,(flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs 0) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))) + (symbolic-simp `(- ,(flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs 1) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + ,(flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs 1) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the jump in the flux vector is equal to the product of the Roe matrix and the jump in the conserved variable vector (otherwise, return false). + [(or (not (equal? (list-ref roe-jump 0) (list-ref flux-jump 0))) + (not (equal? (list-ref roe-jump 1) (list-ref flux-jump 1)))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-roe-matrix) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-vector2-1d-flux-conservation) \ No newline at end of file diff --git a/provable-algorithms/test_inviscid_burgers.rkt b/provable-algorithms/test_inviscid_burgers.rkt new file mode 100644 index 00000000..b2400d51 --- /dev/null +++ b/provable-algorithms/test_inviscid_burgers.rkt @@ -0,0 +1,217 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "prover_core.rkt") +(provide (all-from-out "code_generator_core.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D inviscid Burgers' equation: du/dt + u du/dx = 0. +(define pde-inviscid-burgers + (hash + 'name "inviscid-burgers" + 'cons-expr `u ; conserved variable: u + 'flux-expr `(* 0.5 u u) ; flux function: f(u) = 0.5 * u^2 + 'max-speed-expr `(abs u) ; local wave-speed: alpha = |u| + 'parameters `() + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.0) +(define x1 1.0) +(define t-final 0.5) +(define cfl 0.95) +(define init-func `(cond + [(< x 0.0) 1.0] + [else 0.0])) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-lax + (generate-lax-friedrichs-scalar-1d pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-hyperbolicity + (call-with-output-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-inviscid-burgers-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-cfl-stability + (call-with-output-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-cfl-stability pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-inviscid-burgers-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-local-lipschitz + (call-with-output-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-inviscid-burgers-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-roe + (generate-roe-scalar-1d pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-roe-hyperbolicity + (call-with-output-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-hyperbolicity pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-inviscid-burgers-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-roe-flux-conservation + (call-with-output-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-flux-conservation pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-inviscid-burgers-roe-flux-conservation) +(display "\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-inviscid-burgers-lax-minmod + (generate-lax-friedrichs-scalar-1d-second-order pde-inviscid-burgers limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-inviscid-burgers-roe-minmod + (generate-roe-scalar-1d-second-order pde-inviscid-burgers limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_isothermal_euler_mom_x.rkt b/provable-algorithms/test_isothermal_euler_mom_x.rkt similarity index 100% rename from provable-algorithms/finite_volume/test_isothermal_euler_mom_x.rkt rename to provable-algorithms/test_isothermal_euler_mom_x.rkt diff --git a/provable-algorithms/finite_volume/test_isothermal_euler_mom_yz.rkt b/provable-algorithms/test_isothermal_euler_mom_yz.rkt similarity index 100% rename from provable-algorithms/finite_volume/test_isothermal_euler_mom_yz.rkt rename to provable-algorithms/test_isothermal_euler_mom_yz.rkt diff --git a/provable-algorithms/finite_volume/test_limiters.rkt b/provable-algorithms/test_limiters.rkt similarity index 100% rename from provable-algorithms/finite_volume/test_limiters.rkt rename to provable-algorithms/test_limiters.rkt diff --git a/provable-algorithms/test_linear_advection.rkt b/provable-algorithms/test_linear_advection.rkt new file mode 100644 index 00000000..56817a1b --- /dev/null +++ b/provable-algorithms/test_linear_advection.rkt @@ -0,0 +1,218 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "prover_core.rkt") +(provide (all-from-out "code_generator_core.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D linear advection equation: du/dt + d(au)/dx = 0. +(define pde-linear-advection + (hash + 'name "linear-advection" + 'cons-expr `u ; conserved variable: u + 'flux-expr `(* a u) ; flux function: f(u) = a * u + 'max-speed-expr `(abs a) ; local wave-speed: alpha = |a| + 'parameters (list + `(define a 1.0)) ; advection speed: a = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 0.0) +(define x1 2.0) +(define t-final 0.5) +(define cfl 0.95) +(define init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D linear advection equation. +(define code-linear-advection-lax + (generate-lax-friedrichs-scalar-1d pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D linear advection equation. +(define proof-linear-advection-lax-hyperbolicity + (call-with-output-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-linear-advection-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D linear advection equation. +(define proof-linear-advection-lax-cfl-stability + (call-with-output-file "proofs/proof_linear_advection_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-cfl-stability pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-linear-advection-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D linear advection equation. +(define proof-linear-advection-lax-local-lipschitz + (call-with-output-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-linear-advection-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D linear advection equation. +(define code-linear-advection-roe + (generate-roe-scalar-1d pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D linear advection equation. +(define proof-linear-advection-roe-hyperbolicity + (call-with-output-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-hyperbolicity pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-linear-advection-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D linear advection equation. +(define proof-linear-advection-roe-flux-conservation + (call-with-output-file "proofs/proof_linear_advection_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-flux-conservation pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-linear-advection-roe-flux-conservation) +(display "\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-linear-advection-lax-minmod + (generate-lax-friedrichs-scalar-1d-second-order pde-linear-advection limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-linear-advection-roe-minmod + (generate-roe-scalar-1d-second-order pde-linear-advection limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_maxwell_1d_Bx_psi.rkt b/provable-algorithms/test_maxwell_1d_Bx_psi.rkt similarity index 100% rename from provable-algorithms/finite_volume/test_maxwell_1d_Bx_psi.rkt rename to provable-algorithms/test_maxwell_1d_Bx_psi.rkt diff --git a/provable-algorithms/finite_volume/test_maxwell_1d_Ex_phi.rkt b/provable-algorithms/test_maxwell_1d_Ex_phi.rkt similarity index 100% rename from provable-algorithms/finite_volume/test_maxwell_1d_Ex_phi.rkt rename to provable-algorithms/test_maxwell_1d_Ex_phi.rkt diff --git a/provable-algorithms/finite_volume/test_maxwell_1d_Ey_Bz.rkt b/provable-algorithms/test_maxwell_1d_Ey_Bz.rkt similarity index 100% rename from provable-algorithms/finite_volume/test_maxwell_1d_Ey_Bz.rkt rename to provable-algorithms/test_maxwell_1d_Ey_Bz.rkt diff --git a/provable-algorithms/finite_volume/test_maxwell_1d_Ez_By.rkt b/provable-algorithms/test_maxwell_1d_Ez_By.rkt similarity index 100% rename from provable-algorithms/finite_volume/test_maxwell_1d_Ez_By.rkt rename to provable-algorithms/test_maxwell_1d_Ez_By.rkt From e28bd60d16a1814424bad45b76f90cf722d5e383 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Fri, 17 Apr 2026 18:30:57 -0400 Subject: [PATCH 54/66] let's just keep the minimal alfven wave fix for now, the 2x2v and 1x2v cases are not checked yet. --- .../gk_collisionless_flux-surf-conf.mac | 32 +------- .../gk_collisionless_flux-surf-vpar.mac | 75 +++++-------------- 2 files changed, 20 insertions(+), 87 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index 4ee4a55f..c80e7d8e 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -203,32 +203,6 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ), /* It will be used to compute the contribution as ∇ x (A b) = ∇A x b + A ∇ x b */ - /* Try a version where we work with expansion of ∇A dH/dvpar = m vpar ∇A */ - dH_dvpar_e : diff(hamil_e,varsP[vpardim]), - mvpargradA_e : makelist(0, i, 1, cdim), - apar_e : doExpand1(apar,bC), - if em = true then ( - for i : 1 thru cdim do ( - dA_dx_e_ : diff(apar_e*rdx2vec[i],varsP[i]), - mvpargradA_e_ : dA_dx_e_*m_*vmap_e[1], - mvpargradA_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,mvpargradA_e_)), - printf(fh, " double mvpargradA_~a[~a] = {0.}; ~%", i, numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - mvpargradACvar : eval_string(sconcat("mvpargradA_",i)), - writeCExprsNoExpand1(mvpargradACvar, gcfac(float(expand(subst(replaceList, mvpargradA_c))))), - printf(fh, "~%"), - flush_output(fh), - mvpargradANoZero_c : makelistNoZeros1(mvpargradA_c, mvpargradACvar), - mvpargradA_e[i] : doExpand(mvpargradANoZero_c, bSurf) - ) - ), - - /* Now eval at nodes the ∇A dH/dvpar expansion */ - mvpargradA_nodes : makelist(0, i, 1, cdim), - for i : 1 thru cdim do ( - mvpargradA_nodes[i] : float(evAtNodes(mvpargradA_e[i],surfNodes,surfIntVars)) - ), - /* Now calculate flux at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", length(bSurf)*(surfDir-1)), @@ -315,13 +289,13 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* + 1/m ∇A x b/B . ∇ψ dH/dvpar */ if cdim = 3 then ( if surfDir = 1 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]); ~%", mvpargradA_nodes[2][j1index], mvpargradA_nodes[3][j1index]) + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index], vpar0index) ), if surfDir = 2 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]); ~%", mvpargradA_nodes[3][j1index], mvpargradA_nodes[1][j1index]) + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index], vpar0index) ), if surfDir = 3 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]); ~%", mvpargradA_nodes[1][j1index], mvpargradA_nodes[2][j1index]) + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index], vpar0index) ) ), /* in 2D, we take the first and last component of the 3D cross product, setting d/dy = 0.*/ diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 80b12907..a5a95dc0 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -178,75 +178,33 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b dH_dz : dH_dz_nodes[3], dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), dA_dy : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)), - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[3],varsP[3]),surfNodes,surfIntVars)) + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[3],varsP[3]),surfNodes,surfIntVars)), + gradHxgradA : [ + dH_dy*dA_dz - dH_dz*dA_dy, + dH_dz*dA_dx - dH_dx*dA_dz, + dH_dx*dA_dy - dH_dy*dA_dx + ] ) else if cdim = 2 then ( dH_dx : dH_dz_nodes[1], dH_dy : 0, dH_dz : dH_dz_nodes[2], dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), dA_dy : 0, - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)) + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)), + gradHxgradA : [ + dH_dy*dA_dz - dH_dz*dA_dy, + dH_dx*dA_dy - dH_dy*dA_dx + ] ) else if cdim = 1 then ( dH_dx : 0, dH_dy : 0, dH_dz : dH_dz_nodes[1], dA_dx : 0, dA_dy : 0, - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)) - ), - gradHxgradA : [ - dH_dy*dA_dz - dH_dz*dA_dy, - dH_dz*dA_dx - dH_dx*dA_dz, - dH_dx*dA_dy - dH_dy*dA_dx - ], - - /* Work with expansions to the last point before evAtNodes */ - if cdim = 3 then ( - dH_dx_e : diff(hamil_e*rdx2vec[1],varsP[1]), - dH_dy_e : diff(hamil_e*rdx2vec[2],varsP[2]), - dH_dz_e : diff(hamil_e*rdx2vec[3],varsP[3]), - dA_dx_e : diff(apar_e*rdx2vec[1],varsP[1]), - dA_dy_e : diff(apar_e*rdx2vec[2],varsP[2]), - dA_dz_e : diff(apar_e*rdx2vec[3],varsP[3]) - ) else if cdim = 2 then ( - dH_dx_e : diff(hamil_e*rdx2vec[1],varsP[1]), - dH_dy_e : 0, - dH_dz_e : diff(hamil_e*rdx2vec[2],varsP[2]), - dA_dx_e : diff(apar_e*rdx2vec[1],varsP[1]), - dA_dy_e : 0, - dA_dz_e : diff(apar_e*rdx2vec[2],varsP[2]) - ) else if cdim = 1 then ( - dH_dx_e : 0, - dH_dy_e : 0, - dH_dz_e : diff(hamil_e*rdx2vec[1],varsP[1]), - dA_dx_e : 0, - dA_dy_e : 0, - dA_dz_e : diff(apar_e*rdx2vec[1],varsP[1]) - ), - gradHxgradA_e : [ - dH_dy_e*dA_dz_e - dH_dz_e*dA_dy_e, - dH_dz_e*dA_dx_e - dH_dx_e*dA_dz_e, - dH_dx_e*dA_dy_e - dH_dy_e*dA_dx_e - ], - - /* Write out the gradHxgradA expansion to be evaluated at nodes later. */ - for i : 1 thru 3 do ( - gradHxgradA_c_ : calcInnerProdList(varsP, 1, bP, gradHxgradA_e[i]), - printf(fh, " double gradHxgradA_~a[~a] = {0.}; ~%", i, numP), - replaceList : [wvpar^2=wvparSq, rdvpar2^2=rdvpar2Sq, rdx2^2=rdx2Sq, m_^2=mSq, q_^2=qSq], - gradHxgradACvar_ : eval_string(sconcat("gradHxgradA_",i)), - writeCExprsNoExpand1(gradHxgradACvar_, gcfac(float(expand(subst(replaceList, gradHxgradA_c_))))), - printf(fh, "~%"), - flush_output(fh), - gradHxgradANoZero_c_ : makelistNoZeros1(gradHxgradA_c_, gradHxgradACvar_), - /* Expand projected Hamiltonian on basis. */ - gradHxgradA_e[i] : doExpand(gradHxgradANoZero_c_,bP) - ), - - /* Now eval at nodes the ∇H x ∇A expansion */ - gradHxgradA_nodes : makelist(0, i, 1, 3), - for i : 1 thru 3 do ( - gradHxgradA_nodes[i] : float(evAtNodes(gradHxgradA_e[i],surfNodes,surfIntVars)) + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), + gradHxgradA : [ + dH_dx*dA_dy - dH_dy*dA_dx + ] ), /* Now calculate alpha at all quadrature nodes */ @@ -315,7 +273,8 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 0), printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[j1index], 2), /* - ∇H x ∇A . b dψ/dvpar */ - printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 1, gradHxgradA[2][j1index]) + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 0, gradHxgradA[1][j1index]), + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 2, gradHxgradA[2][j1index]) ) ), if cdim = 1 then ( From 02453efcf67f48c4d2d165dcb3cac6f45383bd1a Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 20 Apr 2026 11:46:49 -0400 Subject: [PATCH 55/66] add an if statement to avoid declaring EM variables in ES kernels. --- .../gk_collisionless_flux-surf-conf.mac | 37 ++++++++++--------- 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index c80e7d8e..a227879b 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -183,25 +183,26 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b dHdvpar_nodes : append(dHdvpar_nodes, [dH_dz_nodes[vpardim][i]]) ), - /* Expand Aparallel. */ - apar_e : doExpand1(apar,bC), - apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), - printf(fh, " double apar_surf[~a] = {0.}; ~%", length(bSurf)), - aparSurfCvar : eval_string(sconcat("apar_surf")), - writeCExprsNoExpand1(aparSurfCvar, gcfac(float(expand(apar_c)))), - printf(fh, "~%"), - flush_output(fh), - apar_c : makelistNoZeros1(apar_c, aparSurfCvar), - /* Expand projected Apar on basis. */ - apar_e : doExpand(apar_c, bSurf), - /* Eval Aparallel at nodes. */ - apar_nodes : float(evAtNodes(apar_e,surfNodes,surfIntVars)), - /* Compute gradient of Aparallel */ - dA_dx_nodes : makelist(0, i, 1, cdim), - for i : 1 thru cdim do ( - dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + if em = true then ( + /* Expand Aparallel. */ + apar_e : doExpand1(apar,bC), + apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), + printf(fh, " double apar_surf[~a] = {0.}; ~%", length(bSurf)), + aparSurfCvar : eval_string(sconcat("apar_surf")), + writeCExprsNoExpand1(aparSurfCvar, gcfac(float(expand(apar_c)))), + printf(fh, "~%"), + flush_output(fh), + apar_c : makelistNoZeros1(apar_c, aparSurfCvar), + /* Expand projected Apar on basis. */ + apar_e : doExpand(apar_c, bSurf), + /* Eval Aparallel at nodes. */ + apar_nodes : float(evAtNodes(apar_e,surfNodes,surfIntVars)), + /* Compute gradient of Aparallel */ + dA_dx_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ) ), - /* It will be used to compute the contribution as ∇ x (A b) = ∇A x b + A ∇ x b */ /* Now calculate flux at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ From bb48ede52bc9ed96226c0e704d9e8246d600a6f2 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Thu, 23 Apr 2026 17:15:37 -0400 Subject: [PATCH 56/66] update the maxima script to generate useful zero kernel functions. The current state of this branch is generating good kernels but a lot of them can be removed. I will need to clean this soon. --- .../ms-gk_collisionless_flux.mac | 20 +++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 8120b8e5..e82171bd 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -152,11 +152,11 @@ for bInd : 1 thru length(bName) do ( )$ /* Generate the return zero kernel */ -fname : sconcat(outputDir,"gk_collisionless_flux_surf_return_zero.c")$ +fname : sconcat(outputDir,"gk_collisionless_flux_surfconf_return_zero.c")$ disp(printf(false,"Creating return zero kernel file: ~a",fname))$ fh : openw(fname)$ printf(fh, "#include ~%")$ -printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surf_return_zero(~%")$ +printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surfconf_return_zero(~%")$ printf(fh, " const double *w, const double *dxv,~%")$ printf(fh, " const double *vmap, const double *vmapSq, const double q_, const double m_,~%")$ printf(fh, " const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ~%")$ @@ -167,3 +167,19 @@ printf(fh, "{ ~%")$ printf(fh, " return 0.0; ~%")$ printf(fh, "}~%")$ close(fh)$ + +fname : sconcat(outputDir,"gk_collisionless_flux_surfvpar_return_zero.c")$ +disp(printf(false,"Creating return zero kernel file: ~a",fname))$ +fh : openw(fname)$ +printf(fh, "#include ~%")$ +printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surfvpar_return_zero(~%")$ +printf(fh, " const double *w, const double *dxv,~%")$ +printf(fh, " const double *vmap_prime_l, const double *vmap_prime_r,~%")$ +printf(fh, " const double *vmap, const double *vmapSq, const double q_, const double m_, ~%")$ +printf(fh, " const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, ~%")$ +printf(fh, " const double *bmag, const double *phi, const double *apar, const double *apardot, ~%")$ +printf(fh, " const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf) ~%")$ +printf(fh, "{ ~%")$ +printf(fh, " return 0.0; ~%")$ +printf(fh, "}~%")$ +close(fh)$ From a7b69ef5b288bf3c52818b6ff163f099f1b30230 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 27 Apr 2026 15:09:05 -0400 Subject: [PATCH 57/66] unify ES and EM surface flux kernels --- .../gk_collisionless_flux-surf-conf.mac | 88 +++++++------- .../gk_collisionless_flux-surf-vpar.mac | 62 ++++------ .../ms-gk_collisionless_flux-header.mac | 88 +++++++------- .../ms-gk_collisionless_flux.mac | 110 ++++++------------ 4 files changed, 151 insertions(+), 197 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac index a227879b..ac9faffc 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-conf.mac @@ -6,7 +6,7 @@ load("utilities_gyrokinetic")$ load("nodal_operations/nodal_functions")$ fpprec : 24$ -buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, mb_bound, scheme) := block( +buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge, mb_bound, scheme) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfNodes,nodeVars,bSurf,basisNodal,surfConfigNodes,numSurfNodes,numSurfConfigNodes,numVelNodes, numMuNodes,numVparNodes,d,rdx2vec,rdv2vec,rdSurfVar2,bmagBasis,phi_e,apar_e, @@ -183,25 +183,23 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b dHdvpar_nodes : append(dHdvpar_nodes, [dH_dz_nodes[vpardim][i]]) ), - if em = true then ( - /* Expand Aparallel. */ - apar_e : doExpand1(apar,bC), - apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), - printf(fh, " double apar_surf[~a] = {0.}; ~%", length(bSurf)), - aparSurfCvar : eval_string(sconcat("apar_surf")), - writeCExprsNoExpand1(aparSurfCvar, gcfac(float(expand(apar_c)))), - printf(fh, "~%"), - flush_output(fh), - apar_c : makelistNoZeros1(apar_c, aparSurfCvar), - /* Expand projected Apar on basis. */ - apar_e : doExpand(apar_c, bSurf), - /* Eval Aparallel at nodes. */ - apar_nodes : float(evAtNodes(apar_e,surfNodes,surfIntVars)), - /* Compute gradient of Aparallel */ - dA_dx_nodes : makelist(0, i, 1, cdim), - for i : 1 thru cdim do ( - dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) - ) + /* Expand Aparallel. */ + apar_e : doExpand1(apar,bC), + apar_c : calcInnerProdList(surfIntVars, 1, bSurf, subst(surfVar=evPoint,apar_e)), + printf(fh, " double apar_surf[~a] = {0.}; ~%", length(bSurf)), + aparSurfCvar : eval_string(sconcat("apar_surf")), + writeCExprsNoExpand1(aparSurfCvar, gcfac(float(expand(apar_c)))), + printf(fh, "~%"), + flush_output(fh), + apar_c : makelistNoZeros1(apar_c, aparSurfCvar), + /* Expand projected Apar on basis. */ + apar_e : doExpand(apar_c, bSurf), + /* Eval Aparallel at nodes. */ + apar_nodes : float(evAtNodes(apar_e,surfNodes,surfIntVars)), + /* Compute gradient of Aparallel */ + dA_dx_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) ), /* Now calculate flux at all quadrature nodes */ @@ -280,36 +278,34 @@ buildGKFluxConfKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ) ), - if em = true then ( - /* Electromagnetic Apar contribution using ∇ x (A b) = A ∇ x b + ∇A x b */ - /* No contribution for cdim = 1 */ - if cdim > 1 then ( - /* + 1/m A (∇ x b)/B . ∇ψ dH/dvpar */ - printf(fh, " alpha_quad += 1/m_ * (~a) * normcurlbhat_quad/bmag_quad * dHdvpar_quad[~a]; ~%", apar_nodes[j1index], vpar0index) + /* Electromagnetic Apar contribution using ∇ x (A b) = A ∇ x b + ∇A x b */ + /* No contribution for cdim = 1 */ + if cdim > 1 then ( + /* + 1/m A (∇ x b)/B . ∇ψ dH/dvpar */ + printf(fh, " alpha_quad += 1/m_ * (~a) * normcurlbhat_quad/bmag_quad * dHdvpar_quad[~a]; ~%", apar_nodes[j1index], vpar0index) + ), + /* + 1/m ∇A x b/B . ∇ψ dH/dvpar */ + if cdim = 3 then ( + if surfDir = 1 then( + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index], vpar0index) + ), + if surfDir = 2 then( + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index], vpar0index) ), - /* + 1/m ∇A x b/B . ∇ψ dH/dvpar */ - if cdim = 3 then ( - if surfDir = 1 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[2] - (~a) * bhat_quad[1]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[2][j1index], dA_dx_nodes[3][j1index], vpar0index) - ), - if surfDir = 2 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[0] - (~a) * bhat_quad[2]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[3][j1index], dA_dx_nodes[1][j1index], vpar0index) - ), - if surfDir = 3 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index], vpar0index) - ) + if surfDir = 3 then( + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * ((~a) * bhat_quad[1] - (~a) * bhat_quad[0]) * dHdvpar_quad[~a]; ~%", dA_dx_nodes[1][j1index], dA_dx_nodes[2][j1index], vpar0index) + ) + ), + /* in 2D, we take the first and last component of the 3D cross product, setting d/dy = 0.*/ + if cdim = 2 then ( + if surfDir = 1 then( + printf(fh, " alpha_quad -= 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1] * dHdvpar_quad[~a]; ~%", dA_dx_nodes[2][j1index], vpar0index) ), - /* in 2D, we take the first and last component of the 3D cross product, setting d/dy = 0.*/ - if cdim = 2 then ( - if surfDir = 1 then( - printf(fh, " alpha_quad -= 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1] * dHdvpar_quad[~a]; ~%", dA_dx_nodes[2][j1index], vpar0index) - ), - if surfDir = 2 then( - printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1] * dHdvpar_quad[~a]; ~%", dA_dx_nodes[1][j1index], vpar0index) - ) + if surfDir = 2 then( + printf(fh, " alpha_quad += 1/(m_*bmag_quad*area_elem_quad) * (~a) * bhat_quad[1] * dHdvpar_quad[~a]; ~%", dA_dx_nodes[1][j1index], vpar0index) ) - /* Nothing in 1D */ ) + /* Nothing in 1D */ ), /* Multiply by |e^i|, note: area_elem_quad = J_c |e^i| */ diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index a5a95dc0..558605cf 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -5,7 +5,7 @@ load("scifac")$ load("utilities_gyrokinetic")$ fpprec : 24$ -buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, em, edge, add_apardot, scheme) := block( +buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_by, edge, scheme) := block( [pDim,varsC,bC,varsP,bP,vSub,numC,numP,surfVar,varLabel,dirLabel,surfIntVars,surf_cvars,surf_vvars, surfIntVarsC,bSurfC,surfNodes,nodeVars,bSurf,basisNodal,configNodes,numSurfNodes,numConfigNodes, numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, @@ -219,9 +219,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " double JfR_quad = 0.0; ~%"), printf(fh, " double Jfavg_quad = 0.0; ~%"), printf(fh, " double Jfjump_quad = 0.0; ~%"), - if em = true then ( - printf(fh, " double bioverJB_quad[3] = {0.0}; ~%") - ), + printf(fh, " double bioverJB_quad[3] = {0.0}; ~%"), printf(fh, "~%"), for i : 1 thru numConfigNodes do ( @@ -233,11 +231,9 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " dualcurlbhat_quad[1] = gkdgv[~a].dualcurlbhat.x[1]; ~%", i0index), printf(fh, " dualcurlbhat_quad[2] = gkdgv[~a].dualcurlbhat.x[2]; ~%", i0index), - if em = true then ( - printf(fh, " bioverJB_quad[0] = gkdgv[~a].bioverJB.x[0]; ~%", i0index), - printf(fh, " bioverJB_quad[1] = gkdgv[~a].bioverJB.x[1]; ~%", i0index), - printf(fh, " bioverJB_quad[2] = gkdgv[~a].bioverJB.x[2]; ~%", i0index) - ), + printf(fh, " bioverJB_quad[0] = gkdgv[~a].bioverJB.x[0]; ~%", i0index), + printf(fh, " bioverJB_quad[1] = gkdgv[~a].bioverJB.x[1]; ~%", i0index), + printf(fh, " bioverJB_quad[2] = gkdgv[~a].bioverJB.x[2]; ~%", i0index), for j : 1 thru numVelNodes do ( j0index : j-1+(i-1)*numVelNodes, @@ -254,47 +250,39 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b for k : 1 thru cdim do ( printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[k][j1index], k-1, mvpar_j1) ), - if em = true then ( - /* EM term using ∇ x (A b) . ∇H = A . ∇ x b . ∇H + ∇A x b . ∇H = A . ∇ x b . ∇H + ∇H x ∇A . b */ - for k : 1 thru cdim do ( - /* - A ∇ x b . ∇H dψ/dvpar = - A (∇ x b)_i dH/dxi dψ/dvpar */ - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[j1index], k-1), - /* - ∇H x ∇A . b dψ/dvpar = - b_i/B 1/J eps_ijk dH/dx_j dA/dx_k */ - printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", k-1, gradHxgradA[k][j1index]) - ) + /* EM term using ∇ x (A b) . ∇H = A . ∇ x b . ∇H + ∇A x b . ∇H = A . ∇ x b . ∇H + ∇H x ∇A . b */ + for k : 1 thru cdim do ( + /* - A ∇ x b . ∇H dψ/dvpar = - A (∇ x b)_i dH/dxi dψ/dvpar */ + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[j1index], k-1), + /* - ∇H x ∇A . b dψ/dvpar = - b_i/B 1/J eps_ijk dH/dx_j dA/dx_k */ + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", k-1, gradHxgradA[k][j1index]) ) ), if cdim = 2 then ( /* Finish ES term */ printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 0, mvpar_j1), printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[2][j1index], 2, mvpar_j1), - if em = true then ( - /* - A * ∇ x b . ∇H dψ/dvpar*/ - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 0), - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[j1index], 2), - /* - ∇H x ∇A . b dψ/dvpar */ - printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 0, gradHxgradA[1][j1index]), - printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 2, gradHxgradA[2][j1index]) - ) + /* EM - A * ∇ x b . ∇H dψ/dvpar*/ + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 0), + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[j1index], 2), + /* EM - ∇H x ∇A . b dψ/dvpar */ + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 0, gradHxgradA[1][j1index]), + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 2, gradHxgradA[2][j1index]) ), if cdim = 1 then ( /* Finish ES term */ printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 2, mvpar_j1), - if em = true then ( - /* - A * ∇ x b . ∇H dψ/dvpar*/ - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 2) - /* - ∇H x ∇A . b dψ/dvpar */ - /* none */ - ) + /* EM - A * ∇ x b . ∇H dψ/dvpar*/ + printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 2) + /* EM - ∇H x ∇A . b dψ/dvpar */ + /* none */ ) ), - /* Add apardot contribution if requested */ - if add_apardot = true then ( - apardot_e : doExpand1(apardot, bC), - apardot_nodes : float(evAtNodes(apardot_e,configNodes,surf_cvars)), - printf(fh, " alpha_quad += -q_/m_*(~a); ~%", apardot_nodes[i1index]) - ), + /* Add EM (apardot) contribution */ + apardot_e : doExpand1(apardot, bC), + apardot_nodes : float(evAtNodes(apardot_e,configNodes,surf_cvars)), + printf(fh, " alpha_quad += -q_/m_*(~a); ~%", apardot_nodes[i1index]), printf(fh, "~%"), printf(fh, " cfl = fmax(fabs(alpha_quad), fabs(cfl)) ;~%", j0index), diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac index 7b35759d..9b66d599 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux-header.mac @@ -46,59 +46,55 @@ byStr : ["", "no_by_"]$ mb_bcOpt : [[false,true],[false,true],[false,true]]$ mb_bcStr : ["", "multib_boundary_"]$ -emStr : ["", "em_", "em_star_"]$ - /* Options for writing kernels at surface and edge surfaces. */ edgeBool : [false, true]$ edgeOpt : ["surf", "edge_surf"]$ printPrototypes() := block([], - for emI : 1 thru 3 do ( - em_label : emStr[emI], - for bInd : 1 thru length(bName) do ( + for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ - for polyOrder : 1 thru maxPolyOrderB do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only declare p=1 kernels for 3x2v */ + for polyOrder : 1 thru maxPolyOrderB do ( - for byI : 1 thru length(byOpt[c]) do ( - no_by : byOpt[c][byI], - no_byStr : byStr[byI], + for byI : 1 thru length(byOpt[c]) do ( + no_by : byOpt[c][byI], + no_byStr : byStr[byI], - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], - for surfDir : 1 thru c do ( - dirlabel : varsC[surfDir], + for surfDir : 1 thru c do ( + dirlabel : varsC[surfDir], - for edgeI : 1 thru 2 do ( - edge : edgeBool[edgeI], - edgeStr : edgeOpt[edgeI], - - funcName : sconcat("gk_collisionless_flux_",em_label,no_byStr,mb_boundStr,edgeStr,dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), - printf(fh, "GKYL_CU_DH double ~a( + for edgeI : 1 thru 2 do ( + edge : edgeBool[edgeI], + edgeStr : edgeOpt[edgeI], + + funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,edgeStr,dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), + printf(fh, "GKYL_CU_DH double ~a( const double *w, const double *dxv, const double *vmap, const double *vmapSq, const double q_, const double m_, const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf); ~%", funcName) - ) ) - ), - - dirlabel : varsV[1], - edgeStr : edgeOpt[1], - edge : false, - funcName : sconcat("gk_collisionless_flux_",em_label,no_byStr,edgeStr,dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), - printf(fh, "GKYL_CU_DH double ~a( + ) + ), + + dirlabel : varsV[1], + edgeStr : edgeOpt[1], + edge : false, + funcName : sconcat("gk_collisionless_flux_",no_byStr,edgeStr,dirlabel,"_",c,"x",v,"v_",bName[bInd],"_p",polyOrder), + printf(fh, "GKYL_CU_DH double ~a( const double *w, const double *dxv, const double *vmap_prime_l, const double *vmap_prime_r, const double *vmap, const double *vmapSq, const double q_, const double m_, @@ -106,21 +102,31 @@ printPrototypes() := block([], const double *bmag, const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf); ~%", funcName), - printf(fh, "~%") - ) + printf(fh, "~%") ) - ) - ) + ) + ) ) ), - printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surf_return_zero( + printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surfconf_none( const double *w, const double *dxv, const double *vmap, const double *vmapSq, const double q_, const double m_, const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, const double *bmag, const double *jacobgeo_rat_surfL, const double *jacobgeo_rat_surfR, - const double *phi, const double *apar, const double *apardot, const double *JfL, const double *JfR, - double* GKYL_RESTRICT flux_surf);~%") + const double *phi, const double *apar, const double *apardot, + const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf);~%"), + + printf(fh, "~%"), + + printf(fh,"GKYL_CU_DH double gk_collisionless_flux_surfvpar_none( + const double *w, const double *dxv, + const double *vmap_prime_l, const double *vmap_prime_r, + const double *vmap, const double *vmapSq, const double q_, const double m_, + const struct gkyl_dg_vol_geom *dgv, const struct gkyl_gk_dg_vol_geom *gkdgv, + const double *bmag, const double *phi, const double *apar, const double *apardot, + const double *JfL, const double *JfR, double* GKYL_RESTRICT flux_surf);~%") + )$ fh : openw(sconcat(outputDir,"gkyl_gk_collisionless_flux_kernels.h"))$ diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index e82171bd..753e81b5 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -43,10 +43,6 @@ vlabels : ["vpar","mu"]$ byOpt : [[false], [false, true], [false, true]]$ byStr : ["", "no_by_"]$ -/* Options for writing electromagnetic and electrostatic kernels. */ -emBool : [false, true]$ -emOpt : ["", "em_"]$ - /* Options for writing kernels used at multiblock boundaries. One for each dimension. */ mb_bcOpt : [[false,true],[false,true],[false,true]]$ @@ -69,81 +65,49 @@ for bInd : 1 thru length(bName) do ( /* Loop over polynomial order. */ for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - /* With/without toroidal field loop. */ - for byI : 1 thru length(byOpt[c]) do ( - no_by : byOpt[c][byI], - no_byStr : byStr[byI], - - /* Electrostatic/electromagnetic loop. */ - for emI : 1 thru length(emOpt) do ( - em : emBool[emI], - emStr : emOpt[emI], - - /* Singleblock/multiblock loop. */ - for mbI : 1 thru length(mb_bcOpt[c]) do ( - mb_bound : mb_bcOpt[c][mbI], - mb_boundStr : mb_bcStr[mbI], - - /* Configuration space surface direction loop. */ - for dir : 1 thru c do ( - dirStr : clabels[dir], - - /* Surface/edge surface loop. */ - for edgeI : 1 thru length(edgeBool) do ( - edge : edgeBool[edgeI], - edgeStr : edgeOpt[edgeI], - - scheme : "upwind", - fname : sconcat(outputDir,"gk_collisionless_flux_",emStr,no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), - disp(printf(false,"Creating ~a flux surf~a ~a ~a file: ~a",edgeStr,dirStr,no_byStr,mb_boundStr,fname)), - fh : openw(fname), - printf(fh, "#include ~%"), - funcName : sconcat("gk_collisionless_flux_",emStr,no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxConfKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, scheme), - close(fh), - - if (em) then ( - scheme : "upwind", - fname : sconcat(outputDir,"gk_collisionless_flux_em_star_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), - disp(printf(false,"Creating ~a flux surf~a ~a ~a file: ~a",edgeStr,dirStr,no_byStr,mb_boundStr,fname)), - fh : openw(fname), - printf(fh, "#include ~%"), - funcName : sconcat("gk_collisionless_flux_em_star_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxConfKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, mb_bound, scheme), - close(fh) - ) - ) - ), - - /* Surface flux in vparallel direction (no edge).*/ - dirStr : vlabels[1], - edge : false, - edgeStr : edgeOpt[1], - add_apardot : em, /* Add apardot term if EM. */ - - scheme : "upwind", - fname : sconcat(outputDir,"gk_collisionless_flux_",emStr,no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), - fh : openw(fname), - printf(fh, "#include ~%"), - funcName : sconcat("gk_collisionless_flux_",emStr,no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, scheme), - close(fh), - - if (em) then ( - /* Add EM terms but not Apardot (star term) */ - add_apardot : false, + /* With/without toroidal field loop. */ + for byI : 1 thru length(byOpt[c]) do ( + no_by : byOpt[c][byI], + no_byStr : byStr[byI], + + /* Singleblock/multiblock loop. */ + for mbI : 1 thru length(mb_bcOpt[c]) do ( + mb_bound : mb_bcOpt[c][mbI], + mb_boundStr : mb_bcStr[mbI], + + /* Configuration space surface direction loop. */ + for dir : 1 thru c do ( + dirStr : clabels[dir], + + /* Surface/edge surface loop. */ + for edgeI : 1 thru length(edgeBool) do ( + edge : edgeBool[edgeI], + edgeStr : edgeOpt[edgeI], scheme : "upwind", - fname : sconcat(outputDir,"gk_collisionless_flux_em_star_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), - disp(printf(false,"Creating flux surfvpar file: ~a",fname)), + fname : sconcat(outputDir,"gk_collisionless_flux_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), + disp(printf(false,"Creating ~a flux surf~a ~a ~a file: ~a",edgeStr,dirStr,no_byStr,mb_boundStr,fname)), fh : openw(fname), printf(fh, "#include ~%"), - funcName : sconcat("gk_collisionless_flux_em_star_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), - buildGKFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, em, edge, add_apardot, scheme), + funcName : sconcat("gk_collisionless_flux_",no_byStr,mb_boundStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), + buildGKFluxConfKernel(dir, fh, funcName, c, v, bStr, polyOrder, no_by, edge, mb_bound, scheme), close(fh) ) - ) + ), + + /* Surface flux in vparallel direction (no edge).*/ + dirStr : vlabels[1], + edge : false, + edgeStr : edgeOpt[1], + + scheme : "upwind", + fname : sconcat(outputDir,"gk_collisionless_flux_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder, ".c"), + disp(printf(false,"Creating flux surfvpar ~a file: ~a",no_byStr,fname)), + fh : openw(fname), + printf(fh, "#include ~%"), + funcName : sconcat("gk_collisionless_flux_",no_byStr,edgeStr,dirStr,"_", c, "x", v, "v_", bStr, "_p", polyOrder), + buildGKFluxVparKernel(c+1, fh, funcName, c, v, bStr, polyOrder, no_by, edge, scheme), + close(fh) ) ) ) From 7dd67127e7e9acc2567260c111d9da6db4e28445 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 27 Apr 2026 15:17:28 -0400 Subject: [PATCH 58/66] checkout origin/main of some files that got lost --- .../finite_volume/code_generator_core.rkt | 1080 +++++ .../finite_volume/code_generator_core_2d.rkt | 1977 +++++++++ .../finite_volume/code_generator_vector.rkt | 1467 +++++++ .../code_generator_vector_2d.rkt | 3281 +++++++++++++++ .../finite_volume/gkyl_code_generator_lax.rkt | 1282 ++++++ .../gkyl_code_generator_lax_vector.rkt | 1305 ++++++ .../finite_volume/gkyl_code_generator_roe.rkt | 1261 ++++++ .../gkyl_code_generator_roe_vector.rkt | 1335 ++++++ .../gkyl_test_inviscid_burgers.rkt | 275 ++ .../gkyl_test_isothermal_euler_mom_x.rkt | 339 ++ .../gkyl_test_isothermal_euler_mom_yz.rkt | 333 ++ .../finite_volume/gkyl_test_limiters.rkt | 219 + .../gkyl_test_linear_advection.rkt | 276 ++ .../gkyl_test_maxwell_1d_Bx_psi.rkt | 339 ++ .../gkyl_test_maxwell_1d_Ex_phi.rkt | 339 ++ .../gkyl_test_maxwell_1d_Ey_Bz.rkt | 339 ++ .../gkyl_test_maxwell_1d_Ez_By.rkt | 339 ++ .../finite_volume/prover_core.rkt | 1284 ++++++ .../finite_volume/prover_vector.rkt | 1916 +++++++++ .../finite_volume/test_inviscid_burgers.rkt | 448 ++ .../test_isothermal_euler_2d.rkt | 350 ++ .../test_isothermal_euler_mom_x.rkt | 282 ++ .../test_isothermal_euler_mom_yz.rkt | 276 ++ .../finite_volume/test_limiters.rkt | 177 + .../finite_volume/test_linear_advection.rkt | 451 ++ .../finite_volume/test_maxwell_1d_Bx_psi.rkt | 282 ++ .../finite_volume/test_maxwell_1d_Ex_phi.rkt | 282 ++ .../finite_volume/test_maxwell_1d_Ey_Bz.rkt | 282 ++ .../finite_volume/test_maxwell_1d_Ez_By.rkt | 282 ++ .../code_generator_core_training.rkt | 1415 +++++++ .../code_generator_core_training_2d.rkt | 2325 +++++++++++ .../code_generator_core_validation.rkt | 976 +++++ .../code_generator_matrix_training.rkt | 920 ++++ .../code_generator_matrix_training_2d.rkt | 1827 ++++++++ .../code_generator_matrix_validation.rkt | 1074 +++++ .../code_generator_vector_training.rkt | 1888 +++++++++ .../code_generator_vector_training_2d.rkt | 3717 +++++++++++++++++ .../code_generator_vector_validation.rkt | 1036 +++++ .../neural_networks/prover_core.rkt | 624 +++ .../neural_networks/prover_matrix.rkt | 901 ++++ .../neural_networks/prover_vector.rkt | 826 ++++ .../neural_networks/test_euler_shallow.rkt | 450 ++ .../test_inviscid_burgers_shallow.rkt | 403 ++ .../test_isothermal_euler_shallow.rkt | 480 +++ .../test_linear_advection_shallow.rkt | 405 ++ 45 files changed, 41365 insertions(+) create mode 100644 provable-algorithms/finite_volume/code_generator_core.rkt create mode 100644 provable-algorithms/finite_volume/code_generator_core_2d.rkt create mode 100644 provable-algorithms/finite_volume/code_generator_vector.rkt create mode 100644 provable-algorithms/finite_volume/code_generator_vector_2d.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_code_generator_lax.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_code_generator_lax_vector.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_code_generator_roe.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_code_generator_roe_vector.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_test_inviscid_burgers.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_x.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_yz.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_test_limiters.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_test_linear_advection.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Bx_psi.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ex_phi.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ey_Bz.rkt create mode 100644 provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ez_By.rkt create mode 100644 provable-algorithms/finite_volume/prover_core.rkt create mode 100644 provable-algorithms/finite_volume/prover_vector.rkt create mode 100644 provable-algorithms/finite_volume/test_inviscid_burgers.rkt create mode 100644 provable-algorithms/finite_volume/test_isothermal_euler_2d.rkt create mode 100644 provable-algorithms/finite_volume/test_isothermal_euler_mom_x.rkt create mode 100644 provable-algorithms/finite_volume/test_isothermal_euler_mom_yz.rkt create mode 100644 provable-algorithms/finite_volume/test_limiters.rkt create mode 100644 provable-algorithms/finite_volume/test_linear_advection.rkt create mode 100644 provable-algorithms/finite_volume/test_maxwell_1d_Bx_psi.rkt create mode 100644 provable-algorithms/finite_volume/test_maxwell_1d_Ex_phi.rkt create mode 100644 provable-algorithms/finite_volume/test_maxwell_1d_Ey_Bz.rkt create mode 100644 provable-algorithms/finite_volume/test_maxwell_1d_Ez_By.rkt create mode 100644 provable-algorithms/neural_networks/code_generator_core_training.rkt create mode 100644 provable-algorithms/neural_networks/code_generator_core_training_2d.rkt create mode 100644 provable-algorithms/neural_networks/code_generator_core_validation.rkt create mode 100644 provable-algorithms/neural_networks/code_generator_matrix_training.rkt create mode 100644 provable-algorithms/neural_networks/code_generator_matrix_training_2d.rkt create mode 100644 provable-algorithms/neural_networks/code_generator_matrix_validation.rkt create mode 100644 provable-algorithms/neural_networks/code_generator_vector_training.rkt create mode 100644 provable-algorithms/neural_networks/code_generator_vector_training_2d.rkt create mode 100644 provable-algorithms/neural_networks/code_generator_vector_validation.rkt create mode 100644 provable-algorithms/neural_networks/prover_core.rkt create mode 100644 provable-algorithms/neural_networks/prover_matrix.rkt create mode 100644 provable-algorithms/neural_networks/prover_vector.rkt create mode 100644 provable-algorithms/neural_networks/test_euler_shallow.rkt create mode 100644 provable-algorithms/neural_networks/test_inviscid_burgers_shallow.rkt create mode 100644 provable-algorithms/neural_networks/test_isothermal_euler_shallow.rkt create mode 100644 provable-algorithms/neural_networks/test_linear_advection_shallow.rkt diff --git a/provable-algorithms/finite_volume/code_generator_core.rkt b/provable-algorithms/finite_volume/code_generator_core.rkt new file mode 100644 index 00000000..d9ba7978 --- /dev/null +++ b/provable-algorithms/finite_volume/code_generator_core.rkt @@ -0,0 +1,1080 @@ +#lang racket + +(require "prover_core.rkt") +(provide convert-expr + remove-bracketed-expressions + remove-bracketed-expressions-from-file + flux-substitute + generate-lax-friedrichs-scalar-1d + generate-lax-friedrichs-scalar-1d-second-order + generate-roe-scalar-1d + generate-roe-scalar-1d-second-order) + +;; Lightweight converter from Racket expressions (expr) into strings representing equivalent C code. +(define (convert-expr expr) + (match expr + ;; If expr is a symbol, then convert it directly to a string. + [(? symbol? symb) (symbol->string symb)] + + ;; If expr is a numerical constant, then convert it directly to a string. + [(? number? num) (number->string num)] + + ;; If expr is a sum of the form (+ expr1 expr2 ...), then convert it to "(expr1 + expr2 + ...)" in C. + [`(+ . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " + ") ")"))] + ;; Likewise for differences. + [`(- . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " - ") ")"))] + + ;; If expr is a product of the form (* expr1 expr2 ...), then convert it to "(expr1 * expr2 * ...)" in C. + [`(* . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " * ") ")"))] + ;; Likewise for quotients. + [`(/ . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " / ") ")"))] + + ;; If expr is an absolute value of the form (abs expr1), then convert it to "fabs(expr1)" in C. + [`(abs ,arg) + (format "fabs(~a)" (convert-expr arg))] + + ;; If expr is a square root of the form (sqrt expr1), then convert it to "sqrt(expr1)" in C. + [`(sqrt ,arg) + (format "sqrt(~a)" (convert-expr arg))] + + ;; If expr is a maximum of the form (max expr1 expr2), then convert it to "fmax(expr1, expr2)" in C. + [`(max ,arg1 ,arg2) + (format "fmax(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a maximum of the form (max expr1 expr2 expr2), then convert it to "fmax(expr1, expr2, expr3)" in C. + [`(max ,arg1 ,arg2 ,arg3) + (format "fmax3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] + + ;; If expr is a minimum of the form (max expr1 expr2), then convert it to "fmin(expr1, expr2)" in C. + [`(min ,arg1 ,arg2) + (format "fmin(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a minimum of the form (max expr1 expr2 expr2), then convert it to "fmin(expr1, expr2, expr3)" in C. + [`(min ,arg1 ,arg2 ,arg3) + (format "fmin3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] + + ;; If expr is a variable assignment of the form (define expr1 expr2), then convert it to "expr1 = expr2" in C. + [`(define ,arg1 ,arg2) + (format "~a = ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a strict comparison of the form (< expr1 expr2), then convert it to "expr1 < expr2" in C. + [`(< ,arg1 ,arg2) + (format "~a < ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a comparison of the form (<= expr1 expr2), then convert it to "expr1 <= expr2" in C. + [`(<= ,arg1 ,arg2) + (format "~a <= ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a strict comparison of the form (> expr1 expr2), then convert it to "expr1 > expr2" in C. + [`(> ,arg1 ,arg2) + (format "~a > ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a comparison of the form (>= expr1 expr2), then convert it to "expr1 >= expr2" in C. + [`(>= ,arg1 ,arg2) + (format "~a >= ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is an equality comparison of the form (equal? expr1 expr2), then convert it to "expr1 == expr2" in C. + [`(equal? ,arg1 ,arg2) + (format "~a == ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a conditional of the form [(cond [cond1 expr1] [else expr2])], then convert it to the ternary operator "(cond1) ? expr1 : expr2" in C. + [`(cond + [,cond1 ,expr1] + [else ,expr2]) + (format "(~a) ? ~a : ~a" (convert-expr cond1) (convert-expr expr1) (convert-expr expr2))])) + +;; A simple boilerplate function for removing bracketed expressions from strings. +(define (remove-bracketed-expressions str) + (regexp-replace* #rx"\\[.*?\\]" str "")) + +;; A simple boilerplate function for removing bracketed expressions from files. +(define (remove-bracketed-expressions-from-file output-file) + (define content + (with-input-from-file output-file + (lambda () + (port->string (current-input-port))))) + (define cleaned + (remove-bracketed-expressions content)) + (with-output-to-file output-file #:exists 'replace + (lambda () + (display cleaned)))) + +(define (flux-substitute flux-expr cons-expr var-name) + (string-replace flux-expr cons-expr var-name)) + +;; ------------------------------------------------------------- +;; Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE +;; ------------------------------------------------------------- +(define (generate-lax-friedrichs-scalar-1d pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define flux-um (flux-substitute flux-code cons-code "um")) + (define flux-ui (flux-substitute flux-code cons-code "ui")) + (define flux-up (flux-substitute flux-code cons-code "up")) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR SCALAR PDE: ~a +// Lax–Friedrichs first-order finite-difference solver for a scalar PDE in 1D. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * sizeof(double)); + double *un = (double*) malloc((nx + 2) * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[i] = ~a; // init-func in C. + un[i] = ~a; // init-func in C. + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable. + for (int i = 1; i <= nx; i++) { + double um = u[i - 1]; + double ui = u[i]; + double up = u[i + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um = ~a; // f(u_{i - 1}). + double f_ui = ~a; // f(u_i). + double f_up = ~a; // f(u_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * alpha * (u_i - u_{i - 1}). + double fluxL = 0.5 * (f_um + f_ui) - 0.5 * alpha * (ui - um); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * alpha * (u_{i + 1} - u_i). + double fluxR = 0.5 * (f_ui + f_up) - 0.5 * alpha * (up - ui); + + // Update the conserved variable. + un[i] = ui - (dt / dx) * (fluxR - fluxL); + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + u[i] = un[i]; + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[1]; + u[nx + 1] = u[nx]; + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(un); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expression for local wave-speed estimate. + max-speed-local + ;; Left flux f(u_{i - 1}). + flux-um + ;; Middle flux f(u_i). + flux-ui + ;; Right flux f(u_{i + 1}). + flux-up + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------------- +;; Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE with a Second-Order Flux Extrapolation +;; ---------------------------------------------------------------------------------------------------- +(define (generate-lax-friedrichs-scalar-1d-second-order pde limiter + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method with a second-order flux extrapolation using flux limiter `limiter`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umL (flux-substitute flux-code cons-code "umL")) + (define flux-umR (flux-substitute flux-code cons-code "umR")) + (define flux-uiL (flux-substitute flux-code cons-code "uiL")) + (define flux-uiR (flux-substitute flux-code cons-code "uiR")) + (define flux-upL (flux-substitute flux-code cons-code "upL")) + (define flux-upR (flux-substitute flux-code cons-code "upR")) + + (define flux-umR-evol (flux-substitute flux-code cons-code "umR_evol")) + (define flux-uiL-evol (flux-substitute flux-code cons-code "uiL_evol")) + (define flux-uiR-evol (flux-substitute flux-code cons-code "uiR_evol")) + (define flux-upL-evol (flux-substitute flux-code cons-code "upL_evol")) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Lax–Friedrichs first-order finite-difference solver for a scalar PDE in 1D, with a second-order flux extrapolation. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Array for storing slopes. + double *slope = (double*) malloc((nx + 4) * sizeof(double)); + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * sizeof(double)); + double *un = (double*) malloc((nx + 4) * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[i] = ~a; // init-func in C. + un[i] = ~a; // init-func in C. + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + double r = (u[i] - u[i - 1]) / (u[i + 1] - u[i]); + double limiter = ~a; // limiter-r in C. + + slope[i] = limiter * (0.5 * ((u[i] - u[i - 1]) + (u[i + 1] - u[i]))); + } + + // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable. + for (int i = 2; i <= nx + 1; i++) { + // Extrapolate boundary states. + double umL = u[i - 1] - (0.5 * slope[i - 1]); + double umR = u[i - 1] + (0.5 * slope[i - 1]); + + double uiL = u[i] - (0.5 * slope[i]); + double uiR = u[i] + (0.5 * slope[i]); + + double upL = u[i + 1] - (0.5 * slope[i + 1]); + double upR = u[i + 1] + (0.5 * slope[i + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL = ~a; + double f_umR = ~a; + + double f_uiL = ~a; + double f_uiR = ~a; + + double f_upL = ~a; + double f_upR = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol = umR + ((dt / (2.0 * dx)) * (f_umL - f_umR)); + + double uiL_evol = uiL + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); + double uiR_evol = uiR + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); + + double upL_evol = upL + ((dt / (2.0 * dx)) * (f_upL - f_upR)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol = ~a; + double f_uiL_evol = ~a; + + double f_uiR_evol = ~a; + double f_upL_evol = ~a; + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * alpha * (u_{i, L+} - u_{i - 1, R+}). + double fluxL = 0.5 * (f_umR_evol + f_uiL_evol) - 0.5 * alpha * (uiL_evol - umR_evol); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * alpha * (u_{i + 1, L+} - u_{i, R+}). + double fluxR = 0.5 * (f_uiR_evol + f_upL_evol) - 0.5 * alpha * (upL_evol - uiR_evol); + + // Update the conserved variable. + un[i] = u[i] - (dt / dx) * (fluxR - fluxL); + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + u[i] = un[i]; + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[2]; + u[1] = u[2]; + u[nx + 2] = u[nx + 1]; + u[nx + 3] = u[nx + 1]; + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(un); + free(slope); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expression for local wave-speed estimate. + max-speed-local + ;; Expression for flux limiter function. + limiter-r + ;; Left negative flux f(u_{i - 1, L}). + flux-umL + ;; Right negative flux f(u_{i - 1, R}). + flux-umR + ;; Left central flux f(u_{i, L}). + flux-uiL + ;; Right central flux f(u_{i, R}). + flux-uiR + ;; Left positive flux f(u_{i + 1, L}). + flux-upL + ;; Right positive flux f(u_{i + 1, R}). + flux-upR + ;; Evolved right negative flux f(u_{i - 1, R+}). + flux-umR-evol + ;; Evolved left central flux f(u_{i, L+}). + flux-uiL-evol + ;; Evolved right central flux f(u_{i, R+}). + flux-uiR-evol + ;; Evolved left positive flux f(u_{i + 1, L+}). + flux-upL-evol + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------- +;; Roe (Finite-Volume) Solver for a 1D Scalar PDE +;; ---------------------------------------------- +(define (generate-roe-scalar-1d pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define flux-deriv-code (convert-expr flux-deriv)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define flux-um (flux-substitute flux-code cons-code "um")) + (define flux-ui (flux-substitute flux-code cons-code "ui")) + (define flux-up (flux-substitute flux-code cons-code "up")) + + (define flux-deriv-um (flux-substitute flux-deriv-code cons-code "um")) + (define flux-deriv-ui (flux-substitute flux-deriv-code cons-code "ui")) + (define flux-deriv-up (flux-substitute flux-deriv-code cons-code "up")) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR SCALAR PDE: ~a +// Roe higher-order finite-volume solver for a scalar PDE in 1D. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * sizeof(double)); + double *un = (double*) malloc((nx + 2) * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[i] = ~a; // init-func in C. + un[i] = ~a; // init-func in C. + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Roe approximation and update the conserved variable. + for (int i = 1; i <= nx; i++) { + double um = u[i - 1]; + double ui = u[i]; + double up = u[i + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um = ~a; // f(u_{i - 1}). + double f_ui = ~a; // f(u_i). + double f_up = ~a; // f(u_{i + 1}). + + // Evaluate flux derivative for each value of the conserved variable. + double f_deriv_um = ~a; // f'(u_{i - 1}). + double f_deriv_ui = ~a; // f'(u_i). + double f_deriv_up = ~a; // f'(u_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * |aL_roe| * (u_i - u_{i - 1}). + double aL_roe = 0.5 * (f_deriv_um + f_deriv_ui); + double fluxL = 0.5 * (f_um + f_ui) - 0.5 * fabs(aL_roe) * (ui - um); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * |aR_roe| * (u_{i + 1} - u_i). + double aR_roe = 0.5 * (f_deriv_ui + f_deriv_up); + double fluxR = 0.5 * (f_ui + f_up) - 0.5 * fabs(aR_roe) * (up - ui); + + // Update the conserved variable. + un[i] = ui - (dt / dx) * (fluxR - fluxL); + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + u[i] = un[i]; + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[1]; + u[nx + 1] = u[nx]; + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(un); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expression for local wave-speed estimate. + max-speed-local + ;; Left flux f(u_{i - 1}). + flux-um + ;; Middle flux f(u_i). + flux-ui + ;; Right flux f(u_{i + 1}). + flux-up + ;; Left flux derivative f'(u_{i - 1}). + flux-deriv-um + ;; Middle flux derivative f'(u_i). + flux-deriv-ui + ;; Right flux derivative f'(u_{i + 1}). + flux-deriv-up + ;; PDE name for file output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------- +;; Roe (Finite-Volume) Solver for a 1D Scalar PDE with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------- +(define (generate-roe-scalar-1d-second-order pde limiter + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method with a second-order flux extrapolation using flux limiter `limiter`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define flux-deriv-code (convert-expr flux-deriv)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umL (flux-substitute flux-code cons-code "umL")) + (define flux-umR (flux-substitute flux-code cons-code "umR")) + (define flux-uiL (flux-substitute flux-code cons-code "uiL")) + (define flux-uiR (flux-substitute flux-code cons-code "uiR")) + (define flux-upL (flux-substitute flux-code cons-code "upL")) + (define flux-upR (flux-substitute flux-code cons-code "upR")) + + (define flux-umR-evol (flux-substitute flux-code cons-code "umR_evol")) + (define flux-uiL-evol (flux-substitute flux-code cons-code "uiL_evol")) + (define flux-uiR-evol (flux-substitute flux-code cons-code "uiR_evol")) + (define flux-upL-evol (flux-substitute flux-code cons-code "upL_evol")) + + (define flux-deriv-umR-evol (flux-substitute flux-deriv-code cons-code "umR_evol")) + (define flux-deriv-uiL-evol (flux-substitute flux-deriv-code cons-code "uiL_evol")) + (define flux-deriv-uiR-evol (flux-substitute flux-deriv-code cons-code "uiR_evol")) + (define flux-deriv-upL-evol (flux-substitute flux-deriv-code cons-code "upL_evol")) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Roe higher-order finite-volume solver for a scalar PDE in 1D, with a second-order flux extrapolation. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Array for storing slopes. + double *slope = (double*) malloc((nx + 4) * sizeof(double)); + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * sizeof(double)); + double *un = (double*) malloc((nx + 4) * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[i] = ~a; // init-func in C. + un[i] = ~a; // init-func in C. + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + double r = (u[i] - u[i - 1]) / (u[i + 1] - u[i]); + double limiter = ~a; // limiter-r in C. + + slope[i] = limiter * (0.5 * ((u[i] - u[i - 1]) + (u[i + 1] - u[i]))); + } + + // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable. + for (int i = 2; i <= nx + 1; i++) { + // Extrapolate boundary states. + double umL = u[i - 1] - (0.5 * slope[i - 1]); + double umR = u[i - 1] + (0.5 * slope[i - 1]); + + double uiL = u[i] - (0.5 * slope[i]); + double uiR = u[i] + (0.5 * slope[i]); + + double upL = u[i + 1] - (0.5 * slope[i + 1]); + double upR = u[i + 1] + (0.5 * slope[i + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL = ~a; + double f_umR = ~a; + + double f_uiL = ~a; + double f_uiR = ~a; + + double f_upL = ~a; + double f_upR = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol = umR + ((dt / (2.0 * dx)) * (f_umL - f_umR)); + + double uiL_evol = uiL + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); + double uiR_evol = uiR + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); + + double upL_evol = upL + ((dt / (2.0 * dx)) * (f_upL - f_upR)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol = ~a; + double f_uiL_evol = ~a; + + double f_uiR_evol = ~a; + double f_upL_evol = ~a; + + // Evaluate flux derivative for each value of the (evolved) conserved variable. + double f_deriv_umR_evol = ~a; + double f_deriv_uiL_evol = ~a; + + double f_deriv_uiR_evol = ~a; + double f_deriv_upL_evol = ~a; + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * |aL_roe| * (u_{i, L+} - u_{i - 1, R+}). + double aL_roe = 0.5 * (f_deriv_umR_evol + f_deriv_uiL_evol); + double fluxL = 0.5 * (f_umR_evol + f_uiL_evol) - 0.5 * fabs(aL_roe) * (uiL_evol - umR_evol); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * |aR_roe| * (u_{i + 1, L+} - u_{i, R+}). + double aR_roe = 0.5 * (f_deriv_uiR_evol + f_deriv_upL_evol); + double fluxR = 0.5 * (f_uiR_evol + f_upL_evol) - 0.5 * fabs(aR_roe) * (upL_evol - uiR_evol); + + // Update the conserved variable. + un[i] = u[i] - (dt / dx) * (fluxR - fluxL); + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + u[i] = un[i]; + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[2]; + u[1] = u[2]; + u[nx + 2] = u[nx + 1]; + u[nx + 3] = u[nx + 1]; + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(un); + free(slope); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expression for local wave-speed estimate. + max-speed-local + ;; Expression for flux limiter function. + limiter-r + ;; Left negative flux f(u_{i - 1, L}). + flux-umL + ;; Right negative flux f(u_{i - 1, R}). + flux-umR + ;; Left central flux f(u_{i, L}). + flux-uiL + ;; Right central flux f(u_{i, R}). + flux-uiR + ;; Left positive flux f(u_{i + 1, L}). + flux-upL + ;; Right positive flux f(u_{i + 1, R}). + flux-upR + ;; Evolved right negative flux f(u_{i - 1, R+}). + flux-umR-evol + ;; Evolved left central flux f(u_{i, L+}). + flux-uiL-evol + ;; Evolved right central flux f(u_{i, R+}). + flux-uiR-evol + ;; Evolved left positive flux f(u_{i + 1, L+}). + flux-upL-evol + ;; Evolved right negative flux derivative f'(u_{i - 1, R+}). + flux-deriv-umR-evol + ;; Evolved left central flux derivative f'(u_{i, L+}). + flux-deriv-uiL-evol + ;; Evolved right central flux derivative f'(u_{i, R+}). + flux-deriv-uiR-evol + ;; Evolved left positive flux derivative f'(u_{i + 1, L+}). + flux-deriv-upL-evol + ;; PDE name for file output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/code_generator_core_2d.rkt b/provable-algorithms/finite_volume/code_generator_core_2d.rkt new file mode 100644 index 00000000..c4fa8361 --- /dev/null +++ b/provable-algorithms/finite_volume/code_generator_core_2d.rkt @@ -0,0 +1,1977 @@ +#lang racket + +(require "prover_core.rkt") +(require "code_generator_core.rkt") +(provide generate-lax-friedrichs-scalar-2d + generate-lax-friedrichs-scalar-2d-second-order + generate-roe-scalar-2d + generate-roe-scalar-2d-second-order) + +;; ------------------------------------------------------------- +;; Lax–Friedrichs (Finite-Difference) Solver for a 2D Scalar PDE +;; ------------------------------------------------------------- +(define (generate-lax-friedrichs-scalar-2d pde + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that solves the 2D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define cons-code (convert-expr cons-expr)) + (define flux-code-x (convert-expr flux-expr-x)) + (define flux-code-y (convert-expr flux-expr-y)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define flux-um-x (flux-substitute flux-code-x cons-code "um_x")) + (define flux-ui-x (flux-substitute flux-code-x cons-code "ui_x")) + (define flux-up-x (flux-substitute flux-code-x cons-code "up_x")) + + (define flux-um-y (flux-substitute flux-code-y cons-code "um_y")) + (define flux-ui-y (flux-substitute flux-code-y cons-code "ui_y")) + (define flux-up-y (flux-substitute flux-code-y cons-code "up_y")) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR SCALAR PDE: ~a +// Lax–Friedrichs first-order finite-difference solver for a scalar PDE in 2D. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + double **un = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * sizeof(double)); + un[i] = (double*) malloc((ny + 2) * sizeof(double)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][j] = ~a; // init-func in C. + un[i][j] = ~a; // init-func in C. + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_y = u[i][j - 1]; + double ui_y = u[i][j]; + double up_y = u[i][j + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um_y = ~a; // f(u_{j - 1}). + double f_ui_y = ~a; // f(u_j). + double f_up_y = ~a; // f(u_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * alpha_y * (u_j - u_{j - 1}). + double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * alpha_y * (ui_y - um_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * alpha_y * (u_{j + 1} - u_j). + double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * alpha_y * (up_y - ui_y); + + // Update the conserved variable. + un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the x-direction. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_x = u[i - 1][j]; + double ui_x = u[i][j]; + double up_x = u[i + 1][j]; + + // Evaluate flux for each value of the conserved variable. + double f_um_x = ~a; // f(u_{i - 1}). + double f_ui_x = ~a; // f(u_i). + double f_up_x = ~a; // f(u_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * alpha_x * (u_i - u_{i - 1}). + double fluxL_x = 0.5 * (f_um_x + f_ui_x) - 0.5 * alpha_x * (ui_x - um_x); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * alpha_x * (u_{i + 1} - u_i). + double fluxR_x = 0.5 * (f_ui_x + f_up_x) - 0.5 * alpha_x * (up_x - ui_x); + + // Update the conserved variable. + un[i][j] = ui_x - (dt / dx) * (fluxR_x - fluxL_x); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_y = u[i][j - 1]; + double ui_y = u[i][j]; + double up_y = u[i][j + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um_y = ~a; // f(u_{j - 1}). + double f_ui_y = ~a; // f(u_j). + double f_up_y = ~a; // f(u_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * alpha_y * (u_j - u_{j - 1}). + double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * alpha_y * (ui_y - um_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * alpha_y * (u_{j + 1} - u_j). + double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * alpha_y * (up_y - ui_y); + + // Update the conserved variable. + un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + free(un[i]); + } + free(u); + free(un); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). + flux-um-y + flux-ui-y + flux-up-y + ;; Left, middle, right fluxes in x-direction f(u_{i - 1}), f(u_i), f(u_{i + 1}). + flux-um-x + flux-ui-x + flux-up-x + ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). + flux-um-y + flux-ui-y + flux-up-y + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------------- +;; Lax–Friedrichs (Finite-Difference) Solver for a 2D Scalar PDE with a Second-Order Flux Extrapolation +;; ---------------------------------------------------------------------------------------------------- +(define (generate-lax-friedrichs-scalar-2d-second-order pde limiter + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that solves the 2D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method with a second-order flux extrapolation using flux limiter `limiter`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define cons-code (convert-expr cons-expr)) + (define flux-code-x (convert-expr flux-expr-x)) + (define flux-code-y (convert-expr flux-expr-y)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umL-x (flux-substitute flux-code-x cons-code "umL_x")) + (define flux-umR-x (flux-substitute flux-code-x cons-code "umR_x")) + (define flux-uiL-x (flux-substitute flux-code-x cons-code "uiL_x")) + (define flux-uiR-x (flux-substitute flux-code-x cons-code "uiR_x")) + (define flux-upL-x (flux-substitute flux-code-x cons-code "upL_x")) + (define flux-upR-x (flux-substitute flux-code-x cons-code "upR_x")) + + (define flux-umR-evol-x (flux-substitute flux-code-x cons-code "umR_evol_x")) + (define flux-uiL-evol-x (flux-substitute flux-code-x cons-code "uiL_evol_x")) + (define flux-uiR-evol-x (flux-substitute flux-code-x cons-code "uiR_evol_x")) + (define flux-upL-evol-x (flux-substitute flux-code-x cons-code "upL_evol_x")) + + (define flux-umL-y (flux-substitute flux-code-y cons-code "umL_y")) + (define flux-umR-y (flux-substitute flux-code-y cons-code "umR_y")) + (define flux-uiL-y (flux-substitute flux-code-y cons-code "uiL_y")) + (define flux-uiR-y (flux-substitute flux-code-y cons-code "uiR_y")) + (define flux-upL-y (flux-substitute flux-code-y cons-code "upL_y")) + (define flux-upR-y (flux-substitute flux-code-y cons-code "upR_y")) + + (define flux-umR-evol-y (flux-substitute flux-code-y cons-code "umR_evol_y")) + (define flux-uiL-evol-y (flux-substitute flux-code-y cons-code "uiL_evol_y")) + (define flux-uiR-evol-y (flux-substitute flux-code-y cons-code "uiR_evol_y")) + (define flux-upL-evol-y (flux-substitute flux-code-y cons-code "upL_evol_y")) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Lax–Friedrichs first-order finite-difference solver for a scalar PDE in 2D, with a second-order flux extrapolation. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing slopes. + double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); + double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + slope_x[i] = (double*) malloc((ny + 4) * sizeof(double)); + slope_y[i] = (double*) malloc((ny + 4) * sizeof(double)); + } + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + double **un = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * sizeof(double)); + un[i] = (double*) malloc((ny + 4) * sizeof(double)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][j] = ~a; // init-func in C. + un[i][j] = ~a; // init-func in C. + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); + } + } + + // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); + double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); + + double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); + double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); + + double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); + double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_y = ~a; + double f_umR_y = ~a; + + double f_uiL_y = ~a; + double f_uiR_y = ~a; + + double f_upL_y = ~a; + double f_upR_y = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); + + double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + + double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_y = ~a; + double f_uiL_evol_y = ~a; + + double f_uiR_evol_y = ~a; + double f_upL_evol_y = ~a; + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * alpha * (u_{j, L+} - u_{j - 1, R+}). + double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * alpha_y * (uiL_evol_y - umR_evol_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * alpha * (u_{j + 1, L+} - u_{j, R+}). + double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * alpha_y * (upL_evol_y - uiR_evol_y); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i - 1][j]) / (u[i + 1][j] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_x[i][j] = limiter * (0.5 * ((u[i][j] - u[i - 1][j]) + (u[i + 1][j] - u[i][j]))); + } + } + + // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the x-direction. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_x = u[i - 1][j] - (0.5 * slope_x[i - 1][j]); + double umR_x = u[i - 1][j] + (0.5 * slope_x[i - 1][j]); + + double uiL_x = u[i][j] - (0.5 * slope_x[i][j]); + double uiR_x = u[i][j] + (0.5 * slope_x[i][j]); + + double upL_x = u[i + 1][j] - (0.5 * slope_x[i + 1][j]); + double upR_x = u[i + 1][j] + (0.5 * slope_x[i + 1][j]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_x = ~a; + double f_umR_x = ~a; + + double f_uiL_x = ~a; + double f_uiR_x = ~a; + + double f_upL_x = ~a; + double f_upR_x = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_x = umR_x + ((dt / (2.0 * dx)) * (f_umL_x - f_umR_x)); + + double uiL_evol_x = uiL_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); + double uiR_evol_x = uiR_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); + + double upL_evol_x = upL_x + ((dt / (2.0 * dx)) * (f_upL_x - f_upR_x)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_x = ~a; + double f_uiL_evol_x = ~a; + + double f_uiR_evol_x = ~a; + double f_upL_evol_x = ~a; + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * alpha * (u_{i, L+} - u_{i - 1, R+}). + double fluxL_x = 0.5 * (f_umR_evol_x + f_uiL_evol_x) - 0.5 * alpha_x * (uiL_evol_x - umR_evol_x); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * alpha * (u_{i + 1, L+} - u_{i, R+}). + double fluxR_x = 0.5 * (f_uiR_evol_x + f_upL_evol_x) - 0.5 * alpha_x * (upL_evol_x - uiR_evol_x); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / dx) * (fluxR_x - fluxL_x); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); + } + } + + // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); + double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); + + double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); + double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); + + double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); + double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_y = ~a; + double f_umR_y = ~a; + + double f_uiL_y = ~a; + double f_uiR_y = ~a; + + double f_upL_y = ~a; + double f_upR_y = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); + + double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + + double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_y = ~a; + double f_uiL_evol_y = ~a; + + double f_uiR_evol_y = ~a; + double f_upL_evol_y = ~a; + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * alpha * (u_{j, L+} - u_{j - 1, R+}). + double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * alpha_y * (uiL_evol_y - umR_evol_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * alpha * (u_{j + 1, L+} - u_{j, R+}). + double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * alpha_y * (upL_evol_y - uiR_evol_y); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + free(un[i]); + free(slope_x[i]); + free(slope_y[i]); + } + free(u); + free(un); + free(slope_x); + free(slope_y); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). + flux-umL-y + flux-umR-y + ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). + flux-uiL-y + flux-uiR-y + ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). + flux-upL-y + flux-upR-y + ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). + flux-umR-evol-y + ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). + flux-uiL-evol-y + flux-uiR-evol-y + ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). + flux-upL-evol-y + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in x-direction f(u_{i - 1, L}), f(u_{i - 1, R}). + flux-umL-x + flux-umR-x + ;; Left/right central fluxes in x-direction f(u_{i, L}), f(u_{i, R}). + flux-uiL-x + flux-uiR-x + ;; Left/right positive fluxes in x-direction f(u_{i + 1, L}), f(u_{i + 1, R}). + flux-upL-x + flux-upR-x + ;; Evolved right negative flux in x-direction f(u_{i - 1, R+}). + flux-umR-evol-x + ;; Evolved left/right central fluxes in x-direction f(u_{i, L+}), f(u_{i, R+}). + flux-uiL-evol-x + flux-uiR-evol-x + ;; Evolved left positive flux in x-direction f(u_{i + 1, L+}). + flux-upL-evol-x + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). + flux-umL-y + flux-umR-y + ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). + flux-uiL-y + flux-uiR-y + ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). + flux-upL-y + flux-upR-y + ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). + flux-umR-evol-y + ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). + flux-uiL-evol-y + flux-uiR-evol-y + ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). + flux-upL-evol-y + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------- +;; Roe (Finite-Volume) Solver for a 2D Scalar PDE +;; ---------------------------------------------- +(define (generate-roe-scalar-2d pde + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that solves the 2D scalar PDE specified by `pde` using the Roe finite-volume method. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) + (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) + + (define cons-code (convert-expr cons-expr)) + (define flux-code-x (convert-expr flux-expr-x)) + (define flux-code-y (convert-expr flux-expr-y)) + (define flux-deriv-code-x (convert-expr flux-deriv-x)) + (define flux-deriv-code-y (convert-expr flux-deriv-y)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define flux-um-x (flux-substitute flux-code-x cons-code "um_x")) + (define flux-ui-x (flux-substitute flux-code-x cons-code "ui_x")) + (define flux-up-x (flux-substitute flux-code-x cons-code "up_x")) + + (define flux-um-y (flux-substitute flux-code-y cons-code "um_y")) + (define flux-ui-y (flux-substitute flux-code-y cons-code "ui_y")) + (define flux-up-y (flux-substitute flux-code-y cons-code "up_y")) + + (define flux-deriv-um-x (flux-substitute flux-deriv-code-x cons-code "um_x")) + (define flux-deriv-ui-x (flux-substitute flux-deriv-code-x cons-code "ui_x")) + (define flux-deriv-up-x (flux-substitute flux-deriv-code-x cons-code "up_x")) + + (define flux-deriv-um-y (flux-substitute flux-deriv-code-y cons-code "um_y")) + (define flux-deriv-ui-y (flux-substitute flux-deriv-code-y cons-code "ui_y")) + (define flux-deriv-up-y (flux-substitute flux-deriv-code-y cons-code "up_y")) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR SCALAR PDE: ~a +// Roe higher-order finite-volume solver for a scalar PDE in 2D. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + double **un = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * sizeof(double)); + un[i] = (double*) malloc((ny + 2) * sizeof(double)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][j] = ~a; // init-func in C. + un[i][j] = ~a; // init-func in C. + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Roe approximation and update the conserved variable in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_y = u[i][j - 1]; + double ui_y = u[i][j]; + double up_y = u[i][j + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um_y = ~a; // f(u_{j - 1}). + double f_ui_y = ~a; // f(u_j). + double f_up_y = ~a; // f(u_{j + 1}). + + // Evaluate flux derivative for each value of the conserved variable. + double f_deriv_um_y = ~a; // f'(u_{j - 1}). + double f_deriv_ui_y = ~a; // f'(u_j). + double f_deriv_up_y = ~a; // f'(u_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * |aL_roe_y| * (u_j - u_{j - 1}). + double aL_roe_y = 0.5 * (f_deriv_um_y + f_deriv_ui_y); + double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * fabs(aL_roe_y) * (ui_y - um_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * |aR_roe_y| * (u_{j + 1} - u_j). + double aR_roe_y = 0.5 * (f_deriv_ui_y + f_deriv_up_y); + double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * fabs(aR_roe_y) * (up_y - ui_y); + + // Update the conserved variable. + un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Compute fluxes with Roe approximation and update the conserved variable in the x-direction. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_x = u[i - 1][j]; + double ui_x = u[i][j]; + double up_x = u[i + 1][j]; + + // Evaluate flux for each value of the conserved variable. + double f_um_x = ~a; // f(u_{i - 1}). + double f_ui_x = ~a; // f(u_i). + double f_up_x = ~a; // f(u_{i + 1}). + + // Evaluate flux derivative for each value of the conserved variable. + double f_deriv_um_x = ~a; // f'(u_{i - 1}). + double f_deriv_ui_x = ~a; // f'(u_i). + double f_deriv_up_x = ~a; // f'(u_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * |aL_roe_x| * (u_i - u_{i - 1}). + double aL_roe_x = 0.5 * (f_deriv_um_x + f_deriv_ui_x); + double fluxL_x = 0.5 * (f_um_x + f_ui_x) - 0.5 * fabs(aL_roe_x) * (ui_x - um_x); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * |aR_roe_x| * (u_{i + 1} - u_i). + double aR_roe_x = 0.5 * (f_deriv_ui_x + f_deriv_up_x); + double fluxR_x = 0.5 * (f_ui_x + f_up_x) - 0.5 * fabs(aR_roe_x) * (up_x - ui_x); + + // Update the conserved variable. + un[i][j] = ui_x - (dt / dx) * (fluxR_x - fluxL_x); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Compute fluxes with Roe approximation and update the conserved variable in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_y = u[i][j - 1]; + double ui_y = u[i][j]; + double up_y = u[i][j + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um_y = ~a; // f(u_{j - 1}). + double f_ui_y = ~a; // f(u_j). + double f_up_y = ~a; // f(u_{j + 1}). + + // Evaluate flux derivative for each value of the conserved variable. + double f_deriv_um_y = ~a; // f'(u_{j - 1}). + double f_deriv_ui_y = ~a; // f'(u_j). + double f_deriv_up_y = ~a; // f'(u_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * |aL_roe_y| * (u_j - u_{j - 1}). + double aL_roe_y = 0.5 * (f_deriv_um_y + f_deriv_ui_y); + double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * fabs(aL_roe_y) * (ui_y - um_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * |aR_roe_y| * (u_{j + 1} - u_j). + double aR_roe_y = 0.5 * (f_deriv_ui_y + f_deriv_up_y); + double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * fabs(aR_roe_y) * (up_y - ui_y); + + // Update the conserved variable. + un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + free(un[i]); + } + free(u); + free(un); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). + flux-um-y + flux-ui-y + flux-up-y + ;; Left, middle, right flux derivatives in y-direction f'(u_{j - 1}), f'(u_j), f'(u_{j + 1}). + flux-deriv-um-y + flux-deriv-ui-y + flux-deriv-up-y + ;; Left, middle, right fluxes in x-direction f(u_{i - 1}), f(u_i), f(u_{i + 1}). + flux-um-x + flux-ui-x + flux-up-x + ;; Left, middle, right flux derivatives in x-direction f'(u_{i - 1}), f'(u_i), f'(u_{i + 1}). + flux-deriv-um-x + flux-deriv-ui-x + flux-deriv-up-x + ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). + flux-um-y + flux-ui-y + flux-up-y + ;; Left, middle, right flux derivatives in y-direction f'(u_{j - 1}), f'(u_j), f'(u_{j + 1}). + flux-deriv-um-y + flux-deriv-ui-y + flux-deriv-up-y + ;; PDE name for file output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------- +;; Roe (Finite-Volume) Solver for a 2D Scalar PDE with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------- +(define (generate-roe-scalar-2d-second-order pde limiter + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that solves the 2D scalar PDE specified by `pde` using the Roe finite-volume method with a second-order flux extrapolation using flux limiter `limiter`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) + (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) + + (define cons-code (convert-expr cons-expr)) + (define flux-code-x (convert-expr flux-expr-x)) + (define flux-code-y (convert-expr flux-expr-y)) + (define flux-deriv-code-x (convert-expr flux-deriv-x)) + (define flux-deriv-code-y (convert-expr flux-deriv-y)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umL-x (flux-substitute flux-code-x cons-code "umL_x")) + (define flux-umR-x (flux-substitute flux-code-x cons-code "umR_x")) + (define flux-uiL-x (flux-substitute flux-code-x cons-code "uiL_x")) + (define flux-uiR-x (flux-substitute flux-code-x cons-code "uiR_x")) + (define flux-upL-x (flux-substitute flux-code-x cons-code "upL_x")) + (define flux-upR-x (flux-substitute flux-code-x cons-code "upR_x")) + + (define flux-umR-evol-x (flux-substitute flux-code-x cons-code "umR_evol_x")) + (define flux-uiL-evol-x (flux-substitute flux-code-x cons-code "uiL_evol_x")) + (define flux-uiR-evol-x (flux-substitute flux-code-x cons-code "uiR_evol_x")) + (define flux-upL-evol-x (flux-substitute flux-code-x cons-code "upL_evol_x")) + + (define flux-deriv-umR-evol-x (flux-substitute flux-deriv-code-x cons-code "umR_evol_x")) + (define flux-deriv-uiL-evol-x (flux-substitute flux-deriv-code-x cons-code "uiL_evol_x")) + (define flux-deriv-uiR-evol-x (flux-substitute flux-deriv-code-x cons-code "uiR_evol_x")) + (define flux-deriv-upL-evol-x (flux-substitute flux-deriv-code-x cons-code "upL_evol_x")) + + (define flux-umL-y (flux-substitute flux-code-y cons-code "umL_y")) + (define flux-umR-y (flux-substitute flux-code-y cons-code "umR_y")) + (define flux-uiL-y (flux-substitute flux-code-y cons-code "uiL_y")) + (define flux-uiR-y (flux-substitute flux-code-y cons-code "uiR_y")) + (define flux-upL-y (flux-substitute flux-code-y cons-code "upL_y")) + (define flux-upR-y (flux-substitute flux-code-y cons-code "upR_y")) + + (define flux-umR-evol-y (flux-substitute flux-code-y cons-code "umR_evol_y")) + (define flux-uiL-evol-y (flux-substitute flux-code-y cons-code "uiL_evol_y")) + (define flux-uiR-evol-y (flux-substitute flux-code-y cons-code "uiR_evol_y")) + (define flux-upL-evol-y (flux-substitute flux-code-y cons-code "upL_evol_y")) + + (define flux-deriv-umR-evol-y (flux-substitute flux-deriv-code-y cons-code "umR_evol_y")) + (define flux-deriv-uiL-evol-y (flux-substitute flux-deriv-code-y cons-code "uiL_evol_y")) + (define flux-deriv-uiR-evol-y (flux-substitute flux-deriv-code-y cons-code "uiR_evol_y")) + (define flux-deriv-upL-evol-y (flux-substitute flux-deriv-code-y cons-code "upL_evol_y")) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Roe higher-order finite-volume solver for a scalar PDE in 2D, with a second-order flux extrapolation. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing slopes. + double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); + double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + slope_x[i] = (double*) malloc((ny + 4) * sizeof(double)); + slope_y[i] = (double*) malloc((ny + 4) * sizeof(double)); + } + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + double **un = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * sizeof(double)); + un[i] = (double*) malloc((ny + 4) * sizeof(double)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][j] = ~a; // init-func in C. + un[i][j] = ~a; // init-func in C. + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); + } + } + + // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); + double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); + + double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); + double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); + + double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); + double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_y = ~a; + double f_umR_y = ~a; + + double f_uiL_y = ~a; + double f_uiR_y = ~a; + + double f_upL_y = ~a; + double f_upR_y = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); + + double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + + double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_y = ~a; + double f_uiL_evol_y = ~a; + + double f_uiR_evol_y = ~a; + double f_upL_evol_y = ~a; + + // Evaluate flux derivative for each value of the (evolved) conserved variable. + double f_deriv_umR_evol_y = ~a; + double f_deriv_uiL_evol_y = ~a; + + double f_deriv_uiR_evol_y = ~a; + double f_deriv_upL_evol_y = ~a; + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * |aL_roe_y| * (u_{j, L+} - u_{j - 1, R+}). + double aL_roe_y = 0.5 * (f_deriv_umR_evol_y + f_deriv_uiL_evol_y); + double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * fabs(aL_roe_y) * (uiL_evol_y - umR_evol_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * |aR_roe_y| * (u_{j + 1, L+} - u_{j, R+}). + double aR_roe_y = 0.5 * (f_deriv_uiR_evol_y + f_deriv_upL_evol_y); + double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * fabs(aR_roe_y) * (upL_evol_y - uiR_evol_y); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i - 1][j]) / (u[i + 1][j] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_x[i][j] = limiter * (0.5 * ((u[i][j] - u[i - 1][j]) + (u[i + 1][j] - u[i][j]))); + } + } + + // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the x-direction. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_x = u[i - 1][j] - (0.5 * slope_x[i - 1][j]); + double umR_x = u[i - 1][j] + (0.5 * slope_x[i - 1][j]); + + double uiL_x = u[i][j] - (0.5 * slope_x[i][j]); + double uiR_x = u[i][j] + (0.5 * slope_x[i][j]); + + double upL_x = u[i + 1][j] - (0.5 * slope_x[i + 1][j]); + double upR_x = u[i + 1][j] + (0.5 * slope_x[i + 1][j]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_x = ~a; + double f_umR_x = ~a; + + double f_uiL_x = ~a; + double f_uiR_x = ~a; + + double f_upL_x = ~a; + double f_upR_x = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_x = umR_x + ((dt / (2.0 * dx)) * (f_umL_x - f_umR_x)); + + double uiL_evol_x = uiL_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); + double uiR_evol_x = uiR_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); + + double upL_evol_x = upL_x + ((dt / (2.0 * dx)) * (f_upL_x - f_upR_x)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_x = ~a; + double f_uiL_evol_x = ~a; + + double f_uiR_evol_x = ~a; + double f_upL_evol_x = ~a; + + // Evaluate flux derivative for each value of the (evolved) conserved variable. + double f_deriv_umR_evol_x = ~a; + double f_deriv_uiL_evol_x = ~a; + + double f_deriv_uiR_evol_x = ~a; + double f_deriv_upL_evol_x = ~a; + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * |aL_roe_x| * (u_{i, L+} - u_{i - 1, R+}). + double aL_roe_x = 0.5 * (f_deriv_umR_evol_x + f_deriv_uiL_evol_x); + double fluxL_x = 0.5 * (f_umR_evol_x + f_uiL_evol_x) - 0.5 * fabs(aL_roe_x) * (uiL_evol_x - umR_evol_x); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * |aR_roe_x| * (u_{i + 1, L+} - u_{i, R+}). + double aR_roe_x = 0.5 * (f_deriv_uiR_evol_x + f_deriv_upL_evol_x); + double fluxR_x = 0.5 * (f_uiR_evol_x + f_upL_evol_x) - 0.5 * fabs(aR_roe_x) * (upL_evol_x - uiR_evol_x); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / dx) * (fluxR_x - fluxL_x); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); + } + } + + // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); + double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); + + double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); + double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); + + double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); + double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_y = ~a; + double f_umR_y = ~a; + + double f_uiL_y = ~a; + double f_uiR_y = ~a; + + double f_upL_y = ~a; + double f_upR_y = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); + + double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + + double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_y = ~a; + double f_uiL_evol_y = ~a; + + double f_uiR_evol_y = ~a; + double f_upL_evol_y = ~a; + + // Evaluate flux derivative for each value of the (evolved) conserved variable. + double f_deriv_umR_evol_y = ~a; + double f_deriv_uiL_evol_y = ~a; + + double f_deriv_uiR_evol_y = ~a; + double f_deriv_upL_evol_y = ~a; + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * |aL_roe_y| * (u_{j, L+} - u_{j - 1, R+}). + double aL_roe_y = 0.5 * (f_deriv_umR_evol_y + f_deriv_uiL_evol_y); + double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * fabs(aL_roe_y) * (uiL_evol_y - umR_evol_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * |aR_roe_y| * (u_{j + 1, L+} - u_{j, R+}). + double aR_roe_y = 0.5 * (f_deriv_uiR_evol_y + f_deriv_upL_evol_y); + double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * fabs(aR_roe_y) * (upL_evol_y - uiR_evol_y); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + free(un[i]); + free(slope_x[i]); + free(slope_y[i]); + } + free(u); + free(un); + free(slope_x); + free(slope_y); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). + flux-umL-y + flux-umR-y + ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). + flux-uiL-y + flux-uiR-y + ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). + flux-upL-y + flux-upR-y + ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). + flux-umR-evol-y + ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). + flux-uiL-evol-y + flux-uiR-evol-y + ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). + flux-upL-evol-y + ;; Evolved right negative flux derivative in y-direction f'(u_{j - 1, R+}). + flux-deriv-umR-evol-y + ;; Evolved left/right central flux derivatives in y-direction f'(u_{j, L+}), f(u_{j, R+}). + flux-deriv-uiL-evol-y + flux-deriv-uiR-evol-y + ;; Evolved left positive flux derivative in y-direction f'(u_{j + 1, L+}). + flux-deriv-upL-evol-y + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in x-direction f(u_{i - 1, L}), f(u_{i - 1, R}). + flux-umL-x + flux-umR-x + ;; Left/right central fluxes in x-direction f(u_{i, L}), f(u_{i, R}). + flux-uiL-x + flux-uiR-x + ;; Left/right positive fluxes in x-direction f(u_{i + 1, L}), f(u_{i + 1, R}). + flux-upL-x + flux-upR-x + ;; Evolved right negative flux in x-direction f(u_{i - 1, R+}). + flux-umR-evol-x + ;; Evolved left/right central fluxes in x-direction f(u_{i, L+}), f(u_{i, R+}). + flux-uiL-evol-x + flux-uiR-evol-x + ;; Evolved left positive flux in x-direction f(u_{i + 1, L+}). + flux-upL-evol-x + ;; Evolved right negative flux derivative in x-direction f'(u_{i - 1, R+}). + flux-deriv-umR-evol-x + ;; Evolved left/right central flux derivatives in x-direction f'(u_{i, L+}), f(u_{i, R+}). + flux-deriv-uiL-evol-x + flux-deriv-uiR-evol-x + ;; Evolved left positive flux derivative in x-direction f'(u_{i + 1, L+}). + flux-deriv-upL-evol-x + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). + flux-umL-y + flux-umR-y + ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). + flux-uiL-y + flux-uiR-y + ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). + flux-upL-y + flux-upR-y + ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). + flux-umR-evol-y + ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). + flux-uiL-evol-y + flux-uiR-evol-y + ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). + flux-upL-evol-y + ;; Evolved right negative flux derivative in y-direction f'(u_{j - 1, R+}). + flux-deriv-umR-evol-y + ;; Evolved left/right central flux derivatives in y-direction f'(u_{j, L+}), f(u_{j, R+}). + flux-deriv-uiL-evol-y + flux-deriv-uiR-evol-y + ;; Evolved left positive flux derivative in y-direction f'(u_{j + 1, L+}). + flux-deriv-upL-evol-y + ;; PDE name for file output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/code_generator_vector.rkt b/provable-algorithms/finite_volume/code_generator_vector.rkt new file mode 100644 index 00000000..dc9af122 --- /dev/null +++ b/provable-algorithms/finite_volume/code_generator_vector.rkt @@ -0,0 +1,1467 @@ +#lang racket + +(require "prover_core.rkt") +(require "prover_vector.rkt") +(require "code_generator_core.rkt") +(provide generate-lax-friedrichs-vector2-1d + generate-lax-friedrichs-vector2-1d-second-order + generate-roe-vector2-1d + generate-roe-vector2-1d-second-order) + +;; ---------------------------------------------------------------------------------- +;; Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; ---------------------------------------------------------------------------------- +(define (generate-lax-friedrichs-vector2-1d pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") + (list-ref cons-codes 1) "um[1]")) flux-codes)) + (define flux-uis (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") + (list-ref cons-codes 1) "ui[1]")) flux-codes)) + (define flux-ups (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") + (list-ref cons-codes 1) "up[1]")) flux-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a +// Lax–Friedrichs first-order finite-difference solver for a coupled vector system of 2 PDEs in 1D. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); + double *un = (double*) malloc((nx + 2) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + double *um = (double*) malloc(2 * sizeof(double)); + double *ui = (double*) malloc(2 * sizeof(double)); + double *up = (double*) malloc(2 * sizeof(double)); + + double *f_um = (double*) malloc(2 * sizeof(double)); + double *f_ui = (double*) malloc(2 * sizeof(double)); + double *f_up = (double*) malloc(2 * sizeof(double)); + + double *fluxL = (double*) malloc(2 * sizeof(double)); + double *fluxR = (double*) malloc(2 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + un[(i * 2) + 0] = ~a; // init-funcs[0] in C. + un[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. + for (int i = 1; i <= nx; i++) { + for (int j = 0; j < 2; j++) { + um[j] = u[((i - 1) * 2) + j]; + ui[j] = u[(i * 2) + j]; + up[j] = u[((i + 1) * 2) + j]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um[0] = ~a; + f_um[1] = ~a; // F(U_{i - 1}). + + f_ui[0] = ~a; + f_ui[1] = ~a; // F(U_i). + + f_up[0] = ~a; + f_up[1] = ~a; // F(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha * (U_i - U_{i - 1}). + for (int j = 0; j < 2; j++) { + fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * alpha * (ui[j] - um[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha * (U_{i + 1} - U_i). + for (int j = 0; j < 2; j++) { + fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * alpha * (up[j] - ui[j]); + } + + // Update the conserved variable vector. + for (int j = 0; j < 2; j++) { + un[(i * 2) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j < 2; j++) { + u[(i * 2) + j] = un[(i * 2) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(1 * 2) + j]; + u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(un); + + free(local_alpha); + + free(um); + free(ui); + free(up); + + free(f_um); + free(f_ui); + free(f_up); + + free(fluxL); + free(fluxR); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; Left flux vector F(u_{i - 1}). + (list-ref flux-ums 0) + (list-ref flux-ums 1) + ;; Middle flux vector F(u_i). + (list-ref flux-uis 0) + (list-ref flux-uis 1) + ;; Right flux vector F(u_{i + 1}). + (list-ref flux-ups 0) + (list-ref flux-ups 1) + ;; PDE name for file output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------------------------------- +;; Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------------------------------------------- +(define (generate-lax-friedrichs-vector2-1d-second-order pde-system limiter + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method with a + second-order flux extrapolation using flux limiter `limiter`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") + (list-ref cons-codes 1) "umL[1]")) flux-codes)) + (define flux-umRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") + (list-ref cons-codes 1) "umR[1]")) flux-codes)) + (define flux-uiLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") + (list-ref cons-codes 1) "uiL[1]")) flux-codes)) + (define flux-uiRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") + (list-ref cons-codes 1) "uiR[1]")) flux-codes)) + (define flux-upLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") + (list-ref cons-codes 1) "upL[1]")) flux-codes)) + (define flux-upRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") + (list-ref cons-codes 1) "upR[1]")) flux-codes)) + + (define flux-umR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") + (list-ref cons-codes 1) "umR_evol[1]")) flux-codes)) + (define flux-uiL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") + (list-ref cons-codes 1) "uiL_evol[1]")) flux-codes)) + (define flux-uiR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") + (list-ref cons-codes 1) "uiR_evol[1]")) flux-codes)) + (define flux-upL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") + (list-ref cons-codes 1) "upL_evol[1]")) flux-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Lax–Friedrichs first-order finite-difference solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Array for storing slopes. + double *slope = (double*) malloc((nx + 4) * 2 * sizeof(double)); + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); + double *un = (double*) malloc((nx + 4) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + double *umL = (double*) malloc(2 * sizeof(double)); + double *umR = (double*) malloc(2 * sizeof(double)); + double *uiL = (double*) malloc(2 * sizeof(double)); + double *uiR = (double*) malloc(2 * sizeof(double)); + double *upL = (double*) malloc(2 * sizeof(double)); + double *upR = (double*) malloc(2 * sizeof(double)); + + double *f_umL = (double*) malloc(2 * sizeof(double)); + double *f_umR = (double*) malloc(2 * sizeof(double)); + double *f_uiL = (double*) malloc(2 * sizeof(double)); + double *f_uiR = (double*) malloc(2 * sizeof(double)); + double *f_upL = (double*) malloc(2 * sizeof(double)); + double *f_upR = (double*) malloc(2 * sizeof(double)); + + double *umR_evol = (double*) malloc(2 * sizeof(double)); + double *uiL_evol = (double*) malloc(2 * sizeof(double)); + double *uiR_evol = (double*) malloc(2 * sizeof(double)); + double *upL_evol = (double*) malloc(2 * sizeof(double)); + + double *f_umR_evol = (double*) malloc(2 * sizeof(double)); + double *f_uiL_evol = (double*) malloc(2 * sizeof(double)); + double *f_uiR_evol = (double*) malloc(2 * sizeof(double)); + double *f_upL_evol = (double*) malloc(2 * sizeof(double)); + + double *fluxL = (double*) malloc(2 * sizeof(double)); + double *fluxR = (double*) malloc(2 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + un[(i * 2) + 0] = ~a; // init-funcs[0] in C. + un[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 0; j < 2; j++) { + double r = (u[(i * 2) + j] - u[((i - 1) * 2) + j]) / (u[((i + 1) * 2) + j] - u[(i * 2) + j]); + double limiter = ~a; // limiter-r in C. + + slope[(i * 2) + j] = limiter * (0.5 * ((u[(i * 2) + j] - u[((i - 1) * 2) + j]) + (u[((i + 1) * 2) + j] - u[(i * 2) + j]))); + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. + for (int i = 2; i <= nx + 1; i++) { + // Extrapolate boundary states. + for (int j = 0; j < 2; j++) { + umL[j] = u[((i - 1) * 2) + j] - (0.5 * slope[((i - 1) * 2) + j]); + umR[j] = u[((i - 1) * 2) + j] + (0.5 * slope[((i - 1) * 2) + j]); + + uiL[j] = u[(i * 2) + j] - (0.5 * slope[(i * 2) + j]); + uiR[j] = u[(i * 2) + j] + (0.5 * slope[(i * 2) + j]); + + upL[j] = u[((i + 1) * 2) + j] - (0.5 * slope[((i + 1) * 2) + j]); + upR[j] = u[((i + 1) * 2) + j] + (0.5 * slope[((i + 1) * 2) + j]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL[0] = ~a; + f_umL[1] = ~a; + f_umR[0] = ~a; + f_umR[1] = ~a; + + f_uiL[0] = ~a; + f_uiL[1] = ~a; + f_uiR[0] = ~a; + f_uiR[1] = ~a; + + f_upL[0] = ~a; + f_upL[1] = ~a; + f_upR[0] = ~a; + f_upR[1] = ~a; + + // Evolve each extrapolated boundary state. + for (int j = 0; j < 2; j++) { + umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); + + uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + + upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol[0] = ~a; + f_umR_evol[1] = ~a; // F(U_{i - 1, R+}) + f_uiL_evol[0] = ~a; + f_uiL_evol[1] = ~a; // F(U_{i, L+}) + + f_uiR_evol[0] = ~a; + f_uiR_evol[1] = ~a; // F(U_{i, R+}) + f_upL_evol[0] = ~a; + f_upL_evol[1] = ~a; // F(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha * (U_{i, L+} - U_{i - 1, R+}). + for (int j = 0; j < 2; j++) { + fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * alpha * (uiL_evol[j] - umR_evol[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha * (U_{i + 1, L+} - U_{i, R+}). + for (int j = 0; j < 2; j++) { + fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * alpha * (upL_evol[j] - uiR_evol[j]); + } + + // Update the conserved variable vector. + for (int j = 0; j < 2; j++) { + un[(i * 2) + j] = u[(i * 2) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j < 2; j++) { + u[(i * 2) + j] = un[(i * 2) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(2 * 2) + j]; + u[(1 * 2) + j] = u[(2 * 2) + j]; + u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; + u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(un); + free(slope); + + free(local_alpha); + + free(umL); + free(umR); + free(uiL); + free(uiR); + free(upL); + free(upR); + + free(f_umL); + free(f_umR); + free(f_uiL); + free(f_uiR); + free(f_upL); + free(f_upR); + + free(umR_evol); + free(uiL_evol); + free(uiR_evol); + free(upL_evol); + + free(f_umR_evol); + free(f_uiL_evol); + free(f_uiR_evol); + free(f_upL_evol); + + free(fluxL); + free(fluxR); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; Expression for flux limiter function. + limiter-r + ;; Left negative flux vector F(U_{i - 1, L}). + (list-ref flux-umLs 0) + (list-ref flux-umLs 1) + ;; Right negative flux vector F(U_{i - 1, R}). + (list-ref flux-umRs 0) + (list-ref flux-umRs 1) + ;; Left central flux vector F(U_{i, L}). + (list-ref flux-uiLs 0) + (list-ref flux-uiLs 1) + ;; Right central flux vector F(U_{i, R}). + (list-ref flux-uiRs 0) + (list-ref flux-uiRs 1) + ;; Left positive flux vector F(U_{i + 1, L}). + (list-ref flux-upLs 0) + (list-ref flux-upLs 1) + ;; Right positive flux vector F(U_{i + 1, R}). + (list-ref flux-upRs 0) + (list-ref flux-upRs 1) + ;; Evolved right negative flux vector F(U_{i - 1, R+}). + (list-ref flux-umR-evols 0) + (list-ref flux-umR-evols 1) + ;; Evolved left central flux vector F(U_{i, L+}). + (list-ref flux-uiL-evols 0) + (list-ref flux-uiL-evols 1) + ;; Evolved right central flux vector F(U_{i, R+}). + (list-ref flux-uiR-evols 0) + (list-ref flux-uiR-evols 1) + ;; Evolved left positive flux vector F(U_{i + 1, L+}). + (list-ref flux-upL-evols 0) + (list-ref flux-upL-evols 1) + ;; PDE name for file output. + name + name + )) + code) + +;; ------------------------------------------------------------------- +;; Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------- +(define (generate-roe-vector2-1d pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define flux-deriv-codes (map (lambda (flux-deriv-expr) + (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") + (list-ref cons-codes 1) "um[1]")) flux-codes)) + (define flux-uis (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") + (list-ref cons-codes 1) "ui[1]")) flux-codes)) + (define flux-ups (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") + (list-ref cons-codes 1) "up[1]")) flux-codes)) + + (define flux-deriv-ums (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "um[0]") + (list-ref cons-codes 1) "um[1]")) flux-deriv-codes)) + (define flux-deriv-uis (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "ui[0]") + (list-ref cons-codes 1) "ui[1]")) flux-deriv-codes)) + (define flux-deriv-ups (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "up[0]") + (list-ref cons-codes 1) "up[1]")) flux-deriv-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a +// Roe higher-order finite-volume solver for a coupled vector system of 2 PDEs in 1D. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); + double *un = (double*) malloc((nx + 2) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + double *um = (double*) malloc(2 * sizeof(double)); + double *ui = (double*) malloc(2 * sizeof(double)); + double *up = (double*) malloc(2 * sizeof(double)); + + double *f_um = (double*) malloc(2 * sizeof(double)); + double *f_ui = (double*) malloc(2 * sizeof(double)); + double *f_up = (double*) malloc(2 * sizeof(double)); + + double *f_deriv_um = (double*) malloc(2 * sizeof(double)); + double *f_deriv_ui = (double*) malloc(2 * sizeof(double)); + double *f_deriv_up = (double*) malloc(2 * sizeof(double)); + + double *aL_roe = (double*) malloc(2 * sizeof(double)); + double *aR_roe = (double*) malloc(2 * sizeof(double)); + + double *fluxL = (double*) malloc(2 * sizeof(double)); + double *fluxR = (double*) malloc(2 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + un[(i * 2) + 0] = ~a; // init-funcs[0] in C. + un[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Roe approximation and update the conserved variable vector. + for (int i = 1; i <= nx; i++) { + for (int j = 0; j < 2; j++) { + um[j] = u[((i - 1) * 2) + j]; + ui[j] = u[(i * 2) + j]; + up[j] = u[((i + 1) * 2) + j]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um[0] = ~a; + f_um[1] = ~a; // F(U_{i - 1}). + + f_ui[0] = ~a; + f_ui[1] = ~a; // F(U_i). + + f_up[0] = ~a; + f_up[1] = ~a; // F(U_{i + 1}). + + // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. + f_deriv_um[0] = ~a; + f_deriv_um[1] = ~a; // Eigenvalues of F'(U_{i - 1}). + + f_deriv_ui[0] = ~a; + f_deriv_ui[1] = ~a; // Eigenvalues of F'(U_i). + + f_deriv_up[0] = ~a; + f_deriv_up[1] = ~a; // Eigenvalues of F'(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * |aL_roe| * (U_i - U_{i - 1}). + for (int j = 0; j < 2; j++) { + aL_roe[j] = 0.5 * (f_deriv_um[j] + f_deriv_ui[j]); + } + for (int j = 0; j < 2; j++) { + fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * fabs(aL_roe[j]) * (ui[j] - um[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * |aR_roe| * (U_{i + 1} - u_i). + for (int j = 0; j < 2; j++) { + aR_roe[j] = 0.5 * (f_deriv_ui[j] + f_deriv_up[j]); + } + for (int j = 0; j < 2; j++) { + fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * fabs(aR_roe[j]) * (up[j] - ui[j]); + } + + // Update the conserved variable. + for (int j = 0; j < 2; j++) { + un[(i * 2) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j < 2; j++) { + u[(i * 2) + j] = un[(i * 2) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(1 * 2) + j]; + u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(un); + + free(local_alpha); + + free(um); + free(ui); + free(up); + + free(f_um); + free(f_ui); + free(f_up); + + free(f_deriv_um); + free(f_deriv_ui); + free(f_deriv_up); + + free(aL_roe); + free(aR_roe); + + free(fluxL); + free(fluxR); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; Left flux vector F(u_{i - 1}). + (list-ref flux-ums 0) + (list-ref flux-ums 1) + ;; Middle flux vector F(u_i). + (list-ref flux-uis 0) + (list-ref flux-uis 1) + ;; Right flux vector F(u_{i + 1}). + (list-ref flux-ups 0) + (list-ref flux-ups 1) + ;; Eigenvalues of left flux Jacobian F'(u_{i - 1}). + (list-ref flux-deriv-ums 0) + (list-ref flux-deriv-ums 1) + ;; Eigenvalues of middle flux Jacobian F'(u_i). + (list-ref flux-deriv-uis 0) + (list-ref flux-deriv-uis 1) + ;; Eigenvalues of right flux Jacobian F'(u_{i + 1}). + (list-ref flux-deriv-ups 0) + (list-ref flux-deriv-ups 1) + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------------------- +;; Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs with a Second-Order Flux Extrapolation +;; ---------------------------------------------------------------------------------------------------------- +(define (generate-roe-vector2-1d-second-order pde-system limiter + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method with a + second-order flux extrapolation using flux limiter `limiter`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define flux-deriv-codes (map (lambda (flux-deriv-expr) + (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") + (list-ref cons-codes 1) "umL[1]")) flux-codes)) + (define flux-umRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") + (list-ref cons-codes 1) "umR[1]")) flux-codes)) + (define flux-uiLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") + (list-ref cons-codes 1) "uiL[1]")) flux-codes)) + (define flux-uiRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") + (list-ref cons-codes 1) "uiR[1]")) flux-codes)) + (define flux-upLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") + (list-ref cons-codes 1) "upL[1]")) flux-codes)) + (define flux-upRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") + (list-ref cons-codes 1) "upR[1]")) flux-codes)) + + (define flux-umR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") + (list-ref cons-codes 1) "umR_evol[1]")) flux-codes)) + (define flux-uiL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") + (list-ref cons-codes 1) "uiL_evol[1]")) flux-codes)) + (define flux-uiR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") + (list-ref cons-codes 1) "uiR_evol[1]")) flux-codes)) + (define flux-upL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") + (list-ref cons-codes 1) "upL_evol[1]")) flux-codes)) + + (define flux-deriv-umR-evols (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "umR_evol[0]") + (list-ref cons-codes 1) "umR_evol[1]")) flux-deriv-codes)) + (define flux-deriv-uiL-evols (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "uiL_evol[0]") + (list-ref cons-codes 1) "uiL_evol[1]")) flux-deriv-codes)) + (define flux-deriv-uiR-evols (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "uiR_evol[0]") + (list-ref cons-codes 1) "uiR_evol[1]")) flux-deriv-codes)) + (define flux-deriv-upL-evols (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "upL_evol[0]") + (list-ref cons-codes 1) "upL_evol[1]")) flux-deriv-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Roe higher-order finite-volume solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Array for storing slopes. + double *slope = (double*) malloc((nx + 4) * 2 * sizeof(double)); + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); + double *un = (double*) malloc((nx + 4) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + double *umL = (double*) malloc(2 * sizeof(double)); + double *umR = (double*) malloc(2 * sizeof(double)); + double *uiL = (double*) malloc(2 * sizeof(double)); + double *uiR = (double*) malloc(2 * sizeof(double)); + double *upL = (double*) malloc(2 * sizeof(double)); + double *upR = (double*) malloc(2 * sizeof(double)); + + double *f_umL = (double*) malloc(2 * sizeof(double)); + double *f_umR = (double*) malloc(2 * sizeof(double)); + double *f_uiL = (double*) malloc(2 * sizeof(double)); + double *f_uiR = (double*) malloc(2 * sizeof(double)); + double *f_upL = (double*) malloc(2 * sizeof(double)); + double *f_upR = (double*) malloc(2 * sizeof(double)); + + double *umR_evol = (double*) malloc(2 * sizeof(double)); + double *uiL_evol = (double*) malloc(2 * sizeof(double)); + double *uiR_evol = (double*) malloc(2 * sizeof(double)); + double *upL_evol = (double*) malloc(2 * sizeof(double)); + + double *f_umR_evol = (double*) malloc(2 * sizeof(double)); + double *f_uiL_evol = (double*) malloc(2 * sizeof(double)); + double *f_uiR_evol = (double*) malloc(2 * sizeof(double)); + double *f_upL_evol = (double*) malloc(2 * sizeof(double)); + + double *f_deriv_umR_evol = (double*) malloc(2 * sizeof(double)); + double *f_deriv_uiL_evol = (double*) malloc(2 * sizeof(double)); + double *f_deriv_uiR_evol = (double*) malloc(2 * sizeof(double)); + double *f_deriv_upL_evol = (double*) malloc(2 * sizeof(double)); + + double *aL_roe = (double*) malloc(2 * sizeof(double)); + double *aR_roe = (double*) malloc(2 * sizeof(double)); + + double *fluxL = (double*) malloc(2 * sizeof(double)); + double *fluxR = (double*) malloc(2 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + un[(i * 2) + 0] = ~a; // init-funcs[0] in C. + un[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 0; j < 2; j++) { + double r = (u[(i * 2) + j] - u[((i - 1) * 2) + j]) / (u[((i + 1) * 2) + j] - u[(i * 2) + j]); + double limiter = ~a; // limiter-r in C. + + slope[(i * 2) + j] = limiter * (0.5 * ((u[(i * 2) + j] - u[((i - 1) * 2) + j]) + (u[((i + 1) * 2) + j] - u[(i * 2) + j]))); + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector. + for (int i = 2; i <= nx + 1; i++) { + // Extrapolate boundary states. + for (int j = 0; j < 2; j++) { + umL[j] = u[((i - 1) * 2) + j] - (0.5 * slope[((i - 1) * 2) + j]); + umR[j] = u[((i - 1) * 2) + j] + (0.5 * slope[((i - 1) * 2) + j]); + + uiL[j] = u[(i * 2) + j] - (0.5 * slope[(i * 2) + j]); + uiR[j] = u[(i * 2) + j] + (0.5 * slope[(i * 2) + j]); + + upL[j] = u[((i + 1) * 2) + j] - (0.5 * slope[((i + 1) * 2) + j]); + upR[j] = u[((i + 1) * 2) + j] + (0.5 * slope[((i + 1) * 2) + j]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL[0] = ~a; + f_umL[1] = ~a; + f_umR[0] = ~a; + f_umR[1] = ~a; + + f_uiL[0] = ~a; + f_uiL[1] = ~a; + f_uiR[0] = ~a; + f_uiR[1] = ~a; + + f_upL[0] = ~a; + f_upL[1] = ~a; + f_upR[0] = ~a; + f_upR[1] = ~a; + + // Evolve each extrapolated boundary state. + for (int j = 0; j < 2; j++) { + umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); + + uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + + upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol[0] = ~a; + f_umR_evol[1] = ~a; // F(U_{i - 1, R+}) + f_uiL_evol[0] = ~a; + f_uiL_evol[1] = ~a; // F(U_{i, L+}) + + f_uiR_evol[0] = ~a; + f_uiR_evol[1] = ~a; // F(U_{i, R+}) + f_upL_evol[0] = ~a; + f_upL_evol[1] = ~a; // F(U_{i + 1, L+}) + + // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. + f_deriv_umR_evol[0] = ~a; + f_deriv_umR_evol[1] = ~a; // F'(U_{i - 1, R+}) + f_deriv_uiL_evol[0] = ~a; + f_deriv_uiL_evol[1] = ~a; // F'(U_{i, L+}) + + f_deriv_uiR_evol[0] = ~a; + f_deriv_uiR_evol[1] = ~a; // F'(U_{i, R+}) + f_deriv_upL_evol[0] = ~a; + f_deriv_upL_evol[1] = ~a; // F'(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * |aL_roe| * (U_{i, L+} - U_{i - 1, R+}). + for (int j = 0; j < 2; j++) { + aL_roe[j] = 0.5 * (f_deriv_umR_evol[j] + f_deriv_uiL_evol[j]); + } + for (int j = 0; j < 2; j++) { + fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * fabs(aL_roe[j]) * (uiL_evol[j] - umR_evol[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * |aR_roe| * (U_{i + 1, L+} - u_{i, R+}). + for (int j = 0; j < 2; j++) { + aR_roe[j] = 0.5 * (f_deriv_uiR_evol[j] + f_deriv_upL_evol[j]); + } + for (int j = 0; j < 2; j++) { + fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * fabs(aR_roe[j]) * (upL_evol[j] - uiR_evol[j]); + } + + // Update the conserved variable. + for (int j = 0; j < 2; j++) { + un[(i * 2) + j] = u[(i * 2) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j < 2; j++) { + u[(i * 2) + j] = un[(i * 2) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(2 * 2) + j]; + u[(1 * 2) + j] = u[(2 * 2) + j]; + u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; + u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(un); + free(slope); + + free(local_alpha); + + free(umL); + free(umR); + free(uiL); + free(uiR); + free(upL); + free(upR); + + free(f_umL); + free(f_umR); + free(f_uiL); + free(f_uiR); + free(f_upL); + free(f_upR); + + free(umR_evol); + free(uiL_evol); + free(uiR_evol); + free(upL_evol); + + free(f_umR_evol); + free(f_uiL_evol); + free(f_uiR_evol); + free(f_upL_evol); + + free(f_deriv_umR_evol); + free(f_deriv_uiL_evol); + free(f_deriv_uiR_evol); + free(f_deriv_upL_evol); + + free(fluxL); + free(fluxR); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; Expression for flux limiter function. + limiter-r + ;; Left negative flux vector F(U_{i - 1, L}). + (list-ref flux-umLs 0) + (list-ref flux-umLs 1) + ;; Right negative flux vector F(U_{i - 1, R}). + (list-ref flux-umRs 0) + (list-ref flux-umRs 1) + ;; Left central flux vector F(U_{i, L}). + (list-ref flux-uiLs 0) + (list-ref flux-uiLs 1) + ;; Right central flux vector F(U_{i, R}). + (list-ref flux-uiRs 0) + (list-ref flux-uiRs 1) + ;; Left positive flux vector F(U_{i + 1, L}). + (list-ref flux-upLs 0) + (list-ref flux-upLs 1) + ;; Right positive flux vector F(U_{i + 1, R}). + (list-ref flux-upRs 0) + (list-ref flux-upRs 1) + ;; Evolved right negative flux vector F(U_{i - 1, R+}). + (list-ref flux-umR-evols 0) + (list-ref flux-umR-evols 1) + ;; Evolved left central flux vector F(U_{i, L+}). + (list-ref flux-uiL-evols 0) + (list-ref flux-uiL-evols 1) + ;; Evolved right central flux vector F(U_{i, R+}). + (list-ref flux-uiR-evols 0) + (list-ref flux-uiR-evols 1) + ;; Evolved left positive flux vector F(U_{i + 1, L+}). + (list-ref flux-upL-evols 0) + (list-ref flux-upL-evols 1) + ;; Eigenvalues of evolved right negative flux Jacobian F'(U_{i - 1, R+}). + (list-ref flux-deriv-umR-evols 0) + (list-ref flux-deriv-umR-evols 1) + ;; Eigenvalues of evolved left central flux Jacobian F'(U_{i, L+}). + (list-ref flux-deriv-uiL-evols 0) + (list-ref flux-deriv-uiL-evols 1) + ;; Eigenvalues of evolved right central flux Jacobian F'(U_{i, R+}). + (list-ref flux-deriv-uiR-evols 0) + (list-ref flux-deriv-uiR-evols 1) + ;; Eigenvalues of evolved left positive flux Jacobian F'(U_{i + 1, L+}). + (list-ref flux-deriv-upL-evols 0) + (list-ref flux-deriv-upL-evols 1) + ;; PDE name for file output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/code_generator_vector_2d.rkt b/provable-algorithms/finite_volume/code_generator_vector_2d.rkt new file mode 100644 index 00000000..653c14b7 --- /dev/null +++ b/provable-algorithms/finite_volume/code_generator_vector_2d.rkt @@ -0,0 +1,3281 @@ +#lang racket + +(require "prover_core.rkt") +(require "prover_vector.rkt") +(require "code_generator_core.rkt") +(provide generate-lax-friedrichs-vector3-2d + generate-lax-friedrichs-vector3-2d-second-order + generate-roe-vector3-2d + generate-roe-vector3-2d-second-order) + +;; ---------------------------------------------------------------------------------- +;; Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs +;; ---------------------------------------------------------------------------------- +(define (generate-lax-friedrichs-vector3-2d pde-system + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") + (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-codes-x)) + (define flux-uis-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") + (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-codes-x)) + (define flux-ups-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") + (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-codes-x)) + + (define flux-ums-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") + (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-codes-y)) + (define flux-uis-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") + (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-codes-y)) + (define flux-ups-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") + (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a +// Lax–Friedrichs first-order finite-difference solver for a coupled vector system of 3 PDEs in 2D. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + double **un = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); + un[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + double *um_x = (double*) malloc(3 * sizeof(double)); + double *ui_x = (double*) malloc(3 * sizeof(double)); + double *up_x = (double*) malloc(3 * sizeof(double)); + + double *f_um_x = (double*) malloc(3 * sizeof(double)); + double *f_ui_x = (double*) malloc(3 * sizeof(double)); + double *f_up_x = (double*) malloc(3 * sizeof(double)); + + double *fluxL_x = (double*) malloc(3 * sizeof(double)); + double *fluxR_x = (double*) malloc(3 * sizeof(double)); + + double *um_y = (double*) malloc(3 * sizeof(double)); + double *ui_y = (double*) malloc(3 * sizeof(double)); + double *up_y = (double*) malloc(3 * sizeof(double)); + + double *f_um_y = (double*) malloc(3 * sizeof(double)); + double *f_ui_y = (double*) malloc(3 * sizeof(double)); + double *f_up_y = (double*) malloc(3 * sizeof(double)); + + double *fluxL_y = (double*) malloc(3 * sizeof(double)); + double *fluxR_y = (double*) malloc(3 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + + un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_y[k] = u[i][((j - 1) * 3) + k]; + ui_y[k] = u[i][(j * 3) + k]; + up_y[k] = u[i][((j + 1) * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; // F(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_x[k] = u[i - 1][(j * 3) + k]; + ui_x[k] = u[i][(j * 3) + k]; + up_x[k] = u[i + 1][(j * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_x[0] = ~a; + f_um_x[1] = ~a; + f_um_x[2] = ~a; // F(U_{i - 1}). + + f_ui_x[0] = ~a; + f_ui_x[1] = ~a; + f_ui_x[2] = ~a; // F(U_i). + + f_up_x[0] = ~a; + f_up_x[1] = ~a; + f_up_x[2] = ~a; // F(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha_x * (U_i - U_{i - 1}). + for (int k = 0; k < 3; k++) { + fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * alpha_x * (ui_x[k] - um_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha_x * (U_{i + 1} - U_i). + for (int k = 0; k < 3; k++) { + fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * alpha_x * (up_x[k] - ui_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_y[k] = u[i][((j - 1) * 3) + k]; + ui_y[k] = u[i][(j * 3) + k]; + up_y[k] = u[i][((j + 1) * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; // F(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + free(un[i]); + } + free(u); + free(un); + + free(local_alpha_x); + free(local_alpha_y); + + free(um_x); + free(ui_x); + free(up_x); + + free(f_um_x); + free(f_ui_x); + free(f_up_x); + + free(fluxL_x); + free(fluxR_x); + + free(um_y); + free(ui_y); + free(up_y); + + free(f_um_y); + free(f_ui_y); + free(f_up_y); + + free(fluxL_y); + free(fluxR_y); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). + (list-ref flux-ums-x 0) + (list-ref flux-ums-x 1) + (list-ref flux-ums-x 2) + (list-ref flux-uis-x 0) + (list-ref flux-uis-x 1) + (list-ref flux-uis-x 2) + (list-ref flux-ups-x 0) + (list-ref flux-ups-x 1) + (list-ref flux-ups-x 2) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + ;; PDE name for file output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------------------------------- +;; Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------------------------------------------- +(define (generate-lax-friedrichs-vector3-2d-second-order pde-system limiter + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that solves the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method with a + second-order flux extrapolation using flux limiter `limiter`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") + (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]")) flux-codes-x)) + (define flux-umRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_x[0]") + (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]")) flux-codes-x)) + (define flux-uiLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") + (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]")) flux-codes-x)) + (define flux-uiRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") + (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]")) flux-codes-x)) + (define flux-upLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") + (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]")) flux-codes-x)) + (define flux-upRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") + (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]")) flux-codes-x)) + + (define flux-umR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") + (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-codes-x)) + (define flux-uiL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") + (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-codes-x)) + (define flux-uiR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") + (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-codes-x)) + (define flux-upL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") + (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-codes-x)) + + (define flux-umLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") + (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]")) flux-codes-y)) + (define flux-umRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") + (list-ref cons-codes 1) "umR_y[1]") (list-ref cons-codes 2) "umR_y[2]")) flux-codes-y)) + (define flux-uiLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") + (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]")) flux-codes-y)) + (define flux-uiRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") + (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]")) flux-codes-y)) + (define flux-upLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") + (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]")) flux-codes-y)) + (define flux-upRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") + (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]")) flux-codes-y)) + + (define flux-umR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") + (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-codes-y)) + (define flux-uiL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") + (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-codes-y)) + (define flux-uiR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") + (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-codes-y)) + (define flux-upL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") + (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Lax–Friedrichs first-order finite-difference solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing slopes. + double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); + double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + slope_x[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + slope_y[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + } + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + double **un = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + un[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + double *umL_x = (double*) malloc(3 * sizeof(double)); + double *umR_x = (double*) malloc(3 * sizeof(double)); + double *uiL_x = (double*) malloc(3 * sizeof(double)); + double *uiR_x = (double*) malloc(3 * sizeof(double)); + double *upL_x = (double*) malloc(3 * sizeof(double)); + double *upR_x = (double*) malloc(3 * sizeof(double)); + + double *f_umL_x = (double*) malloc(3 * sizeof(double)); + double *f_umR_x = (double*) malloc(3 * sizeof(double)); + double *f_uiL_x = (double*) malloc(3 * sizeof(double)); + double *f_uiR_x = (double*) malloc(3 * sizeof(double)); + double *f_upL_x = (double*) malloc(3 * sizeof(double)); + double *f_upR_x = (double*) malloc(3 * sizeof(double)); + + double *umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *f_umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *fluxL_x = (double*) malloc(3 * sizeof(double)); + double *fluxR_x = (double*) malloc(3 * sizeof(double)); + + double *umL_y = (double*) malloc(3 * sizeof(double)); + double *umR_y = (double*) malloc(3 * sizeof(double)); + double *uiL_y = (double*) malloc(3 * sizeof(double)); + double *uiR_y = (double*) malloc(3 * sizeof(double)); + double *upL_y = (double*) malloc(3 * sizeof(double)); + double *upR_y = (double*) malloc(3 * sizeof(double)); + + double *f_umL_y = (double*) malloc(3 * sizeof(double)); + double *f_umR_y = (double*) malloc(3 * sizeof(double)); + double *f_uiL_y = (double*) malloc(3 * sizeof(double)); + double *f_uiR_y = (double*) malloc(3 * sizeof(double)); + double *f_upL_y = (double*) malloc(3 * sizeof(double)); + double *f_upR_y = (double*) malloc(3 * sizeof(double)); + + double *umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *f_umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *fluxL_y = (double*) malloc(3 * sizeof(double)); + double *fluxR_y = (double*) malloc(3 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + + un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); + umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); + + uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); + uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); + + upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); + upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) / (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_x[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) + (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_x[k] = u[i - 1][(j * 3) + k] - (0.5 * slope_x[i - 1][(j * 3) + k]); + umR_x[k] = u[i - 1][(j * 3) + k] + (0.5 * slope_x[i - 1][(j * 3) + k]); + + uiL_x[k] = u[i][(j * 3) + k] - (0.5 * slope_x[i][(j * 3) + k]); + uiR_x[k] = u[i][(j * 3) + k] + (0.5 * slope_x[i][(j * 3) + k]); + + upL_x[k] = u[i + 1][(j * 3) + k] - (0.5 * slope_x[i + 1][(j * 3) + k]); + upR_x[k] = u[i + 1][(j * 3) + k] + (0.5 * slope_x[i + 1][(j * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_x[0] = ~a; + f_umL_x[1] = ~a; + f_umL_x[2] = ~a; + f_umR_x[0] = ~a; + f_umR_x[1] = ~a; + f_umR_x[2] = ~a; + + f_uiL_x[0] = ~a; + f_uiL_x[1] = ~a; + f_uiL_x[2] = ~a; + f_uiR_x[0] = ~a; + f_uiR_x[1] = ~a; + f_uiR_x[2] = ~a; + + f_upL_x[0] = ~a; + f_upL_x[1] = ~a; + f_upL_x[2] = ~a; + f_upR_x[0] = ~a; + f_upR_x[1] = ~a; + f_upR_x[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); + + uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + + upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_x[0] = ~a; + f_umR_evol_x[1] = ~a; + f_umR_evol_x[2] = ~a; // F(U_{i - 1, R+}) + f_uiL_evol_x[0] = ~a; + f_uiL_evol_x[1] = ~a; + f_uiL_evol_x[2] = ~a; // F(U_{i, L+}) + + f_uiR_evol_x[0] = ~a; + f_uiR_evol_x[1] = ~a; + f_uiR_evol_x[2] = ~a; // F(U_{i, R+}) + f_upL_evol_x[0] = ~a; + f_upL_evol_x[1] = ~a; + f_upL_evol_x[2] = ~a; // F(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha_x * (U_{i, L+} - U_{i - 1, R+}). + for (int k = 0; k < 3; k++) { + fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * alpha_x * (uiL_evol_x[k] - umR_evol_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha_x * (U_{i + 1, L+} - U_{i, R+}). + for (int k = 0; k < 3; k++) { + fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * alpha_x * (upL_evol_x[k] - uiR_evol_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); + umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); + + uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); + uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); + + upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); + upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + free(un[i]); + free(slope_x[i]); + free(slope_y[i]); + } + free(u); + free(un); + free(slope_x); + free(slope_y); + + free(local_alpha_x); + free(local_alpha_y); + + free(umL_x); + free(umR_x); + free(uiL_x); + free(uiR_x); + free(upL_x); + free(upR_x); + + free(f_umL_x); + free(f_umR_x); + free(f_uiL_x); + free(f_uiR_x); + free(f_upL_x); + free(f_upR_x); + + free(umR_evol_x); + free(uiL_evol_x); + free(uiR_evol_x); + free(upL_evol_x); + + free(f_umR_evol_x); + free(f_uiL_evol_x); + free(f_uiR_evol_x); + free(f_upL_evol_x); + + free(fluxL_x); + free(fluxR_x); + + free(umL_y); + free(umR_y); + free(uiL_y); + free(uiR_y); + free(upL_y); + free(upR_y); + + free(f_umL_y); + free(f_umR_y); + free(f_uiL_y); + free(f_uiR_y); + free(f_upL_y); + free(f_upR_y); + + free(umR_evol_y); + free(uiL_evol_y); + free(uiR_evol_y); + free(upL_evol_y); + + free(f_umR_evol_y); + free(f_uiL_evol_y); + free(f_uiR_evol_y); + free(f_upL_evol_y); + + free(fluxL_y); + free(fluxR_y); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). + (list-ref flux-umLs-x 0) + (list-ref flux-umLs-x 1) + (list-ref flux-umLs-x 2) + (list-ref flux-umRs-x 0) + (list-ref flux-umRs-x 1) + (list-ref flux-umRs-x 2) + ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). + (list-ref flux-uiLs-x 0) + (list-ref flux-uiLs-x 1) + (list-ref flux-uiLs-x 2) + (list-ref flux-uiRs-x 0) + (list-ref flux-uiRs-x 1) + (list-ref flux-uiRs-x 2) + ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). + (list-ref flux-upLs-x 0) + (list-ref flux-upLs-x 1) + (list-ref flux-upLs-x 2) + (list-ref flux-upRs-x 0) + (list-ref flux-upRs-x 1) + (list-ref flux-upRs-x 2) + ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). + (list-ref flux-umR-evols-x 0) + (list-ref flux-umR-evols-x 1) + (list-ref flux-umR-evols-x 2) + (list-ref flux-uiL-evols-x 0) + (list-ref flux-uiL-evols-x 1) + (list-ref flux-uiL-evols-x 2) + ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). + (list-ref flux-uiR-evols-x 0) + (list-ref flux-uiR-evols-x 1) + (list-ref flux-uiR-evols-x 2) + (list-ref flux-upL-evols-x 0) + (list-ref flux-upL-evols-x 1) + (list-ref flux-upL-evols-x 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + ;; PDE name for file output. + name + name + )) + code) + +;; ------------------------------------------------------------------- +;; Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs +;; ------------------------------------------------------------------- +(define (generate-roe-vector3-2d pde-system + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that solves the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Roe finite-volume method. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define flux-jacobian-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) + (define flux-jacobian-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) + (define flux-jacobian-eigvals-simp-x (list (symbolic-simp (list-ref flux-jacobian-eigvals-x 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals-x 1)) + (symbolic-simp (list-ref flux-jacobian-eigvals-x 2)))) + (define flux-jacobian-eigvals-simp-y (list (symbolic-simp (list-ref flux-jacobian-eigvals-y 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals-y 1)) + (symbolic-simp (list-ref flux-jacobian-eigvals-y 2)))) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define flux-deriv-codes-x (map (lambda (flux-deriv-expr-x) + (convert-expr flux-deriv-expr-x)) flux-jacobian-eigvals-simp-x)) + (define flux-deriv-codes-y (map (lambda (flux-deriv-expr-y) + (convert-expr flux-deriv-expr-y)) flux-jacobian-eigvals-simp-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") + (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-codes-x)) + (define flux-uis-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") + (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-codes-x)) + (define flux-ups-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") + (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-codes-x)) + + (define flux-deriv-ums-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "um_x[0]") + (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-uis-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "ui_x[0]") + (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-ups-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "up_x[0]") + (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-deriv-codes-x)) + + (define flux-ums-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") + (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-codes-y)) + (define flux-uis-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") + (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-codes-y)) + (define flux-ups-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") + (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-codes-y)) + + (define flux-deriv-ums-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "um_y[0]") + (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-uis-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "ui_y[0]") + (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-ups-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "up_y[0]") + (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-deriv-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a +// Roe higher-order finite-volume solver for a coupled vector system of 3 PDEs in 2D. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + double **un = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); + un[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + double *um_x = (double*) malloc(3 * sizeof(double)); + double *ui_x = (double*) malloc(3 * sizeof(double)); + double *up_x = (double*) malloc(3 * sizeof(double)); + + double *f_um_x = (double*) malloc(3 * sizeof(double)); + double *f_ui_x = (double*) malloc(3 * sizeof(double)); + double *f_up_x = (double*) malloc(3 * sizeof(double)); + + double *f_deriv_um_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_ui_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_up_x = (double*) malloc(3 * sizeof(double)); + + double *aL_roe_x = (double*) malloc(3 * sizeof(double)); + double *aR_roe_x = (double*) malloc(3 * sizeof(double)); + + double *fluxL_x = (double*) malloc(3 * sizeof(double)); + double *fluxR_x = (double*) malloc(3 * sizeof(double)); + + double *um_y = (double*) malloc(3 * sizeof(double)); + double *ui_y = (double*) malloc(3 * sizeof(double)); + double *up_y = (double*) malloc(3 * sizeof(double)); + + double *f_um_y = (double*) malloc(3 * sizeof(double)); + double *f_ui_y = (double*) malloc(3 * sizeof(double)); + double *f_up_y = (double*) malloc(3 * sizeof(double)); + + double *f_deriv_um_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_ui_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_up_y = (double*) malloc(3 * sizeof(double)); + + double *aL_roe_y = (double*) malloc(3 * sizeof(double)); + double *aR_roe_y = (double*) malloc(3 * sizeof(double)); + + double *fluxL_y = (double*) malloc(3 * sizeof(double)); + double *fluxR_y = (double*) malloc(3 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + + un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_y[k] = u[i][((j - 1) * 3) + k]; + ui_y[k] = u[i][(j * 3) + k]; + up_y[k] = u[i][((j + 1) * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; // F(U_{j + 1}). + + // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. + f_deriv_um_y[0] = ~a; + f_deriv_um_y[1] = ~a; + f_deriv_um_y[2] = ~a; // Eigenvalues of F'(U_{j - 1}). + + f_deriv_ui_y[0] = ~a; + f_deriv_ui_y[1] = ~a; + f_deriv_ui_y[2] = ~a; // Eigenvalues of F'(U_j). + + f_deriv_up_y[0] = ~a; + f_deriv_up_y[1] = ~a; + f_deriv_up_y[2] = ~a; // Eigenvalues of F'(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * |aL_roe_y| * (U_j - U_{j - 1}). + for (int k = 0; k < 3; k++) { + aL_roe_y[k] = 0.5 * (f_deriv_um_y[k] + f_deriv_ui_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * |aR_roe_y| * (U_{j + 1} - U_j). + for (int k = 0; k < 3; k++) { + aR_roe_y[k] = 0.5 * (f_deriv_ui_y[k] + f_deriv_up_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the x-direction. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_x[k] = u[i - 1][(j * 3) + k]; + ui_x[k] = u[i][(j * 3) + k]; + up_x[k] = u[i + 1][(j * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_x[0] = ~a; + f_um_x[1] = ~a; + f_um_x[2] = ~a; // F(U_{i - 1}). + + f_ui_x[0] = ~a; + f_ui_x[1] = ~a; + f_ui_x[2] = ~a; // F(U_i). + + f_up_x[0] = ~a; + f_up_x[1] = ~a; + f_up_x[2] = ~a; // F(U_{i + 1}). + + // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. + f_deriv_um_x[0] = ~a; + f_deriv_um_x[1] = ~a; + f_deriv_um_x[2] = ~a; // Eigenvalues of F'(U_{i - 1}). + + f_deriv_ui_x[0] = ~a; + f_deriv_ui_x[1] = ~a; + f_deriv_ui_x[2] = ~a; // Eigenvalues of F'(U_i). + + f_deriv_up_x[0] = ~a; + f_deriv_up_x[1] = ~a; + f_deriv_up_x[2] = ~a; // Eigenvalues of F'(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * |aL_roe_x| * (U_i - U_{i - 1}). + for (int k = 0; k < 3; k++) { + aL_roe_x[k] = 0.5 * (f_deriv_um_x[k] + f_deriv_ui_x[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * fabs(aL_roe_x[k]) * (ui_x[k] - um_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * |aR_roe_x| * (U_{i + 1} - U_i). + for (int k = 0; k < 3; k++) { + aR_roe_x[k] = 0.5 * (f_deriv_ui_x[k] + f_deriv_up_x[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * fabs(aR_roe_x[k]) * (up_x[k] - ui_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_y[k] = u[i][((j - 1) * 3) + k]; + ui_y[k] = u[i][(j * 3) + k]; + up_y[k] = u[i][((j + 1) * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; // F(U_{j + 1}). + + // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. + f_deriv_um_y[0] = ~a; + f_deriv_um_y[1] = ~a; + f_deriv_um_y[2] = ~a; // Eigenvalues of F'(U_{j - 1}). + + f_deriv_ui_y[0] = ~a; + f_deriv_ui_y[1] = ~a; + f_deriv_ui_y[2] = ~a; // Eigenvalues of F'(U_j). + + f_deriv_up_y[0] = ~a; + f_deriv_up_y[1] = ~a; + f_deriv_up_y[2] = ~a; // Eigenvalues of F'(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * |aL_roe_y| * (U_j - U_{j - 1}). + for (int k = 0; k < 3; k++) { + aL_roe_y[k] = 0.5 * (f_deriv_um_y[k] + f_deriv_ui_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * |aR_roe_y| * (U_{j + 1} - U_j). + for (int k = 0; k < 3; k++) { + aR_roe_y[k] = 0.5 * (f_deriv_ui_y[k] + f_deriv_up_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + free(un[i]); + } + free(u); + free(un); + + free(local_alpha_x); + free(local_alpha_y); + + free(um_x); + free(ui_x); + free(up_x); + + free(f_um_x); + free(f_ui_x); + free(f_up_x); + + free(f_deriv_um_x); + free(f_deriv_ui_x); + free(f_deriv_up_x); + + free(aL_roe_x); + free(aR_roe_x); + + free(fluxL_x); + free(fluxR_x); + + free(um_y); + free(ui_y); + free(up_y); + + free(f_um_y); + free(f_ui_y); + free(f_up_y); + + free(f_deriv_um_y); + free(f_deriv_ui_y); + free(f_deriv_up_y); + + free(aL_roe_y); + free(aR_roe_y); + + free(fluxL_y); + free(fluxR_y); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + ;; Eigenvalues of left, middle, right flux Jacobians in y-direction F'(u_{j - 1}), F'(u_j), F'(u_{j + 1}). + (list-ref flux-deriv-ums-y 0) + (list-ref flux-deriv-ums-y 1) + (list-ref flux-deriv-ums-y 2) + (list-ref flux-deriv-uis-y 0) + (list-ref flux-deriv-uis-y 1) + (list-ref flux-deriv-uis-y 2) + (list-ref flux-deriv-ups-y 0) + (list-ref flux-deriv-ups-y 1) + (list-ref flux-deriv-ups-y 2) + ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). + (list-ref flux-ums-x 0) + (list-ref flux-ums-x 1) + (list-ref flux-ums-x 2) + (list-ref flux-uis-x 0) + (list-ref flux-uis-x 1) + (list-ref flux-uis-x 2) + (list-ref flux-ups-x 0) + (list-ref flux-ups-x 1) + (list-ref flux-ups-x 2) + ;; Eigenvalues of left, middle, right flux Jacobians in x-direction F'(u_{i - 1}), F'(u_i), F'(u_{i + 1}). + (list-ref flux-deriv-ums-x 0) + (list-ref flux-deriv-ums-x 1) + (list-ref flux-deriv-ums-x 2) + (list-ref flux-deriv-uis-x 0) + (list-ref flux-deriv-uis-x 1) + (list-ref flux-deriv-uis-x 2) + (list-ref flux-deriv-ups-x 0) + (list-ref flux-deriv-ups-x 1) + (list-ref flux-deriv-ups-x 2) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + ;; Eigenvalues of left, middle, right flux Jacobians in y-direction F'(u_{j - 1}), F'(u_j), F'(u_{j + 1}). + (list-ref flux-deriv-ums-y 0) + (list-ref flux-deriv-ums-y 1) + (list-ref flux-deriv-ums-y 2) + (list-ref flux-deriv-uis-y 0) + (list-ref flux-deriv-uis-y 1) + (list-ref flux-deriv-uis-y 2) + (list-ref flux-deriv-ups-y 0) + (list-ref flux-deriv-ups-y 1) + (list-ref flux-deriv-ups-y 2) + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------------------- +;; Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation +;; ---------------------------------------------------------------------------------------------------------- +(define (generate-roe-vector3-2d-second-order pde-system limiter + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that solves the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Roe finite-volume method with a + second-order flux extrapolation using flux limiter `limiter`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define flux-jacobian-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) + (define flux-jacobian-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) + (define flux-jacobian-eigvals-simp-x (list (symbolic-simp (list-ref flux-jacobian-eigvals-x 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals-x 1)) + (symbolic-simp (list-ref flux-jacobian-eigvals-x 2)))) + (define flux-jacobian-eigvals-simp-y (list (symbolic-simp (list-ref flux-jacobian-eigvals-y 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals-y 1)) + (symbolic-simp (list-ref flux-jacobian-eigvals-y 2)))) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define flux-deriv-codes-x (map (lambda (flux-deriv-expr-x) + (convert-expr flux-deriv-expr-x)) flux-jacobian-eigvals-simp-x)) + (define flux-deriv-codes-y (map (lambda (flux-deriv-expr-y) + (convert-expr flux-deriv-expr-y)) flux-jacobian-eigvals-simp-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") + (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]")) flux-codes-x)) + (define flux-umRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_x[0]") + (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]")) flux-codes-x)) + (define flux-uiLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") + (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]")) flux-codes-x)) + (define flux-uiRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") + (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]")) flux-codes-x)) + (define flux-upLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") + (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]")) flux-codes-x)) + (define flux-upRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") + (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]")) flux-codes-x)) + + (define flux-umR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") + (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-codes-x)) + (define flux-uiL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") + (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-codes-x)) + (define flux-uiR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") + (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-codes-x)) + (define flux-upL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") + (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-codes-x)) + + (define flux-deriv-umR-evols-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "umR_evol_x[0]") + (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-uiL-evols-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") + (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-uiR-evols-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") + (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-upL-evols-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "upL_evol_x[0]") + (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-deriv-codes-x)) + + (define flux-umLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") + (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]")) flux-codes-y)) + (define flux-umRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") + (list-ref cons-codes 1) "umR_y[1]") (list-ref cons-codes 2) "umR_y[2]")) flux-codes-y)) + (define flux-uiLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") + (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]")) flux-codes-y)) + (define flux-uiRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") + (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]")) flux-codes-y)) + (define flux-upLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") + (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]")) flux-codes-y)) + (define flux-upRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") + (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]")) flux-codes-y)) + + (define flux-umR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") + (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-codes-y)) + (define flux-uiL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") + (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-codes-y)) + (define flux-uiR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") + (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-codes-y)) + (define flux-upL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") + (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-codes-y)) + + (define flux-deriv-umR-evols-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "umR_evol_y[0]") + (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-uiL-evols-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") + (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-uiR-evols-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") + (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-upL-evols-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "upL_evol_y[0]") + (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-deriv-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Roe higher-order finite-volume solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. + +#include +#include +#include + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing slopes. + double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); + double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + slope_x[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + slope_y[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + } + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + double **un = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + un[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + double *umL_x = (double*) malloc(3 * sizeof(double)); + double *umR_x = (double*) malloc(3 * sizeof(double)); + double *uiL_x = (double*) malloc(3 * sizeof(double)); + double *uiR_x = (double*) malloc(3 * sizeof(double)); + double *upL_x = (double*) malloc(3 * sizeof(double)); + double *upR_x = (double*) malloc(3 * sizeof(double)); + + double *f_umL_x = (double*) malloc(3 * sizeof(double)); + double *f_umR_x = (double*) malloc(3 * sizeof(double)); + double *f_uiL_x = (double*) malloc(3 * sizeof(double)); + double *f_uiR_x = (double*) malloc(3 * sizeof(double)); + double *f_upL_x = (double*) malloc(3 * sizeof(double)); + double *f_upR_x = (double*) malloc(3 * sizeof(double)); + + double *umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *f_umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *f_deriv_umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *aL_roe_x = (double*) malloc(3 * sizeof(double)); + double *aR_roe_x = (double*) malloc(3 * sizeof(double)); + + double *fluxL_x = (double*) malloc(3 * sizeof(double)); + double *fluxR_x = (double*) malloc(3 * sizeof(double)); + + double *umL_y = (double*) malloc(3 * sizeof(double)); + double *umR_y = (double*) malloc(3 * sizeof(double)); + double *uiL_y = (double*) malloc(3 * sizeof(double)); + double *uiR_y = (double*) malloc(3 * sizeof(double)); + double *upL_y = (double*) malloc(3 * sizeof(double)); + double *upR_y = (double*) malloc(3 * sizeof(double)); + + double *f_umL_y = (double*) malloc(3 * sizeof(double)); + double *f_umR_y = (double*) malloc(3 * sizeof(double)); + double *f_uiL_y = (double*) malloc(3 * sizeof(double)); + double *f_uiR_y = (double*) malloc(3 * sizeof(double)); + double *f_upL_y = (double*) malloc(3 * sizeof(double)); + double *f_upR_y = (double*) malloc(3 * sizeof(double)); + + double *umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *f_umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *f_deriv_umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *aL_roe_y = (double*) malloc(3 * sizeof(double)); + double *aR_roe_y = (double*) malloc(3 * sizeof(double)); + + double *fluxL_y = (double*) malloc(3 * sizeof(double)); + double *fluxR_y = (double*) malloc(3 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + + un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); + umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); + + uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); + uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); + + upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); + upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) + + // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. + f_deriv_umR_evol_y[0] = ~a; + f_deriv_umR_evol_y[1] = ~a; + f_deriv_umR_evol_y[2] = ~a; // F'(U_{j - 1, R+}) + f_deriv_uiL_evol_y[0] = ~a; + f_deriv_uiL_evol_y[1] = ~a; + f_deriv_uiL_evol_y[2] = ~a; // F'(U_{j, L+}) + + f_deriv_uiR_evol_y[0] = ~a; + f_deriv_uiR_evol_y[1] = ~a; + f_deriv_uiR_evol_y[2] = ~a; // F'(U_{j, R+}) + f_deriv_upL_evol_y[0] = ~a; + f_deriv_upL_evol_y[1] = ~a; + f_deriv_upL_evol_y[2] = ~a; // F'(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * |aL_roe_y| * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 3; k++) { + aL_roe_y[k] = 0.5 * (f_deriv_umR_evol_y[k] + f_deriv_uiL_evol_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * |aR_roe_y| * (U_{j + 1, L+} - u_{j, R+}). + for (int k = 0; k < 3; k++) { + aR_roe_y[k] = 0.5 * (f_deriv_uiR_evol_y[k] + f_deriv_upL_evol_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) / (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_x[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) + (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the x-direction. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_x[k] = u[i - 1][(j * 3) + k] - (0.5 * slope_x[i - 1][(j * 3) + k]); + umR_x[k] = u[i - 1][(j * 3) + k] + (0.5 * slope_x[i - 1][(j * 3) + k]); + + uiL_x[k] = u[i][(j * 3) + k] - (0.5 * slope_x[i][(j * 3) + k]); + uiR_x[k] = u[i][(j * 3) + k] + (0.5 * slope_x[i][(j * 3) + k]); + + upL_x[k] = u[i + 1][(j * 3) + k] - (0.5 * slope_x[i + 1][(j * 3) + k]); + upR_x[k] = u[i + 1][(j * 3) + k] + (0.5 * slope_x[i + 1][(j * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_x[0] = ~a; + f_umL_x[1] = ~a; + f_umL_x[2] = ~a; + f_umR_x[0] = ~a; + f_umR_x[1] = ~a; + f_umR_x[2] = ~a; + + f_uiL_x[0] = ~a; + f_uiL_x[1] = ~a; + f_uiL_x[2] = ~a; + f_uiR_x[0] = ~a; + f_uiR_x[1] = ~a; + f_uiR_x[2] = ~a; + + f_upL_x[0] = ~a; + f_upL_x[1] = ~a; + f_upL_x[2] = ~a; + f_upR_x[0] = ~a; + f_upR_x[1] = ~a; + f_upR_x[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); + + uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + + upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_x[0] = ~a; + f_umR_evol_x[1] = ~a; + f_umR_evol_x[2] = ~a; // F(U_{i - 1, R+}) + f_uiL_evol_x[0] = ~a; + f_uiL_evol_x[1] = ~a; + f_uiL_evol_x[2] = ~a; // F(U_{i, L+}) + + f_uiR_evol_x[0] = ~a; + f_uiR_evol_x[1] = ~a; + f_uiR_evol_x[2] = ~a; // F(U_{i, R+}) + f_upL_evol_x[0] = ~a; + f_upL_evol_x[1] = ~a; + f_upL_evol_x[2] = ~a; // F(U_{i + 1, L+}) + + // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. + f_deriv_umR_evol_x[0] = ~a; + f_deriv_umR_evol_x[1] = ~a; + f_deriv_umR_evol_x[2] = ~a; // F'(U_{i - 1, R+}) + f_deriv_uiL_evol_x[0] = ~a; + f_deriv_uiL_evol_x[1] = ~a; + f_deriv_uiL_evol_x[2] = ~a; // F'(U_{i, L+}) + + f_deriv_uiR_evol_x[0] = ~a; + f_deriv_uiR_evol_x[1] = ~a; + f_deriv_uiR_evol_x[2] = ~a; // F'(U_{i, R+}) + f_deriv_upL_evol_x[0] = ~a; + f_deriv_upL_evol_x[1] = ~a; + f_deriv_upL_evol_x[2] = ~a; // F'(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * |aL_roe_x| * (U_{i, L+} - U_{i - 1, R+}). + for (int k = 0; k < 3; k++) { + aL_roe_x[k] = 0.5 * (f_deriv_umR_evol_x[k] + f_deriv_uiL_evol_x[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * fabs(aL_roe_x[k]) * (uiL_evol_x[k] - umR_evol_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * |aR_roe_x| * (U_{i + 1, L+} - u_{i, R+}). + for (int k = 0; k < 3; k++) { + aR_roe_x[k] = 0.5 * (f_deriv_uiR_evol_x[k] + f_deriv_upL_evol_x[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * fabs(aR_roe_x[k]) * (upL_evol_x[k] - uiR_evol_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); + umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); + + uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); + uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); + + upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); + upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) + + // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. + f_deriv_umR_evol_y[0] = ~a; + f_deriv_umR_evol_y[1] = ~a; + f_deriv_umR_evol_y[2] = ~a; // F'(U_{j - 1, R+}) + f_deriv_uiL_evol_y[0] = ~a; + f_deriv_uiL_evol_y[1] = ~a; + f_deriv_uiL_evol_y[2] = ~a; // F'(U_{j, L+}) + + f_deriv_uiR_evol_y[0] = ~a; + f_deriv_uiR_evol_y[1] = ~a; + f_deriv_uiR_evol_y[2] = ~a; // F'(U_{j, R+}) + f_deriv_upL_evol_y[0] = ~a; + f_deriv_upL_evol_y[1] = ~a; + f_deriv_upL_evol_y[2] = ~a; // F'(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * |aL_roe_y| * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 3; k++) { + aL_roe_y[k] = 0.5 * (f_deriv_umR_evol_y[k] + f_deriv_uiL_evol_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * |aR_roe_y| * (U_{j + 1, L+} - u_{j, R+}). + for (int k = 0; k < 3; k++) { + aR_roe_y[k] = 0.5 * (f_deriv_uiR_evol_y[k] + f_deriv_upL_evol_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + free(un[i]); + free(slope_x[i]); + free(slope_y[i]); + } + free(u); + free(un); + free(slope_x); + free(slope_y); + + free(local_alpha_x); + free(local_alpha_y); + + free(umL_x); + free(umR_x); + free(uiL_x); + free(uiR_x); + free(upL_x); + free(upR_x); + + free(f_umL_x); + free(f_umR_x); + free(f_uiL_x); + free(f_uiR_x); + free(f_upL_x); + free(f_upR_x); + + free(umR_evol_x); + free(uiL_evol_x); + free(uiR_evol_x); + free(upL_evol_x); + + free(f_umR_evol_x); + free(f_uiL_evol_x); + free(f_uiR_evol_x); + free(f_upL_evol_x); + + free(f_deriv_umR_evol_x); + free(f_deriv_uiL_evol_x); + free(f_deriv_uiR_evol_x); + free(f_deriv_upL_evol_x); + + free(aL_roe_x); + free(aR_roe_x); + + free(fluxL_x); + free(fluxR_x); + + free(umL_y); + free(umR_y); + free(uiL_y); + free(uiR_y); + free(upL_y); + free(upR_y); + + free(f_umL_y); + free(f_umR_y); + free(f_uiL_y); + free(f_uiR_y); + free(f_upL_y); + free(f_upR_y); + + free(umR_evol_y); + free(uiL_evol_y); + free(uiR_evol_y); + free(upL_evol_y); + + free(f_umR_evol_y); + free(f_uiL_evol_y); + free(f_uiR_evol_y); + free(f_upL_evol_y); + + free(f_deriv_umR_evol_y); + free(f_deriv_uiL_evol_y); + free(f_deriv_uiR_evol_y); + free(f_deriv_upL_evol_y); + + free(aL_roe_y); + free(aR_roe_y); + + free(fluxL_y); + free(fluxR_y); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + ;; Evolved right negative/left central flux Jacobian eigenvalues in y-direction F'(U_{j - 1, R+}), F'(U_{j, L+}). + (list-ref flux-deriv-umR-evols-y 0) + (list-ref flux-deriv-umR-evols-y 1) + (list-ref flux-deriv-umR-evols-y 2) + (list-ref flux-deriv-uiL-evols-y 0) + (list-ref flux-deriv-uiL-evols-y 1) + (list-ref flux-deriv-uiL-evols-y 2) + ;; Evolved right central/left positive flux Jacobian eigenvalues in y-direction F'(U_{j, R+}), F'(U_{j + 1, L+}). + (list-ref flux-deriv-uiR-evols-y 0) + (list-ref flux-deriv-uiR-evols-y 1) + (list-ref flux-deriv-uiR-evols-y 2) + (list-ref flux-deriv-upL-evols-y 0) + (list-ref flux-deriv-upL-evols-y 1) + (list-ref flux-deriv-upL-evols-y 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). + (list-ref flux-umLs-x 0) + (list-ref flux-umLs-x 1) + (list-ref flux-umLs-x 2) + (list-ref flux-umRs-x 0) + (list-ref flux-umRs-x 1) + (list-ref flux-umRs-x 2) + ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). + (list-ref flux-uiLs-x 0) + (list-ref flux-uiLs-x 1) + (list-ref flux-uiLs-x 2) + (list-ref flux-uiRs-x 0) + (list-ref flux-uiRs-x 1) + (list-ref flux-uiRs-x 2) + ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). + (list-ref flux-upLs-x 0) + (list-ref flux-upLs-x 1) + (list-ref flux-upLs-x 2) + (list-ref flux-upRs-x 0) + (list-ref flux-upRs-x 1) + (list-ref flux-upRs-x 2) + ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). + (list-ref flux-umR-evols-x 0) + (list-ref flux-umR-evols-x 1) + (list-ref flux-umR-evols-x 2) + (list-ref flux-uiL-evols-x 0) + (list-ref flux-uiL-evols-x 1) + (list-ref flux-uiL-evols-x 2) + ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). + (list-ref flux-uiR-evols-x 0) + (list-ref flux-uiR-evols-x 1) + (list-ref flux-uiR-evols-x 2) + (list-ref flux-upL-evols-x 0) + (list-ref flux-upL-evols-x 1) + (list-ref flux-upL-evols-x 2) + ;; Evolved right negative/left central flux Jacobian eigenvalues in x-direction F'(U_{i - 1, R+}), F'(U_{i, L+}). + (list-ref flux-deriv-umR-evols-x 0) + (list-ref flux-deriv-umR-evols-x 1) + (list-ref flux-deriv-umR-evols-x 2) + (list-ref flux-deriv-uiL-evols-x 0) + (list-ref flux-deriv-uiL-evols-x 1) + (list-ref flux-deriv-uiL-evols-x 2) + ;; Evolved right central/left positive flux Jacobian eigenvalues in x-direction F'(U_{i, R+}), F'(U_{i + 1, L+}). + (list-ref flux-deriv-uiR-evols-x 0) + (list-ref flux-deriv-uiR-evols-x 1) + (list-ref flux-deriv-uiR-evols-x 2) + (list-ref flux-deriv-upL-evols-x 0) + (list-ref flux-deriv-upL-evols-x 1) + (list-ref flux-deriv-upL-evols-x 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + ;; Evolved right negative/left central flux Jacobian eigenvalues in y-direction F'(U_{j - 1, R+}), F'(U_{j, L+}). + (list-ref flux-deriv-umR-evols-y 0) + (list-ref flux-deriv-umR-evols-y 1) + (list-ref flux-deriv-umR-evols-y 2) + (list-ref flux-deriv-uiL-evols-y 0) + (list-ref flux-deriv-uiL-evols-y 1) + (list-ref flux-deriv-uiL-evols-y 2) + ;; Evolved right central/left positive flux Jacobian eigenvalues in y-direction F'(U_{j, R+}), F'(U_{j + 1, L+}). + (list-ref flux-deriv-uiR-evols-y 0) + (list-ref flux-deriv-uiR-evols-y 1) + (list-ref flux-deriv-uiR-evols-y 2) + (list-ref flux-deriv-upL-evols-y 0) + (list-ref flux-deriv-upL-evols-y 1) + (list-ref flux-deriv-upL-evols-y 2) + ;; PDE name for file output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_code_generator_lax.rkt b/provable-algorithms/finite_volume/gkyl_code_generator_lax.rkt new file mode 100644 index 00000000..e328eee8 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_code_generator_lax.rkt @@ -0,0 +1,1282 @@ +#lang racket + +(require "code_generator_core.rkt") +(provide remove-bracketed-expressions + remove-bracketed-expressions-from-file + gkyl-generate-lax-friedrichs-scalar-1d-header + gkyl-generate-lax-friedrichs-scalar-1d-priv-header + gkyl-generate-lax-friedrichs-scalar-1d-source + gkyl-generate-lax-friedrichs-scalar-1d-regression + gkyl-generate-flux-limiter) + +;; A simple boilerplate function for removing bracketed expressions from strings. +(define (remove-bracketed-expressions str) + (regexp-replace* #rx"\\[.*?\\]" str "")) + +;; A simple boilerplate function for removing bracketed expressions from files. +(define (remove-bracketed-expressions-from-file output-file) + (define content + (with-input-from-file output-file + (lambda () + (port->string (current-input-port))))) + (define cleaned + (remove-bracketed-expressions content)) + (with-output-to-file output-file #:exists 'replace + (lambda () + (display cleaned)))) + +;; ------------------------------------------------------------------------------- +;; Header for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------------- +(define (gkyl-generate-lax-friedrichs-scalar-1d-header pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate Gkeyll C header code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define parameters (hash-ref pde 'parameters)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-comment (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) + parameters) "\n")] + [else "*"])) + + (define code + (format " +#pragma once + +#include + +// Type of Riemann-solver to use: +enum gkyl_wv_~a_rp { + WV_~a_RP_LAX = 0, // Default (Lax fluxes). +}; + +// Input context, packaged as a struct. +struct gkyl_wv_~a_inp { + ~a + + enum gkyl_wv_~a_rp rp_type; // Type of Riemann-solver to use. + bool use_gpu; // Whether the wave equation object is on the host (false) or the device (true). +}; + +/** +* Create a new ~a equation object. +* +~a +* @param use_gpu Whether the wave equation object is on the host (false) or the device (true). +* @return Pointer to the ~a equation object. +*/ +struct gkyl_wv_eqn* +gkyl_wv_~a_new(~a bool use_gpu); + +/** +* Create a new ~a equation object, from an input context struct. +* +* @param inp Input context struct. +* @return Pointer to the ~a equation object. +*/ +struct gkyl_wv_eqn* +gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp); +" + name + (string-upcase name) + name + parameter-def + name + name + parameter-comment + name + name + parameter-sig + name + name + name + name + )) + code) + +;; --------------------------------------------------------------------------------------- +;; Private Header for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE +;; --------------------------------------------------------------------------------------- +(define (gkyl-generate-lax-friedrichs-scalar-1d-priv-header pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate Gkeyll C private header code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define parameters (hash-ref pde 'parameters)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-comment (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) + parameters) "\n")] + [else "*"])) + + (define code + (format " +#pragma once + +// Private header, not for direct use in user-facing code. + +#include +#include +#include +#include +#include +#include + +struct wv_~a { + struct gkyl_wv_eqn eqn; // Base equation object. + ~a +}; + +/** +* Compute maximum absolute wave speed. +* +~a +* @param q Conserved variable vector. +* @return Maximum absolute wave speed for a given q. +*/ +GKYL_CU_D +static inline double +gkyl_~a_max_abs_speed(~a const double* q); + +/** +* Compute flux vector. Assumes rotation to local coordinate system. +* +~a +* @param q Conserved variable vector. +* @param flux Flux vector in direction 'dir' (output). +*/ +GKYL_CU_D +void +gkyl_~a_flux(~a const double* q, double* flux); + +/** +* Compute Riemann variables given the conserved variables. +* +* @param eqn Base equation object. +* @param qstate Current state vector. +* @param qin Conserved variable vector (input). +* @param wout Riemann variable vector (output). +*/ +GKYL_CU_D +static inline void +cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout); + +/** +* Compute conserved variables given the Riemann variables. +* +* @param eqn Base equation object. +* @param qstate Current state vector. +* @param win Riemann variable vector (input). +* @param qout Conserved variable vector (output). +*/ +GKYL_CU_D +static inline void +riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double *qout); + +/** +* Boundary condition function for applying wall boundary conditions for the ~a equation. +* +* @param eqn Base equation object. +* @param t Current simulation time. +* @param nc Number of boundary cells to which to apply wall boundary conditions. +* @param skin Skin cells in boundary region (from which values are copied). +* @param ghost Ghost cells in boundary region (to which values are copied). +* @param ctx Context to pass to the function. +*/ +GKYL_CU_D +static void +~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); + +/** +* Boundary condition function for applying no-slip boundary conditions for the ~a equation. +* +* @param eqn Base equation object. +* @param t Current simulation time. +* @param nc Number of boundary cells to which to apply no-slip boundary conditions. +* @param skin Skin cells in boundary region (from which values are copied). +* @param ghost Ghost cells in boundary region (to which values are copied). +* @param ctx Context to pass to the function. +*/ +GKYL_CU_D +static void +~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); + +/** +* Rotate state vector from global to local coordinate frame. +* +* @param eqn Base equation object. +* @param tau1 First tangent vector of the coordinate frame. +* @param tau2 Second tangent vector of the coordinate frame. +* @param norm Normal vector of the coordinate frame. +* @param qglobal State vector in global coordinate frame (input). +* @param qlocal State vector in local coordinate frame (output). +*/ +GKYL_CU_D +static inline void +rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, + double* GKYL_RESTRICT qlocal); + +/** +* Rotate state vector from local to global coordinate frame. +* +* @param eqn Base equation object. +* @param tau1 First tangent vector of the coordinate frame. +* @param tau2 Second tangent vector of the coordinate frame. +* @param norm Normal vector of the coordinate frame. +* @param qlocal State vector in local coordinate frame (input). +* @param qglobal State vector in global coordinate frame (output). +*/ +GKYL_CU_D +static inline void +rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, + double* GKYL_RESTRICT qglobal); + +/** +* Compute waves and speeds using Lax fluxes. +* +* @param eqn Base equation object. +* @param delta Jump across interface to split. +* @param ql Conserved variables on the left of the interface. +* @param qr Conserved variables on the right of the interface. +* @param waves Waves (output). +* @param s Wave speeds (output). +* @return Maximum wave speed. +*/ +GKYL_CU_D +static double +wave_lax(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s); + +/** +* Compute fluctuations using Lax fluxes. +* +* @param eqn Base equation object. +* @param ql Conserved variable vector on the left of the interface. +* @param qr Conserved variable vector on the right of the interface. +* @param waves Waves (input). +* @param s Wave speeds (input). +* @param amdq Left-moving fluctuations (output). +* @param apdq Right-moving fluctuations (output). +*/ +GKYL_CU_D +static void +qfluct_lax(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq); + +/** +* Compute waves and speeds using Lax fluxes (with potential fallback). +* +* @param eqn Base equation object. +* @param type Type of Riemann-solver flux to use. +* @param delta Jump across interface to split. +* @param ql Conserved variables on the left of the interface. +* @param qr Conserved variables on the right of the interface. +* @param waves Waves (output). +* @param s Wave speeds (output). +* @return Maximum wave speed. +*/ +GKYL_CU_D +static double +wave_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s); + +/** +* Compute fluctuations using Lax fluxes (with potential fallback), +* +* @param eqn Base equation object. +* @param type Type of Riemann-solver flux to use. +* @param ql Conserved variable vector on the left of the interface. +* @param qr Conserved variable vector on the right of the interface. +* @param waves Waves (input). +* @param s Wave speeds (input). +* @param amdq Left-moving fluctuations (output). +* @param apdq Right-moving fluctuations (output). +*/ +GKYL_CU_D +static void +qfluct_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, + double* amdq, double* apdq); + +/** +* Compute jump in flux given two conserved variable states. +* +* @param eqn Base equation object. +* @param ql Conserved variable vector on the left of the interface (input). +* @param qr Conserved variable vector on the right of the interface (input). +* @param flux_jump Jump in flux vector (output). +* @return Maximum wave speeds for states ql and qr. +*/ +GKYL_CU_D +static double +flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump); + +/** +* Determine whether invariant domain of the ~a equation is satisfied. +* +* @param eqn Base equation object. +* @param q Conserved variable vector. +* @return Whether the invariant domain is satisfied. +*/ +GKYL_CU_D +static bool +check_inv(const struct gkyl_wv_eqn* eqn, const double* q); + +/** +* Compute maximum wave speed from a conserved variable vector. +* +* @param eqn Base equation object. +* @param q Conserved variable vector. +* @return Maximum absolute wave speed. +*/ +GKYL_CU_D +static double +max_speed(const struct gkyl_wv_eqn* eqn, const double* q); + +/** +* Convert conserved variables to diagnostic variables. +* +* @param eqn Base equation object. +* @param qin Conserved variable vector (input). +* @param diag Diagnostic variable vector (output). +*/ +GKYL_CU_D +static inline void +~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag); + +/** +* Compute forcing/source term vector from conserved variable vector. +* +* @param eqn Base equation object. +* @param qin Conserved variable vector (input). +* @param sout Forcing/source term vector (output). +*/ +GKYL_CU_DH +static inline void +~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout); + +/** +* Free ~a equation object. +* +* @param ref Reference counter for ~a equation. +*/ +void +gkyl_~a_free(const struct gkyl_ref_count* ref); +" + name + parameter-def + parameter-comment + name + parameter-sig + parameter-comment + name + parameter-sig + name + name + name + name + name + name + name + name + name + name + )) + code) + +;; ------------------------------------------------------------------------------- +;; Source for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------------- +(define (gkyl-generate-lax-friedrichs-scalar-1d-source pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate Gkeyll C source code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define max-speed-local (flux-substitute max-speed-code cons-code "q[0]")) + (define flux-ui (flux-substitute flux-code cons-code "q[0]")) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) " = " + name "->" (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-name (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-field (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + (define parameter-field-set (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append name "->" (convert-expr (list-ref parameter 1)) + " = inp->" (convert-expr (list-ref parameter 1)) ";")) + parameters) "\n")] + [else ""])) + + (define code + (format " +#include +#include + +#include +#include +#include +#include + +static inline double +gkyl_~a_max_abs_speed(~a const double* q) +{ + return ~a; +} + +void +gkyl_~a_flux(~a const double* q, double* flux) +{ + flux[0] = ~a; +} + +static inline void +cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout) +{ + // TODO: This should use a proper L matrix. + wout[0] = qin[0]; +} + +static inline void +riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double* qout) +{ + // TODO: This should use a proper L matrix. + qout[0] = win[0]; +} + +static void +~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) +{ + ghost[0] = skin[0]; +} + +static void +~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) +{ + ghost[0] = skin[0]; +} + +static inline void +rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, + double* GKYL_RESTRICT qlocal) +{ + qlocal[0] = qglobal[0]; +} + +static inline void +rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, + double* GKYL_RESTRICT qglobal) +{ + qglobal[0] = qlocal[0]; +} + +static double +wave_lax(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + double sl = gkyl_~a_max_abs_speed(~a ql); + double sr = gkyl_~a_max_abs_speed(~a qr); + double amax = fmax(sl, sr); + + double *fl = gkyl_malloc(sizeof(double)); + double *fr = gkyl_malloc(sizeof(double)); + gkyl_~a_flux(~a ql, fl); + gkyl_~a_flux(~a qr, fr); + + double *w0 = &waves[0], *w1 = &waves[1]; + w0[0] = 0.5 * ((qr[0] - ql[0]) - (fr[0] - fl[0]) / amax); + w1[0] = 0.5 * ((qr[0] - ql[0]) + (fr[0] - fl[0]) / amax); + + s[0] = -amax; + s[1] = amax; + + gkyl_free(fl); + gkyl_free(fr); + + return s[1]; +} + +static void +qfluct_lax(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq) +{ + const double *w0 = &waves[0], *w1 = &waves[1]; + double s0m = fmin(0.0, s[0]), s1m = fmin(0.0, s[1]); + double s0p = fmax(0.0, s[0]), s1p = fmax(0.0, s[1]); + + amdq[0] = (s0m * w0[0]) + (s1m * w1[0]); + apdq[0] = (s0p * w0[0]) + (s1p * w1[0]); +} + +static double +wave_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s) +{ + return wave_lax(eqn, delta, ql, qr, waves, s); +} + +static void +qfluct_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, + double* amdq, double* apdq) +{ + return qfluct_lax(eqn, ql, qr, waves, s, amdq, apdq); +} + +static double +flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + double *fr = gkyl_malloc(sizeof(double)); + double *fl = gkyl_malloc(sizeof(double)); + gkyl_~a_flux(~a ql, fl); + gkyl_~a_flux(~a qr, fr); + + flux_jump[0] = fr[0] - fl[0]; + + double amaxl = gkyl_~a_max_abs_speed(~a ql); + double amaxr = gkyl_~a_max_abs_speed(~a qr); + + gkyl_free(fr); + gkyl_free(fl); + + return fmax(amaxl, amaxr); +} + +static bool +check_inv(const struct gkyl_wv_eqn* eqn, const double* q) +{ + return true; // All states are assumed to be valid. +} + +static double +max_speed(const struct gkyl_wv_eqn* eqn, const double* q) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + return gkyl_~a_max_abs_speed(~a q); +} + +static inline void +~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag) +{ + diag[0] = qin[0]; +} + +static inline void +~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout) +{ + sout[0] = 0.0; +} + +void +gkyl_~a_free(const struct gkyl_ref_count* ref) +{ + struct gkyl_wv_eqn* base = container_of(ref, struct gkyl_wv_eqn, ref_count); + + if (gkyl_wv_eqn_is_cu_dev(base)) { + // Free inner on_dev object. + struct wv_~a *~a = container_of(base->on_dev, struct wv_~a, eqn); + gkyl_cu_free(~a); + } + + struct wv_~a *~a = container_of(base, struct wv_~a, eqn); + gkyl_free(~a); +} + +struct gkyl_wv_eqn* +gkyl_wv_~a_new(~a bool use_gpu) +{ + return gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { + ~a + .rp_type = WV_~a_RP_LAX, + .use_gpu = use_gpu, + } + ); +} + +struct gkyl_wv_eqn* +gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp) +{ + struct wv_~a *~a = gkyl_malloc(sizeof(struct wv_~a)); + + ~a->eqn.type = GKYL_EQN_~a; + ~a->eqn.num_equations = 1; + ~a->eqn.num_diag = 1; + + ~a + + if (inp->rp_type == WV_~a_RP_LAX) { + ~a->eqn.num_waves = 2; + ~a->eqn.waves_func = wave_lax_l; + ~a->eqn.qfluct_func = qfluct_lax_l; + } + + ~a->eqn.flux_jump = flux_jump; + ~a->eqn.check_inv_func = check_inv; + ~a->eqn.max_speed_func = max_speed; + ~a->eqn.rotate_to_local_func = rot_to_local; + ~a->eqn.rotate_to_global_func = rot_to_global; + + ~a->eqn.wall_bc_func = ~a_wall; + ~a->eqn.no_slip_bc_func = ~a_no_slip; + + ~a->eqn.cons_to_riem = cons_to_riem; + ~a->eqn.riem_to_cons = riem_to_cons; + + ~a->eqn.cons_to_diag = ~a_cons_to_diag; + + ~a->eqn.source_func = ~a_source; + + ~a->eqn.flags = 0; + GKYL_CLEAR_CU_ALLOC(~a->eqn.flags); + ~a->eqn.ref_count = gkyl_ref_count_init(gkyl_~a_free); + ~a->eqn.on_dev = &~a->eqn; // On the CPU, the equation object points to itself. + + return &~a->eqn; +} +" + name + name + name + parameter-sig + max-speed-local + name + parameter-sig + flux-ui + name + name + name + name + name + parameter-def + name + parameter-name + name + parameter-name + name + parameter-name + name + parameter-name + name + name + name + parameter-def + name + parameter-name + name + parameter-name + name + parameter-name + name + parameter-name + name + name + name + parameter-def + name + parameter-name + name + name + name + name + name + name + name + name + name + name + name + name + parameter-sig + name + name + parameter-field + (string-upcase name) + name + name + name + name + name + name + (string-upcase name) + name + name + parameter-field-set + (string-upcase name) + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------ +;; C Regression Test for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------------------------ +(define (gkyl-generate-lax-friedrichs-scalar-1d-regression pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate a Gkeyll C regression test for the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define parameters (hash-ref pde 'parameters)) + + (define init-func-code (convert-expr init-func)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-assign (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 2))"; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-ctx-set (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + (define parameter-ctx (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = ctx." + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + + (define code + (format " +#include +#include +#include +#include + +#include +#include +#include +#include + +#include + +#ifdef GKYL_HAVE_MPI +#include +#include +#endif + +#include + +struct ~a_lax_ctx +{ + // Simulation parameters. + int Nx; // Cell count (x-direction). + double Lx; // Domain size (x-direction). + ~a + double cfl_frac; // CFL coefficient. + + double t_end; // Final simulation time. + int num_frames; // Number of output frames. + int field_energy_calcs; // Number of times to calculate field energy. + int integrated_mom_calcs; // Number of times to calculate integrated moments. + double dt_failure_tol; // Minimum allowable fraction of initial time-step. + int num_failures_max; // Maximum allowable number of consecutive small time-steps. +}; + +struct ~a_lax_ctx +create_ctx(void) +{ + // Simulation parameters. + int Nx = ~a; // Cell count (x-direction). + double Lx = ~a; // Domain size (x-direction). + ~a + double cfl_frac = ~a; // CFL coefficient. + + double t_end = ~a; // Final simulation time. + int num_frames = 1; // Number of output frames. + int field_energy_calcs = INT_MAX; // Number of times to calculate field energy. + int integrated_mom_calcs = INT_MAX; // Number of times to calculate integrated moments. + double dt_failure_tol = 1.0e-4; // Minimum allowable fraction of initial time-step. + int num_failures_max = 20; // Maximum allowable number of consecutive small time-steps. + + struct ~a_lax_ctx ctx = { + .Nx = Nx, + .Lx = Lx, + ~a + .cfl_frac = cfl_frac, + .t_end = t_end, + .num_frames = num_frames, + .field_energy_calcs = field_energy_calcs, + .integrated_mom_calcs = integrated_mom_calcs, + .dt_failure_tol = dt_failure_tol, + .num_failures_max = num_failures_max, + }; + + return ctx; +} + +void +eval~aInit(double t, const double* GKYL_RESTRICT xn, double* GKYL_RESTRICT fout, void* ctx) +{ + double x = xn[0]; + + // Set conserved quantity. + fout[0] = ~a; +} + +void +write_data(struct gkyl_tm_trigger* iot, gkyl_moment_app* app, double t_curr, bool force_write) +{ + if (gkyl_tm_trigger_check_and_bump(iot, t_curr) || force_write) { + int frame = iot->curr - 1; + if (force_write) { + frame = iot->curr; + } + + gkyl_moment_app_write(app, t_curr, frame); + gkyl_moment_app_write_field_energy(app); + gkyl_moment_app_write_integrated_mom(app); + } +} + +void +calc_field_energy(struct gkyl_tm_trigger* fet, gkyl_moment_app* app, double t_curr, bool force_calc) +{ + if (gkyl_tm_trigger_check_and_bump(fet, t_curr) || force_calc) { + gkyl_moment_app_calc_field_energy(app, t_curr); + } +} + +void +calc_integrated_mom(struct gkyl_tm_trigger* imt, gkyl_moment_app* app, double t_curr, bool force_calc) +{ + if (gkyl_tm_trigger_check_and_bump(imt, t_curr) || force_calc) { + gkyl_moment_app_calc_integrated_mom(app, t_curr); + } +} + +int +main(int argc, char **argv) +{ + struct gkyl_app_args app_args = parse_app_args(argc, argv); + +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Init(&argc, &argv); + } +#endif + + if (app_args.trace_mem) { + gkyl_cu_dev_mem_debug_set(true); + gkyl_mem_debug_set(true); + } + + struct ~a_lax_ctx ctx = create_ctx(); // Context for initialization functions. + + int NX = APP_ARGS_CHOOSE(app_args.xcells[0], ctx.Nx); + + // ~a equation. + struct gkyl_wv_eqn *~a = gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { + ~a + .rp_type = WV_~a_RP_LAX, + .use_gpu = app_args.use_gpu, + } + ); + + struct gkyl_moment_species fluid = { + .name = \"~a\", + .equation = ~a, + .evolve = true, + .init = eval~aInit, + .ctx = &ctx, + }; + + int nrank = 1; // Number of processes in simulation. +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Comm_size(MPI_COMM_WORLD, &nrank); + } +#endif + + // Create global range. + int cells[] = { NX }; + int dim = sizeof(cells) / sizeof(cells[0]); + + int cuts[dim]; +#ifdef GKYL_HAVE_MPI + for (int d = 0; d < dim; d++) { + if (app_args.use_mpi) { + cuts[d] = app_args.cuts[d]; + } + else { + cuts[d] = 1; + } + } +#else + for (int d = 0; d < dim; d++) { + cuts[d] = 1; + } +#endif + + // Construct communicator for use in app. + struct gkyl_comm *comm; +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + comm = gkyl_mpi_comm_new( &(struct gkyl_mpi_comm_inp) { + .mpi_comm = MPI_COMM_WORLD, + } + ); + } + else { + comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { + .use_gpu = app_args.use_gpu + } + ); + } +#else + comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { + .use_gpu = app_args.use_gpu + } + ); +#endif + + int my_rank; + gkyl_comm_get_rank(comm, &my_rank); + int comm_size; + gkyl_comm_get_size(comm, &comm_size); + + int ncuts = 1; + for (int d = 0; d < dim; d++) { + ncuts *= cuts[d]; + } + + if (ncuts != comm_size) { + if (my_rank == 0) { + fprintf(stderr, \"*** Number of ranks, %d, does not match total cuts, %d!\\n\", comm_size, ncuts); + } + goto mpifinalize; + } + + // Moment app. + struct gkyl_moment app_inp = { + .name = \"~a_lax\", + + .ndim = 1, + .lower = { ~a }, + .upper = { ~a + ctx.Lx }, + .cells = { NX }, + + .num_periodic_dir = 0, + .periodic_dirs = { }, + .cfl_frac = ctx.cfl_frac, + + .num_species = 1, + .species = { fluid }, + + .parallelism = { + .use_gpu = app_args.use_gpu, + .cuts = { app_args.cuts[0] }, + .comm = comm, + }, + }; + + // Create app object. + gkyl_moment_app *app = gkyl_moment_app_new(&app_inp); + + // Initial and final simulation times. + double t_curr = 0.0, t_end = ctx.t_end; + + // Initialize simulation. + int frame_curr = 0; + if (app_args.is_restart) { + struct gkyl_app_restart_status status = gkyl_moment_app_read_from_frame(app, app_args.restart_frame); + + if (status.io_status != GKYL_ARRAY_RIO_SUCCESS) { + gkyl_moment_app_cout(app, stderr, \"*** Failed to read restart file! (%s)\\n\", gkyl_array_rio_status_msg(status.io_status)); + goto freeresources; + } + + frame_curr = status.frame; + t_curr = status.stime; + + gkyl_moment_app_cout(app, stdout, \"Restarting from frame %d\", frame_curr); + gkyl_moment_app_cout(app, stdout, \" at time = %g\\n\", t_curr); + } + else { + gkyl_moment_app_apply_ic(app, t_curr); + } + + // Create trigger for field energy. + int field_energy_calcs = ctx.field_energy_calcs; + struct gkyl_tm_trigger fe_trig = { .dt = t_end / field_energy_calcs, .tcurr = t_curr, .curr = frame_curr }; + + calc_field_energy(&fe_trig, app, t_curr, false); + + // Create trigger for integrated moments. + int integrated_mom_calcs = ctx.integrated_mom_calcs; + struct gkyl_tm_trigger im_trig = { .dt = t_end / integrated_mom_calcs, .tcurr = t_curr, .curr = frame_curr }; + + calc_integrated_mom(&im_trig, app, t_curr, false); + + // Create trigger for IO. + int num_frames = ctx.num_frames; + struct gkyl_tm_trigger io_trig = { .dt = t_end / num_frames, .tcurr = t_curr, .curr = frame_curr }; + + write_data(&io_trig, app, t_curr, false); + + // Compute initial guess of maximum stable time-step. + double dt = t_end - t_curr; + + // Initialize small time-step check. + double dt_init = -1.0, dt_failure_tol = ctx.dt_failure_tol; + int num_failures = 0, num_failures_max = ctx.num_failures_max; + + long step = 1; + while ((t_curr < t_end) && (step <= app_args.num_steps)) { + gkyl_moment_app_cout(app, stdout, \"Taking time-step %ld at t = %g ...\", step, t_curr); + struct gkyl_update_status status = gkyl_moment_update(app, dt); + gkyl_moment_app_cout(app, stdout, \" dt = %g\\n\", status.dt_actual); + + if (!status.success) { + gkyl_moment_app_cout(app, stdout, \"** Update method failed! Aborting simulation ....\\n\"); + break; + } + + t_curr += status.dt_actual; + dt = status.dt_suggested; + + calc_field_energy(&fe_trig, app, t_curr, false); + calc_integrated_mom(&im_trig, app, t_curr, false); + write_data(&io_trig, app, t_curr, false); + + if (dt_init < 0.0) { + dt_init = status.dt_actual; + } + else if (status.dt_actual < dt_failure_tol * dt_init) { + num_failures += 1; + + gkyl_moment_app_cout(app, stdout, \"WARNING: Time-step dt = %g\", status.dt_actual); + gkyl_moment_app_cout(app, stdout, \" is below %g*dt_init ...\", dt_failure_tol); + gkyl_moment_app_cout(app, stdout, \" num_failures = %d\\n\", num_failures); + if (num_failures >= num_failures_max) { + gkyl_moment_app_cout(app, stdout, \"ERROR: Time-step was below %g*dt_init \", dt_failure_tol); + gkyl_moment_app_cout(app, stdout, \"%d consecutive times. Aborting simulation ....\\n\", num_failures_max); + + calc_field_energy(&fe_trig, app, t_curr, true); + calc_integrated_mom(&im_trig, app, t_curr, true); + write_data(&io_trig, app, t_curr, true); + + break; + } + } + else { + num_failures = 0; + } + + step += 1; + } + + calc_field_energy(&fe_trig, app, t_curr, false); + calc_integrated_mom(&im_trig, app, t_curr, false); + write_data(&io_trig, app, t_curr, false); + gkyl_moment_app_stat_write(app); + + struct gkyl_moment_stat stat = gkyl_moment_app_stat(app); + + gkyl_moment_app_cout(app, stdout, \"\\n\"); + gkyl_moment_app_cout(app, stdout, \"Number of update calls %ld\\n\", stat.nup); + gkyl_moment_app_cout(app, stdout, \"Number of failed time-steps %ld\\n\", stat.nfail); + gkyl_moment_app_cout(app, stdout, \"Species updates took %g secs\\n\", stat.species_tm); + gkyl_moment_app_cout(app, stdout, \"Field updates took %g secs\\n\", stat.field_tm); + gkyl_moment_app_cout(app, stdout, \"Source updates took %g secs\\n\", stat.sources_tm); + gkyl_moment_app_cout(app, stdout, \"Total updates took %g secs\\n\", stat.total_tm); + +freeresources: + // Free resources after simulation completion. + gkyl_wv_eqn_release(~a); + gkyl_comm_release(comm); + gkyl_moment_app_release(app); + +mpifinalize: +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Finalize(); + } +#endif + + return 0; +} + +" + name + name + parameter-def + name + nx + (- x1 x0) + parameter-assign + cfl + t-final + name + parameter-ctx-set + (string-titlecase name) + init-func-code + name + name + name + name + name + parameter-ctx + (string-upcase name) + name + name + (string-titlecase name) + name + x0 + x0 + name + )) + code) + +;; ------------------------------------------------------------- +;; Code for Gkeyll flux limiter (to be plugged into wave_prop.c) +;; ------------------------------------------------------------- +(define (gkyl-generate-flux-limiter limiter) + "Generate Gkeyll C code (to be inserted into wave_prop.c) for flux limiter `limiter`, to be used for second-order flux extrapolation." + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define code + (format " + case GKYL_~a: + theta = ~a; + break; +" + (string-upcase limiter-name) + limiter-r + )) + code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_code_generator_lax_vector.rkt b/provable-algorithms/finite_volume/gkyl_code_generator_lax_vector.rkt new file mode 100644 index 00000000..e2d35da0 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_code_generator_lax_vector.rkt @@ -0,0 +1,1305 @@ +#lang racket + +(require "code_generator_core.rkt") +(provide remove-bracketed-expressions + remove-bracketed-expressions-from-file + gkyl-generate-lax-friedrichs-vector2-1d-header + gkyl-generate-lax-friedrichs-vector2-1d-priv-header + gkyl-generate-lax-friedrichs-vector2-1d-source + gkyl-generate-lax-friedrichs-vector2-1d-regression) + +;; A simple boilerplate function for removing bracketed expressions from strings. +(define (remove-bracketed-expressions str) + (regexp-replace* #rx"\\[.*?\\]" str "")) + +;; A simple boilerplate function for removing bracketed expressions from files. +(define (remove-bracketed-expressions-from-file output-file) + (define content + (with-input-from-file output-file + (lambda () + (port->string (current-input-port))))) + (define cleaned + (remove-bracketed-expressions content)) + (with-output-to-file output-file #:exists 'replace + (lambda () + (display cleaned)))) + +;; ---------------------------------------------------------------------------------------------------- +;; Header for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; ---------------------------------------------------------------------------------------------------- +(define (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate Gkeyll C header code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define parameters (hash-ref pde-system 'parameters)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-comment (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) + parameters) "\n")] + [else "*"])) + + (define code + (format " +#pragma once + +#include + +// Type of Riemann-solver to use: +enum gkyl_wv_~a_rp { + WV_~a_RP_LAX = 0, // Default (Lax fluxes). +}; + +// Input context, packaged as a struct. +struct gkyl_wv_~a_inp { + ~a + + enum gkyl_wv_~a_rp rp_type; // Type of Riemann-solver to use. + bool use_gpu; // Whether the wave equation object is on the host (false) or the device (true). +}; + +/** +* Create a new ~a equations object. +* +~a +* @param use_gpu Whether the wave equation object is on the host (false) or the device (true). +* @return Pointer to the ~a equations object. +*/ +struct gkyl_wv_eqn* +gkyl_wv_~a_new(~a bool use_gpu); + +/** +* Create a new ~a equations object, from an input context struct. +* +* @param inp Input context struct. +* @return Pointer to the ~a equations object. +*/ +struct gkyl_wv_eqn* +gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp); +" + name + (string-upcase name) + name + parameter-def + name + name + parameter-comment + name + name + parameter-sig + name + name + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------------------ +;; Private Header for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------------------------------------------------ +(define (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate Gkeyll C private header code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define parameters (hash-ref pde-system 'parameters)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-comment (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) + parameters) "\n")] + [else "*"])) + + (define code + (format " +#pragma once + +// Private header, not for direct use in user-facing code. + +#include +#include +#include +#include +#include +#include + +struct wv_~a { + struct gkyl_wv_eqn eqn; // Base equation object. + ~a +}; + +/** +* Compute maximum absolute wave speed. +* +~a +* @param q Conserved variable vector. +* @return Maximum absolute wave speed for a given q. +*/ +GKYL_CU_D +static inline double +gkyl_~a_max_abs_speed(~a const double* q); + +/** +* Compute flux vector. Assumes rotation to local coordinate system. +* +~a +* @param q Conserved variable vector. +* @param flux Flux vector in direction 'dir' (output). +*/ +GKYL_CU_D +void +gkyl_~a_flux(~a const double* q, double* flux); + +/** +* Compute Riemann variables given the conserved variables. +* +* @param eqn Base equation object. +* @param qstate Current state vector. +* @param qin Conserved variable vector (input). +* @param wout Riemann variable vector (output). +*/ +GKYL_CU_D +static inline void +cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout); + +/** +* Compute conserved variables given the Riemann variables. +* +* @param eqn Base equation object. +* @param qstate Current state vector. +* @param win Riemann variable vector (input). +* @param qout Conserved variable vector (output). +*/ +GKYL_CU_D +static inline void +riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double *qout); + +/** +* Boundary condition function for applying wall boundary conditions for the ~a equations. +* +* @param eqn Base equation object. +* @param t Current simulation time. +* @param nc Number of boundary cells to which to apply wall boundary conditions. +* @param skin Skin cells in boundary region (from which values are copied). +* @param ghost Ghost cells in boundary region (to which values are copied). +* @param ctx Context to pass to the function. +*/ +GKYL_CU_D +static void +~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); + +/** +* Boundary condition function for applying no-slip boundary conditions for the ~a equations. +* +* @param eqn Base equation object. +* @param t Current simulation time. +* @param nc Number of boundary cells to which to apply no-slip boundary conditions. +* @param skin Skin cells in boundary region (from which values are copied). +* @param ghost Ghost cells in boundary region (to which values are copied). +* @param ctx Context to pass to the function. +*/ +GKYL_CU_D +static void +~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); + +/** +* Rotate state vector from global to local coordinate frame. +* +* @param eqn Base equation object. +* @param tau1 First tangent vector of the coordinate frame. +* @param tau2 Second tangent vector of the coordinate frame. +* @param norm Normal vector of the coordinate frame. +* @param qglobal State vector in global coordinate frame (input). +* @param qlocal State vector in local coordinate frame (output). +*/ +GKYL_CU_D +static inline void +rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, + double* GKYL_RESTRICT qlocal); + +/** +* Rotate state vector from local to global coordinate frame. +* +* @param eqn Base equation object. +* @param tau1 First tangent vector of the coordinate frame. +* @param tau2 Second tangent vector of the coordinate frame. +* @param norm Normal vector of the coordinate frame. +* @param qlocal State vector in local coordinate frame (input). +* @param qglobal State vector in global coordinate frame (output). +*/ +GKYL_CU_D +static inline void +rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, + double* GKYL_RESTRICT qglobal); + +/** +* Compute waves and speeds using Lax fluxes. +* +* @param eqn Base equation object. +* @param delta Jump across interface to split. +* @param ql Conserved variables on the left of the interface. +* @param qr Conserved variables on the right of the interface. +* @param waves Waves (output). +* @param s Wave speeds (output). +* @return Maximum wave speed. +*/ +GKYL_CU_D +static double +wave_lax(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s); + +/** +* Compute fluctuations using Lax fluxes. +* +* @param eqn Base equation object. +* @param ql Conserved variable vector on the left of the interface. +* @param qr Conserved variable vector on the right of the interface. +* @param waves Waves (input). +* @param s Wave speeds (input). +* @param amdq Left-moving fluctuations (output). +* @param apdq Right-moving fluctuations (output). +*/ +GKYL_CU_D +static void +qfluct_lax(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq); + +/** +* Compute waves and speeds using Lax fluxes (with potential fallback). +* +* @param eqn Base equation object. +* @param type Type of Riemann-solver flux to use. +* @param delta Jump across interface to split. +* @param ql Conserved variables on the left of the interface. +* @param qr Conserved variables on the right of the interface. +* @param waves Waves (output). +* @param s Wave speeds (output). +* @return Maximum wave speed. +*/ +GKYL_CU_D +static double +wave_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s); + +/** +* Compute fluctuations using Lax fluxes (with potential fallback), +* +* @param eqn Base equation object. +* @param type Type of Riemann-solver flux to use. +* @param ql Conserved variable vector on the left of the interface. +* @param qr Conserved variable vector on the right of the interface. +* @param waves Waves (input). +* @param s Wave speeds (input). +* @param amdq Left-moving fluctuations (output). +* @param apdq Right-moving fluctuations (output). +*/ +GKYL_CU_D +static void +qfluct_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, + double* amdq, double* apdq); + +/** +* Compute jump in flux given two conserved variable states. +* +* @param eqn Base equation object. +* @param ql Conserved variable vector on the left of the interface (input). +* @param qr Conserved variable vector on the right of the interface (input). +* @param flux_jump Jump in flux vector (output). +* @return Maximum wave speeds for states ql and qr. +*/ +GKYL_CU_D +static double +flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump); + +/** +* Determine whether invariant domain of the ~a equations is satisfied. +* +* @param eqn Base equation object. +* @param q Conserved variable vector. +* @return Whether the invariant domain is satisfied. +*/ +GKYL_CU_D +static bool +check_inv(const struct gkyl_wv_eqn* eqn, const double* q); + +/** +* Compute maximum wave speed from a conserved variable vector. +* +* @param eqn Base equation object. +* @param q Conserved variable vector. +* @return Maximum absolute wave speed. +*/ +GKYL_CU_D +static double +max_speed(const struct gkyl_wv_eqn* eqn, const double* q); + +/** +* Convert conserved variables to diagnostic variables. +* +* @param eqn Base equation object. +* @param qin Conserved variable vector (input). +* @param diag Diagnostic variable vector (output). +*/ +GKYL_CU_D +static inline void +~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag); + +/** +* Compute forcing/source term vector from conserved variable vector. +* +* @param eqn Base equation object. +* @param qin Conserved variable vector (input). +* @param sout Forcing/source term vector (output). +*/ +GKYL_CU_DH +static inline void +~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout); + +/** +* Free ~a equations object. +* +* @param ref Reference counter for ~a equations. +*/ +void +gkyl_~a_free(const struct gkyl_ref_count* ref); +" + name + parameter-def + parameter-comment + name + parameter-sig + parameter-comment + name + parameter-sig + name + name + name + name + name + name + name + name + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------------- +;; Source for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; ---------------------------------------------------------------------------------------------------- +(define (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate Gkeyll C source code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "q[0]") + (list-ref cons-codes 1) "q[1]")) max-speed-codes)) + (define flux-uis (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "q[0]") + (list-ref cons-codes 1) "q[1]")) flux-codes)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) " = " + name "->" (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-name (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-field (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + (define parameter-field-set (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append name "->" (convert-expr (list-ref parameter 1)) + " = inp->" (convert-expr (list-ref parameter 1)) ";")) + parameters) "\n")] + [else ""])) + + (define code + (format " +#include +#include + +#include +#include +#include +#include + +static inline double +gkyl_~a_max_abs_speed(~a const double* q) +{ + return fmax(~a, ~a); +} + +void +gkyl_~a_flux(~a const double* q, double* flux) +{ + flux[0] = ~a; + flux[1] = ~a; +} + +static inline void +cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout) +{ + // TODO: This should use a proper L matrix. + for (int i = 0; i < 2; i++) { + wout[i] = qin[i]; + } +} + +static inline void +riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double* qout) +{ + // TODO: This should use a proper L matrix. + for (int i = 0; i < 2; i++) { + qout[i] = win[i]; + } +} + +static void +~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) +{ + for (int i = 0; i < 2; i++) { + ghost[i] = skin[i]; + } +} + +static void +~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) +{ + for (int i = 0; i < 2; i++) { + ghost[i] = skin[i]; + } +} + +static inline void +rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, + double* GKYL_RESTRICT qlocal) +{ + for (int i = 0; i < 2; i++) { + qlocal[i] = qglobal[i]; + } +} + +static inline void +rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, + double* GKYL_RESTRICT qglobal) +{ + for (int i = 0; i < 2; i++) { + qglobal[i] = qlocal[i]; + } +} + +static double +wave_lax(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + double sl = gkyl_~a_max_abs_speed(~a ql); + double sr = gkyl_~a_max_abs_speed(~a qr); + double amax = fmax(sl, sr); + + double *fl = gkyl_malloc(sizeof(double) * 2); + double *fr = gkyl_malloc(sizeof(double) * 2); + gkyl_~a_flux(~a ql, fl); + gkyl_~a_flux(~a qr, fr); + + double *w0 = &waves[0], *w1 = &waves[2]; + for (int i = 0; i < 2; i++) { + w0[i] = 0.5 * ((qr[i] - ql[i]) - (fr[i] - fl[i]) / amax); + w1[i] = 0.5 * ((qr[i] - ql[i]) + (fr[i] - fl[i]) / amax); + } + + s[0] = -amax; + s[1] = amax; + + gkyl_free(fl); + gkyl_free(fr); + + return s[1]; +} + +static void +qfluct_lax(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq) +{ + const double *w0 = &waves[0], *w1 = &waves[2]; + double s0m = fmin(0.0, s[0]), s1m = fmin(0.0, s[1]); + double s0p = fmax(0.0, s[0]), s1p = fmax(0.0, s[1]); + + for (int i = 0; i < 2; i++) { + amdq[i] = (s0m * w0[i]) + (s1m * w1[i]); + apdq[i] = (s0p * w0[i]) + (s1p * w1[i]); + } +} + +static double +wave_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s) +{ + return wave_lax(eqn, delta, ql, qr, waves, s); +} + +static void +qfluct_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, + double* amdq, double* apdq) +{ + return qfluct_lax(eqn, ql, qr, waves, s, amdq, apdq); +} + +static double +flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + double *fr = gkyl_malloc(sizeof(double) * 2); + double *fl = gkyl_malloc(sizeof(double) * 2); + gkyl_~a_flux(~a ql, fl); + gkyl_~a_flux(~a qr, fr); + + for (int i = 0; i < 2; i++) { + flux_jump[i] = fr[i] - fl[i]; + } + + double amaxl = gkyl_~a_max_abs_speed(~a ql); + double amaxr = gkyl_~a_max_abs_speed(~a qr); + + gkyl_free(fr); + gkyl_free(fl); + + return fmax(amaxl, amaxr); +} + +static bool +check_inv(const struct gkyl_wv_eqn* eqn, const double* q) +{ + return true; // All states are assumed to be valid. +} + +static double +max_speed(const struct gkyl_wv_eqn* eqn, const double* q) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + return gkyl_~a_max_abs_speed(~a q); +} + +static inline void +~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag) +{ + for (int i = 0; i < 2; i++) { + diag[i] = qin[i]; + } +} + +static inline void +~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout) +{ + for (int i = 0; i < 2; i++) { + sout[i] = 0.0; + } +} + +void +gkyl_~a_free(const struct gkyl_ref_count* ref) +{ + struct gkyl_wv_eqn* base = container_of(ref, struct gkyl_wv_eqn, ref_count); + + if (gkyl_wv_eqn_is_cu_dev(base)) { + // Free inner on_dev object. + struct wv_~a *~a = container_of(base->on_dev, struct wv_~a, eqn); + gkyl_cu_free(~a); + } + + struct wv_~a *~a = container_of(base, struct wv_~a, eqn); + gkyl_free(~a); +} + +struct gkyl_wv_eqn* +gkyl_wv_~a_new(~a bool use_gpu) +{ + return gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { + ~a + .rp_type = WV_~a_RP_LAX, + .use_gpu = use_gpu, + } + ); +} + +struct gkyl_wv_eqn* +gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp) +{ + struct wv_~a *~a = gkyl_malloc(sizeof(struct wv_~a)); + + ~a->eqn.type = GKYL_EQN_~a; + ~a->eqn.num_equations = 2; + ~a->eqn.num_diag = 2; + + ~a + + if (inp->rp_type == WV_~a_RP_LAX) { + ~a->eqn.num_waves = 2; + ~a->eqn.waves_func = wave_lax_l; + ~a->eqn.qfluct_func = qfluct_lax_l; + } + + ~a->eqn.flux_jump = flux_jump; + ~a->eqn.check_inv_func = check_inv; + ~a->eqn.max_speed_func = max_speed; + ~a->eqn.rotate_to_local_func = rot_to_local; + ~a->eqn.rotate_to_global_func = rot_to_global; + + ~a->eqn.wall_bc_func = ~a_wall; + ~a->eqn.no_slip_bc_func = ~a_no_slip; + + ~a->eqn.cons_to_riem = cons_to_riem; + ~a->eqn.riem_to_cons = riem_to_cons; + + ~a->eqn.cons_to_diag = ~a_cons_to_diag; + + ~a->eqn.source_func = ~a_source; + + ~a->eqn.flags = 0; + GKYL_CLEAR_CU_ALLOC(~a->eqn.flags); + ~a->eqn.ref_count = gkyl_ref_count_init(gkyl_~a_free); + ~a->eqn.on_dev = &~a->eqn; // On the CPU, the equation object points to itself. + + return &~a->eqn; +} +" + name + name + name + parameter-sig + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + name + parameter-sig + (list-ref flux-uis 0) + (list-ref flux-uis 1) + name + name + name + name + name + parameter-def + name + parameter-name + name + parameter-name + name + parameter-name + name + parameter-name + name + name + name + parameter-def + name + parameter-name + name + parameter-name + name + parameter-name + name + parameter-name + name + name + name + parameter-def + name + parameter-name + name + name + name + name + name + name + name + name + name + name + name + name + parameter-sig + name + name + parameter-field + (string-upcase name) + name + name + name + name + name + name + (string-upcase name) + name + name + parameter-field-set + (string-upcase name) + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + )) + code) + +;; --------------------------------------------------------------------------------------------------------------- +;; C Regression Test for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; --------------------------------------------------------------------------------------------------------------- +(define (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate a Gkeyll C regression test for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define parameters (hash-ref pde-system 'parameters)) + + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-assign (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 2))"; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-ctx-set (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + (define parameter-ctx (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = ctx." + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + + (define code + (format " +#include +#include +#include +#include + +#include +#include +#include +#include + +#include + +#ifdef GKYL_HAVE_MPI +#include +#include +#endif + +#include + +struct ~a_lax_ctx +{ + // Simulation parameters. + int Nx; // Cell count (x-direction). + double Lx; // Domain size (x-direction). + ~a + double cfl_frac; // CFL coefficient. + + double t_end; // Final simulation time. + int num_frames; // Number of output frames. + int field_energy_calcs; // Number of times to calculate field energy. + int integrated_mom_calcs; // Number of times to calculate integrated moments. + double dt_failure_tol; // Minimum allowable fraction of initial time-step. + int num_failures_max; // Maximum allowable number of consecutive small time-steps. +}; + +struct ~a_lax_ctx +create_ctx(void) +{ + // Simulation parameters. + int Nx = ~a; // Cell count (x-direction). + double Lx = ~a; // Domain size (x-direction). + ~a + double cfl_frac = ~a; // CFL coefficient. + + double t_end = ~a; // Final simulation time. + int num_frames = 1; // Number of output frames. + int field_energy_calcs = INT_MAX; // Number of times to calculate field energy. + int integrated_mom_calcs = INT_MAX; // Number of times to calculate integrated moments. + double dt_failure_tol = 1.0e-4; // Minimum allowable fraction of initial time-step. + int num_failures_max = 20; // Maximum allowable number of consecutive small time-steps. + + struct ~a_lax_ctx ctx = { + .Nx = Nx, + .Lx = Lx, + ~a + .cfl_frac = cfl_frac, + .t_end = t_end, + .num_frames = num_frames, + .field_energy_calcs = field_energy_calcs, + .integrated_mom_calcs = integrated_mom_calcs, + .dt_failure_tol = dt_failure_tol, + .num_failures_max = num_failures_max, + }; + + return ctx; +} + +void +eval~aInit(double t, const double* GKYL_RESTRICT xn, double* GKYL_RESTRICT fout, void* ctx) +{ + double x = xn[0]; + + // Set conserved quantities. + fout[0] = ~a; + fout[1] = ~a; +} + +void +write_data(struct gkyl_tm_trigger* iot, gkyl_moment_app* app, double t_curr, bool force_write) +{ + if (gkyl_tm_trigger_check_and_bump(iot, t_curr) || force_write) { + int frame = iot->curr - 1; + if (force_write) { + frame = iot->curr; + } + + gkyl_moment_app_write(app, t_curr, frame); + gkyl_moment_app_write_field_energy(app); + gkyl_moment_app_write_integrated_mom(app); + } +} + +void +calc_field_energy(struct gkyl_tm_trigger* fet, gkyl_moment_app* app, double t_curr, bool force_calc) +{ + if (gkyl_tm_trigger_check_and_bump(fet, t_curr) || force_calc) { + gkyl_moment_app_calc_field_energy(app, t_curr); + } +} + +void +calc_integrated_mom(struct gkyl_tm_trigger* imt, gkyl_moment_app* app, double t_curr, bool force_calc) +{ + if (gkyl_tm_trigger_check_and_bump(imt, t_curr) || force_calc) { + gkyl_moment_app_calc_integrated_mom(app, t_curr); + } +} + +int +main(int argc, char **argv) +{ + struct gkyl_app_args app_args = parse_app_args(argc, argv); + +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Init(&argc, &argv); + } +#endif + + if (app_args.trace_mem) { + gkyl_cu_dev_mem_debug_set(true); + gkyl_mem_debug_set(true); + } + + struct ~a_lax_ctx ctx = create_ctx(); // Context for initialization functions. + + int NX = APP_ARGS_CHOOSE(app_args.xcells[0], ctx.Nx); + + // ~a equation. + struct gkyl_wv_eqn *~a = gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { + ~a + .rp_type = WV_~a_RP_LAX, + .use_gpu = app_args.use_gpu, + } + ); + + struct gkyl_moment_species fluid = { + .name = \"~a\", + .equation = ~a, + .evolve = true, + .init = eval~aInit, + .ctx = &ctx, + }; + + int nrank = 1; // Number of processes in simulation. +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Comm_size(MPI_COMM_WORLD, &nrank); + } +#endif + + // Create global range. + int cells[] = { NX }; + int dim = sizeof(cells) / sizeof(cells[0]); + + int cuts[dim]; +#ifdef GKYL_HAVE_MPI + for (int d = 0; d < dim; d++) { + if (app_args.use_mpi) { + cuts[d] = app_args.cuts[d]; + } + else { + cuts[d] = 1; + } + } +#else + for (int d = 0; d < dim; d++) { + cuts[d] = 1; + } +#endif + + // Construct communicator for use in app. + struct gkyl_comm *comm; +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + comm = gkyl_mpi_comm_new( &(struct gkyl_mpi_comm_inp) { + .mpi_comm = MPI_COMM_WORLD, + } + ); + } + else { + comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { + .use_gpu = app_args.use_gpu + } + ); + } +#else + comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { + .use_gpu = app_args.use_gpu + } + ); +#endif + + int my_rank; + gkyl_comm_get_rank(comm, &my_rank); + int comm_size; + gkyl_comm_get_size(comm, &comm_size); + + int ncuts = 1; + for (int d = 0; d < dim; d++) { + ncuts *= cuts[d]; + } + + if (ncuts != comm_size) { + if (my_rank == 0) { + fprintf(stderr, \"*** Number of ranks, %d, does not match total cuts, %d!\\n\", comm_size, ncuts); + } + goto mpifinalize; + } + + // Moment app. + struct gkyl_moment app_inp = { + .name = \"~a_lax\", + + .ndim = 1, + .lower = { ~a }, + .upper = { ~a + ctx.Lx }, + .cells = { NX }, + + .num_periodic_dir = 0, + .periodic_dirs = { }, + .cfl_frac = ctx.cfl_frac, + + .num_species = 1, + .species = { fluid }, + + .parallelism = { + .use_gpu = app_args.use_gpu, + .cuts = { app_args.cuts[0] }, + .comm = comm, + }, + }; + + // Create app object. + gkyl_moment_app *app = gkyl_moment_app_new(&app_inp); + + // Initial and final simulation times. + double t_curr = 0.0, t_end = ctx.t_end; + + // Initialize simulation. + int frame_curr = 0; + if (app_args.is_restart) { + struct gkyl_app_restart_status status = gkyl_moment_app_read_from_frame(app, app_args.restart_frame); + + if (status.io_status != GKYL_ARRAY_RIO_SUCCESS) { + gkyl_moment_app_cout(app, stderr, \"*** Failed to read restart file! (%s)\\n\", gkyl_array_rio_status_msg(status.io_status)); + goto freeresources; + } + + frame_curr = status.frame; + t_curr = status.stime; + + gkyl_moment_app_cout(app, stdout, \"Restarting from frame %d\", frame_curr); + gkyl_moment_app_cout(app, stdout, \" at time = %g\\n\", t_curr); + } + else { + gkyl_moment_app_apply_ic(app, t_curr); + } + + // Create trigger for field energy. + int field_energy_calcs = ctx.field_energy_calcs; + struct gkyl_tm_trigger fe_trig = { .dt = t_end / field_energy_calcs, .tcurr = t_curr, .curr = frame_curr }; + + calc_field_energy(&fe_trig, app, t_curr, false); + + // Create trigger for integrated moments. + int integrated_mom_calcs = ctx.integrated_mom_calcs; + struct gkyl_tm_trigger im_trig = { .dt = t_end / integrated_mom_calcs, .tcurr = t_curr, .curr = frame_curr }; + + calc_integrated_mom(&im_trig, app, t_curr, false); + + // Create trigger for IO. + int num_frames = ctx.num_frames; + struct gkyl_tm_trigger io_trig = { .dt = t_end / num_frames, .tcurr = t_curr, .curr = frame_curr }; + + write_data(&io_trig, app, t_curr, false); + + // Compute initial guess of maximum stable time-step. + double dt = t_end - t_curr; + + // Initialize small time-step check. + double dt_init = -1.0, dt_failure_tol = ctx.dt_failure_tol; + int num_failures = 0, num_failures_max = ctx.num_failures_max; + + long step = 1; + while ((t_curr < t_end) && (step <= app_args.num_steps)) { + gkyl_moment_app_cout(app, stdout, \"Taking time-step %ld at t = %g ...\", step, t_curr); + struct gkyl_update_status status = gkyl_moment_update(app, dt); + gkyl_moment_app_cout(app, stdout, \" dt = %g\\n\", status.dt_actual); + + if (!status.success) { + gkyl_moment_app_cout(app, stdout, \"** Update method failed! Aborting simulation ....\\n\"); + break; + } + + t_curr += status.dt_actual; + dt = status.dt_suggested; + + calc_field_energy(&fe_trig, app, t_curr, false); + calc_integrated_mom(&im_trig, app, t_curr, false); + write_data(&io_trig, app, t_curr, false); + + if (dt_init < 0.0) { + dt_init = status.dt_actual; + } + else if (status.dt_actual < dt_failure_tol * dt_init) { + num_failures += 1; + + gkyl_moment_app_cout(app, stdout, \"WARNING: Time-step dt = %g\", status.dt_actual); + gkyl_moment_app_cout(app, stdout, \" is below %g*dt_init ...\", dt_failure_tol); + gkyl_moment_app_cout(app, stdout, \" num_failures = %d\\n\", num_failures); + if (num_failures >= num_failures_max) { + gkyl_moment_app_cout(app, stdout, \"ERROR: Time-step was below %g*dt_init \", dt_failure_tol); + gkyl_moment_app_cout(app, stdout, \"%d consecutive times. Aborting simulation ....\\n\", num_failures_max); + + calc_field_energy(&fe_trig, app, t_curr, true); + calc_integrated_mom(&im_trig, app, t_curr, true); + write_data(&io_trig, app, t_curr, true); + + break; + } + } + else { + num_failures = 0; + } + + step += 1; + } + + calc_field_energy(&fe_trig, app, t_curr, false); + calc_integrated_mom(&im_trig, app, t_curr, false); + write_data(&io_trig, app, t_curr, false); + gkyl_moment_app_stat_write(app); + + struct gkyl_moment_stat stat = gkyl_moment_app_stat(app); + + gkyl_moment_app_cout(app, stdout, \"\\n\"); + gkyl_moment_app_cout(app, stdout, \"Number of update calls %ld\\n\", stat.nup); + gkyl_moment_app_cout(app, stdout, \"Number of failed time-steps %ld\\n\", stat.nfail); + gkyl_moment_app_cout(app, stdout, \"Species updates took %g secs\\n\", stat.species_tm); + gkyl_moment_app_cout(app, stdout, \"Field updates took %g secs\\n\", stat.field_tm); + gkyl_moment_app_cout(app, stdout, \"Source updates took %g secs\\n\", stat.sources_tm); + gkyl_moment_app_cout(app, stdout, \"Total updates took %g secs\\n\", stat.total_tm); + +freeresources: + // Free resources after simulation completion. + gkyl_wv_eqn_release(~a); + gkyl_comm_release(comm); + gkyl_moment_app_release(app); + +mpifinalize: +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Finalize(); + } +#endif + + return 0; +} + +" + name + name + parameter-def + name + nx + (- x1 x0) + parameter-assign + cfl + t-final + name + parameter-ctx-set + (string-titlecase name) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + name + name + name + name + name + parameter-ctx + (string-upcase name) + name + name + (string-titlecase name) + name + x0 + x0 + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_code_generator_roe.rkt b/provable-algorithms/finite_volume/gkyl_code_generator_roe.rkt new file mode 100644 index 00000000..fcb7d2d5 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_code_generator_roe.rkt @@ -0,0 +1,1261 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "prover_core.rkt") +(provide gkyl-generate-roe-scalar-1d-header + gkyl-generate-roe-scalar-1d-priv-header + gkyl-generate-roe-scalar-1d-source + gkyl-generate-roe-scalar-1d-regression) + +;; ---------------------------------------------------------------- +;; Header for Gkeyll Roe (Finite-Volume) Solver for a 1D Scalar PDE +;; ---------------------------------------------------------------- +(define (gkyl-generate-roe-scalar-1d-header pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate Gkeyll C header code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define parameters (hash-ref pde 'parameters)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-comment (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) + parameters) "\n")] + [else "*"])) + + (define code + (format " +#pragma once + +#include + +// Type of Riemann-solver to use: +enum gkyl_wv_~a_rp { + WV_~a_RP_ROE = 0, // Default (Roe fluxes). +}; + +// Input context, packaged as a struct. +struct gkyl_wv_~a_inp { + ~a + + enum gkyl_wv_~a_rp rp_type; // Type of Riemann-solver to use. + bool use_gpu; // Whether the wave equation object is on the host (false) or the device (true). +}; + +/** +* Create a new ~a equations object. +* +~a +* @param use_gpu Whether the wave equation object is on the host (false) or the device (true). +* @return Pointer to the ~a equations object. +*/ +struct gkyl_wv_eqn* +gkyl_wv_~a_new(~a bool use_gpu); + +/** +* Create a new ~a equations object, from an input context struct. +* +* @param inp Input context struct. +* @return Pointer to the ~a equations object. +*/ +struct gkyl_wv_eqn* +gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp); +" + name + (string-upcase name) + name + parameter-def + name + name + parameter-comment + name + name + parameter-sig + name + name + name + name + )) + code) + +;; ------------------------------------------------------------------------ +;; Private Header for Gkeyll Roe (Finite-Volume) Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------ +(define (gkyl-generate-roe-scalar-1d-priv-header pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate Gkeyll C private header code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define parameters (hash-ref pde 'parameters)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-comment (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) + parameters) "\n")] + [else "*"])) + + (define code + (format " +#pragma once + +// Private header, not for direct use in user-facing code. + +#include +#include +#include +#include +#include +#include + +struct wv_~a { + struct gkyl_wv_eqn eqn; // Base equation object. + ~a +}; + +/** +* Compute maximum absolute wave speed. +* +~a +* @param q Conserved variable vector. +* @return Maximum absolute wave speed for a given q. +*/ +GKYL_CU_D +static inline double +gkyl_~a_max_abs_speed(~a const double* q); + +/** +* Compute flux vector. Assumes rotation to local coordinate system. +* +~a +* @param q Conserved variable vector. +* @param flux Flux vector in direction 'dir' (output). +*/ +GKYL_CU_D +void +gkyl_~a_flux(~a const double* q, double* flux); + +/** +* Compute eigenvalues of the flux Jacobian. Assumes rotation to local coordinate system. +* +~a +* @param q Conserved variable vector. +* @param flux_deriv Flux Jacobian eigenvalues in direction 'dir' (output). +*/ +GKYL_CU_D +void +gkyl_~a_flux_deriv(~a const double* q, double* flux_deriv); + +/** +* Compute Riemann variables given the conserved variables. +* +* @param eqn Base equation object. +* @param qstate Current state vector. +* @param qin Conserved variable vector (input). +* @param wout Riemann variable vector (output). +*/ +GKYL_CU_D +static inline void +cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout); + +/** +* Compute conserved variables given the Riemann variables. +* +* @param eqn Base equation object. +* @param qstate Current state vector. +* @param win Riemann variable vector (input). +* @param qout Conserved variable vector (output). +*/ +GKYL_CU_D +static inline void +riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double *qout); + +/** +* Boundary condition function for applying wall boundary conditions for the ~a equations. +* +* @param eqn Base equation object. +* @param t Current simulation time. +* @param nc Number of boundary cells to which to apply wall boundary conditions. +* @param skin Skin cells in boundary region (from which values are copied). +* @param ghost Ghost cells in boundary region (to which values are copied). +* @param ctx Context to pass to the function. +*/ +GKYL_CU_D +static void +~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); + +/** +* Boundary condition function for applying no-slip boundary conditions for the ~a equations. +* +* @param eqn Base equation object. +* @param t Current simulation time. +* @param nc Number of boundary cells to which to apply no-slip boundary conditions. +* @param skin Skin cells in boundary region (from which values are copied). +* @param ghost Ghost cells in boundary region (to which values are copied). +* @param ctx Context to pass to the function. +*/ +GKYL_CU_D +static void +~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); + +/** +* Rotate state vector from global to local coordinate frame. +* +* @param eqn Base equation object. +* @param tau1 First tangent vector of the coordinate frame. +* @param tau2 Second tangent vector of the coordinate frame. +* @param norm Normal vector of the coordinate frame. +* @param qglobal State vector in global coordinate frame (input). +* @param qlocal State vector in local coordinate frame (output). +*/ +GKYL_CU_D +static inline void +rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, + double* GKYL_RESTRICT qlocal); + +/** +* Rotate state vector from local to global coordinate frame. +* +* @param eqn Base equation object. +* @param tau1 First tangent vector of the coordinate frame. +* @param tau2 Second tangent vector of the coordinate frame. +* @param norm Normal vector of the coordinate frame. +* @param qlocal State vector in local coordinate frame (input). +* @param qglobal State vector in global coordinate frame (output). +*/ +GKYL_CU_D +static inline void +rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, + double* GKYL_RESTRICT qglobal); + +/** +* Compute waves and speeds using Roe fluxes. +* +* @param eqn Base equation object. +* @param delta Jump across interface to split. +* @param ql Conserved variables on the left of the interface. +* @param qr Conserved variables on the right of the interface. +* @param waves Waves (output). +* @param s Wave speeds (output). +* @return Maximum wave speed. +*/ +GKYL_CU_D +static double +wave_roe(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s); + +/** +* Compute fluctuations using Roe fluxes. +* +* @param eqn Base equation object. +* @param ql Conserved variable vector on the left of the interface. +* @param qr Conserved variable vector on the right of the interface. +* @param waves Waves (input). +* @param s Wave speeds (input). +* @param amdq Left-moving fluctuations (output). +* @param apdq Right-moving fluctuations (output). +*/ +GKYL_CU_D +static void +qfluct_roe(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq); + +/** +* Compute waves and speeds using Roe fluxes (with potential fallback). +* +* @param eqn Base equation object. +* @param type Type of Riemann-solver flux to use. +* @param delta Jump across interface to split. +* @param ql Conserved variables on the left of the interface. +* @param qr Conserved variables on the right of the interface. +* @param waves Waves (output). +* @param s Wave speeds (output). +* @return Maximum wave speed. +*/ +GKYL_CU_D +static double +wave_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s); + +/** +* Compute fluctuations using Roe fluxes (with potential fallback), +* +* @param eqn Base equation object. +* @param type Type of Riemann-solver flux to use. +* @param ql Conserved variable vector on the left of the interface. +* @param qr Conserved variable vector on the right of the interface. +* @param waves Waves (input). +* @param s Wave speeds (input). +* @param amdq Left-moving fluctuations (output). +* @param apdq Right-moving fluctuations (output). +*/ +GKYL_CU_D +static void +qfluct_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, + double* amdq, double* apdq); + +/** +* Compute jump in flux given two conserved variable states. +* +* @param eqn Base equation object. +* @param ql Conserved variable vector on the left of the interface (input). +* @param qr Conserved variable vector on the right of the interface (input). +* @param flux_jump Jump in flux vector (output). +* @return Maximum wave speeds for states ql and qr. +*/ +GKYL_CU_D +static double +flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump); + +/** +* Determine whether invariant domain of the ~a equations is satisfied. +* +* @param eqn Base equation object. +* @param q Conserved variable vector. +* @return Whether the invariant domain is satisfied. +*/ +GKYL_CU_D +static bool +check_inv(const struct gkyl_wv_eqn* eqn, const double* q); + +/** +* Compute maximum wave speed from a conserved variable vector. +* +* @param eqn Base equation object. +* @param q Conserved variable vector. +* @return Maximum absolute wave speed. +*/ +GKYL_CU_D +static double +max_speed(const struct gkyl_wv_eqn* eqn, const double* q); + +/** +* Convert conserved variables to diagnostic variables. +* +* @param eqn Base equation object. +* @param qin Conserved variable vector (input). +* @param diag Diagnostic variable vector (output). +*/ +GKYL_CU_D +static inline void +~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag); + +/** +* Compute forcing/source term vector from conserved variable vector. +* +* @param eqn Base equation object. +* @param qin Conserved variable vector (input). +* @param sout Forcing/source term vector (output). +*/ +GKYL_CU_DH +static inline void +~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout); + +/** +* Free ~a equations object. +* +* @param ref Reference counter for ~a equations. +*/ +void +gkyl_~a_free(const struct gkyl_ref_count* ref); +" + name + parameter-def + parameter-comment + name + parameter-sig + parameter-comment + name + parameter-sig + parameter-comment + name + parameter-sig + name + name + name + name + name + name + name + name + name + name + )) + code) + +;; ---------------------------------------------------------------- +;; Source for Gkeyll Roe (Finite-Volume) Solver for a 1D Scalar PDE +;; ---------------------------------------------------------------- +(define (gkyl-generate-roe-scalar-1d-source pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate Gkeyll C source code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define flux-deriv-code (convert-expr flux-deriv)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define max-speed-local (flux-substitute max-speed-code cons-code "q[0]")) + (define flux-ui (flux-substitute flux-code cons-code "q[0]")) + (define flux-deriv-ui (flux-substitute flux-deriv-code cons-code "q[0]")) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) " = " + name "->" (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-name (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-field (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + (define parameter-field-set (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append name "->" (convert-expr (list-ref parameter 1)) + " = inp->" (convert-expr (list-ref parameter 1)) ";")) + parameters) "\n")] + [else ""])) + + (define code + (format " +#include +#include + +#include +#include +#include +#include + +static inline double +gkyl_~a_max_abs_speed(~a const double* q) +{ + return ~a; +} + +void +gkyl_~a_flux(~a const double* q, double* flux) +{ + flux[0] = ~a; +} + +void +gkyl_~a_flux_deriv(~a const double* q, double* flux_deriv) +{ + flux_deriv[0] = ~a; +} + +static inline void +cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout) +{ + // TODO: This should use a proper L matrix. + wout[0] = qin[0]; +} + +static inline void +riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double* qout) +{ + // TODO: This should use a proper L matrix. + qout[0] = win[0]; +} + +static void +~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) +{ + ghost[0] = skin[0]; +} + +static void +~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) +{ + ghost[0] = skin[0]; +} + +static inline void +rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, + double* GKYL_RESTRICT qlocal) +{ + qlocal[0] = qglobal[0]; +} + +static inline void +rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, + double* GKYL_RESTRICT qglobal) +{ + qglobal[0] = qlocal[0]; +} + +static double +wave_roe(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + double *fl_deriv = gkyl_malloc(sizeof(double)); + double *fr_deriv = gkyl_malloc(sizeof(double)); + gkyl_~a_flux_deriv(~a ql, fl_deriv); + gkyl_~a_flux_deriv(~a qr, fr_deriv); + + double a_roe = 0.5 * (fl_deriv[0] + fr_deriv[0]); + + double *w0 = &waves[0]; + w0[0] = delta[0]; + + s[0] = a_roe; + + gkyl_free(fl_deriv); + gkyl_free(fr_deriv); + + return s[0]; +} + +static void +qfluct_roe(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq) +{ + const double *w0 = &waves[0]; + + if (s[0] < 0.0) { + amdq[0] = s[0] * w0[0]; + apdq[0] = 0.0; + } + else { + amdq[0] = 0.0; + apdq[0] = s[0] * w0[0]; + } +} + +static double +wave_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s) +{ + return wave_roe(eqn, delta, ql, qr, waves, s); +} + +static void +qfluct_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, + double* amdq, double* apdq) +{ + return qfluct_roe(eqn, ql, qr, waves, s, amdq, apdq); +} + +static double +flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + double *fr = gkyl_malloc(sizeof(double)); + double *fl = gkyl_malloc(sizeof(double)); + gkyl_~a_flux(~a ql, fl); + gkyl_~a_flux(~a qr, fr); + + flux_jump[0] = fr[0] - fl[0]; + + double amaxl = gkyl_~a_max_abs_speed(~a ql); + double amaxr = gkyl_~a_max_abs_speed(~a qr); + + gkyl_free(fr); + gkyl_free(fl); + + return fmax(amaxl, amaxr); +} + +static bool +check_inv(const struct gkyl_wv_eqn* eqn, const double* q) +{ + return true; // All states are assumed to be valid. +} + +static double +max_speed(const struct gkyl_wv_eqn* eqn, const double* q) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + return gkyl_~a_max_abs_speed(~a q); +} + +static inline void +~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag) +{ + diag[0] = qin[0]; +} + +static inline void +~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout) +{ + sout[0] = 0.0; +} + +void +gkyl_~a_free(const struct gkyl_ref_count* ref) +{ + struct gkyl_wv_eqn* base = container_of(ref, struct gkyl_wv_eqn, ref_count); + + if (gkyl_wv_eqn_is_cu_dev(base)) { + // Free inner on_dev object. + struct wv_~a *~a = container_of(base->on_dev, struct wv_~a, eqn); + gkyl_cu_free(~a); + } + + struct wv_~a *~a = container_of(base, struct wv_~a, eqn); + gkyl_free(~a); +} + +struct gkyl_wv_eqn* +gkyl_wv_~a_new(~a bool use_gpu) +{ + return gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { + ~a + .rp_type = WV_~a_RP_ROE, + .use_gpu = use_gpu, + } + ); +} + +struct gkyl_wv_eqn* +gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp) +{ + struct wv_~a *~a = gkyl_malloc(sizeof(struct wv_~a)); + + ~a->eqn.type = GKYL_EQN_~a; + ~a->eqn.num_equations = 1; + ~a->eqn.num_diag = 1; + + ~a + + if (inp->rp_type == WV_~a_RP_ROE) { + ~a->eqn.num_waves = 1; + ~a->eqn.waves_func = wave_roe_l; + ~a->eqn.qfluct_func = qfluct_roe_l; + } + + ~a->eqn.flux_jump = flux_jump; + ~a->eqn.check_inv_func = check_inv; + ~a->eqn.max_speed_func = max_speed; + ~a->eqn.rotate_to_local_func = rot_to_local; + ~a->eqn.rotate_to_global_func = rot_to_global; + + ~a->eqn.wall_bc_func = ~a_wall; + ~a->eqn.no_slip_bc_func = ~a_no_slip; + + ~a->eqn.cons_to_riem = cons_to_riem; + ~a->eqn.riem_to_cons = riem_to_cons; + + ~a->eqn.cons_to_diag = ~a_cons_to_diag; + + ~a->eqn.source_func = ~a_source; + + ~a->eqn.flags = 0; + GKYL_CLEAR_CU_ALLOC(~a->eqn.flags); + ~a->eqn.ref_count = gkyl_ref_count_init(gkyl_~a_free); + ~a->eqn.on_dev = &~a->eqn; // On the CPU, the equation object points to itself. + + return &~a->eqn; +} +" + name + name + name + parameter-sig + max-speed-local + name + parameter-sig + flux-ui + name + parameter-sig + flux-deriv-ui + name + name + name + name + name + parameter-def + name + parameter-name + name + parameter-name + name + name + name + parameter-def + name + parameter-name + name + parameter-name + name + parameter-name + name + parameter-name + name + name + name + parameter-def + name + parameter-name + name + name + name + name + name + name + name + name + name + name + name + name + parameter-sig + name + name + parameter-field + (string-upcase name) + name + name + name + name + name + name + (string-upcase name) + name + name + parameter-field-set + (string-upcase name) + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + )) + code) + +;; --------------------------------------------------------------------------- +;; C Regression Test for Gkeyll Roe (Finite-Volume) Solver for a 1D Scalar PDE +;; --------------------------------------------------------------------------- +(define (gkyl-generate-roe-scalar-1d-regression pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate a Gkeyll C regression test for the 1D scalar PDE specified by `pde` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define parameters (hash-ref pde 'parameters)) + + (define init-func-code (convert-expr init-func)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-assign (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 2))"; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-ctx-set (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + (define parameter-ctx (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = ctx." + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + + (define code + (format " +#include +#include +#include +#include + +#include +#include +#include +#include + +#include + +#ifdef GKYL_HAVE_MPI +#include +#include +#endif + +#include + +struct ~a_roe_ctx +{ + // Simulation parameters. + int Nx; // Cell count (x-direction). + double Lx; // Domain size (x-direction). + ~a + double cfl_frac; // CFL coefficient. + + double t_end; // Final simulation time. + int num_frames; // Number of output frames. + int field_energy_calcs; // Number of times to calculate field energy. + int integrated_mom_calcs; // Number of times to calculate integrated moments. + double dt_failure_tol; // Minimum allowable fraction of initial time-step. + int num_failures_max; // Maximum allowable number of consecutive small time-steps. +}; + +struct ~a_roe_ctx +create_ctx(void) +{ + // Simulation parameters. + int Nx = ~a; // Cell count (x-direction). + double Lx = ~a; // Domain size (x-direction). + ~a + double cfl_frac = ~a; // CFL coefficient. + + double t_end = ~a; // Final simulation time. + int num_frames = 1; // Number of output frames. + int field_energy_calcs = INT_MAX; // Number of times to calculate field energy. + int integrated_mom_calcs = INT_MAX; // Number of times to calculate integrated moments. + double dt_failure_tol = 1.0e-4; // Minimum allowable fraction of initial time-step. + int num_failures_max = 20; // Maximum allowable number of consecutive small time-steps. + + struct ~a_roe_ctx ctx = { + .Nx = Nx, + .Lx = Lx, + ~a + .cfl_frac = cfl_frac, + .t_end = t_end, + .num_frames = num_frames, + .field_energy_calcs = field_energy_calcs, + .integrated_mom_calcs = integrated_mom_calcs, + .dt_failure_tol = dt_failure_tol, + .num_failures_max = num_failures_max, + }; + + return ctx; +} + +void +eval~aInit(double t, const double* GKYL_RESTRICT xn, double* GKYL_RESTRICT fout, void* ctx) +{ + double x = xn[0]; + + // Set conserved quantity. + fout[0] = ~a; +} + +void +write_data(struct gkyl_tm_trigger* iot, gkyl_moment_app* app, double t_curr, bool force_write) +{ + if (gkyl_tm_trigger_check_and_bump(iot, t_curr) || force_write) { + int frame = iot->curr - 1; + if (force_write) { + frame = iot->curr; + } + + gkyl_moment_app_write(app, t_curr, frame); + gkyl_moment_app_write_field_energy(app); + gkyl_moment_app_write_integrated_mom(app); + } +} + +void +calc_field_energy(struct gkyl_tm_trigger* fet, gkyl_moment_app* app, double t_curr, bool force_calc) +{ + if (gkyl_tm_trigger_check_and_bump(fet, t_curr) || force_calc) { + gkyl_moment_app_calc_field_energy(app, t_curr); + } +} + +void +calc_integrated_mom(struct gkyl_tm_trigger* imt, gkyl_moment_app* app, double t_curr, bool force_calc) +{ + if (gkyl_tm_trigger_check_and_bump(imt, t_curr) || force_calc) { + gkyl_moment_app_calc_integrated_mom(app, t_curr); + } +} + +int +main(int argc, char **argv) +{ + struct gkyl_app_args app_args = parse_app_args(argc, argv); + +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Init(&argc, &argv); + } +#endif + + if (app_args.trace_mem) { + gkyl_cu_dev_mem_debug_set(true); + gkyl_mem_debug_set(true); + } + + struct ~a_roe_ctx ctx = create_ctx(); // Context for initialization functions. + + int NX = APP_ARGS_CHOOSE(app_args.xcells[0], ctx.Nx); + + // ~a equation. + struct gkyl_wv_eqn *~a = gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { + ~a + .rp_type = WV_~a_RP_ROE, + .use_gpu = app_args.use_gpu, + } + ); + + struct gkyl_moment_species fluid = { + .name = \"~a\", + .equation = ~a, + .evolve = true, + .init = eval~aInit, + .ctx = &ctx, + }; + + int nrank = 1; // Number of processes in simulation. +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Comm_size(MPI_COMM_WORLD, &nrank); + } +#endif + + // Create global range. + int cells[] = { NX }; + int dim = sizeof(cells) / sizeof(cells[0]); + + int cuts[dim]; +#ifdef GKYL_HAVE_MPI + for (int d = 0; d < dim; d++) { + if (app_args.use_mpi) { + cuts[d] = app_args.cuts[d]; + } + else { + cuts[d] = 1; + } + } +#else + for (int d = 0; d < dim; d++) { + cuts[d] = 1; + } +#endif + + // Construct communicator for use in app. + struct gkyl_comm *comm; +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + comm = gkyl_mpi_comm_new( &(struct gkyl_mpi_comm_inp) { + .mpi_comm = MPI_COMM_WORLD, + } + ); + } + else { + comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { + .use_gpu = app_args.use_gpu + } + ); + } +#else + comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { + .use_gpu = app_args.use_gpu + } + ); +#endif + + int my_rank; + gkyl_comm_get_rank(comm, &my_rank); + int comm_size; + gkyl_comm_get_size(comm, &comm_size); + + int ncuts = 1; + for (int d = 0; d < dim; d++) { + ncuts *= cuts[d]; + } + + if (ncuts != comm_size) { + if (my_rank == 0) { + fprintf(stderr, \"*** Number of ranks, %d, does not match total cuts, %d!\\n\", comm_size, ncuts); + } + goto mpifinalize; + } + + // Moment app. + struct gkyl_moment app_inp = { + .name = \"~a_roe\", + + .ndim = 1, + .lower = { ~a }, + .upper = { ~a + ctx.Lx }, + .cells = { NX }, + + .num_periodic_dir = 0, + .periodic_dirs = { }, + .cfl_frac = ctx.cfl_frac, + + .num_species = 1, + .species = { fluid }, + + .parallelism = { + .use_gpu = app_args.use_gpu, + .cuts = { app_args.cuts[0] }, + .comm = comm, + }, + }; + + // Create app object. + gkyl_moment_app *app = gkyl_moment_app_new(&app_inp); + + // Initial and final simulation times. + double t_curr = 0.0, t_end = ctx.t_end; + + // Initialize simulation. + int frame_curr = 0; + if (app_args.is_restart) { + struct gkyl_app_restart_status status = gkyl_moment_app_read_from_frame(app, app_args.restart_frame); + + if (status.io_status != GKYL_ARRAY_RIO_SUCCESS) { + gkyl_moment_app_cout(app, stderr, \"*** Failed to read restart file! (%s)\\n\", gkyl_array_rio_status_msg(status.io_status)); + goto freeresources; + } + + frame_curr = status.frame; + t_curr = status.stime; + + gkyl_moment_app_cout(app, stdout, \"Restarting from frame %d\", frame_curr); + gkyl_moment_app_cout(app, stdout, \" at time = %g\\n\", t_curr); + } + else { + gkyl_moment_app_apply_ic(app, t_curr); + } + + // Create trigger for field energy. + int field_energy_calcs = ctx.field_energy_calcs; + struct gkyl_tm_trigger fe_trig = { .dt = t_end / field_energy_calcs, .tcurr = t_curr, .curr = frame_curr }; + + calc_field_energy(&fe_trig, app, t_curr, false); + + // Create trigger for integrated moments. + int integrated_mom_calcs = ctx.integrated_mom_calcs; + struct gkyl_tm_trigger im_trig = { .dt = t_end / integrated_mom_calcs, .tcurr = t_curr, .curr = frame_curr }; + + calc_integrated_mom(&im_trig, app, t_curr, false); + + // Create trigger for IO. + int num_frames = ctx.num_frames; + struct gkyl_tm_trigger io_trig = { .dt = t_end / num_frames, .tcurr = t_curr, .curr = frame_curr }; + + write_data(&io_trig, app, t_curr, false); + + // Compute initial guess of maximum stable time-step. + double dt = t_end - t_curr; + + // Initialize small time-step check. + double dt_init = -1.0, dt_failure_tol = ctx.dt_failure_tol; + int num_failures = 0, num_failures_max = ctx.num_failures_max; + + long step = 1; + while ((t_curr < t_end) && (step <= app_args.num_steps)) { + gkyl_moment_app_cout(app, stdout, \"Taking time-step %ld at t = %g ...\", step, t_curr); + struct gkyl_update_status status = gkyl_moment_update(app, dt); + gkyl_moment_app_cout(app, stdout, \" dt = %g\\n\", status.dt_actual); + + if (!status.success) { + gkyl_moment_app_cout(app, stdout, \"** Update method failed! Aborting simulation ....\\n\"); + break; + } + + t_curr += status.dt_actual; + dt = status.dt_suggested; + + calc_field_energy(&fe_trig, app, t_curr, false); + calc_integrated_mom(&im_trig, app, t_curr, false); + write_data(&io_trig, app, t_curr, false); + + if (dt_init < 0.0) { + dt_init = status.dt_actual; + } + else if (status.dt_actual < dt_failure_tol * dt_init) { + num_failures += 1; + + gkyl_moment_app_cout(app, stdout, \"WARNING: Time-step dt = %g\", status.dt_actual); + gkyl_moment_app_cout(app, stdout, \" is below %g*dt_init ...\", dt_failure_tol); + gkyl_moment_app_cout(app, stdout, \" num_failures = %d\\n\", num_failures); + if (num_failures >= num_failures_max) { + gkyl_moment_app_cout(app, stdout, \"ERROR: Time-step was below %g*dt_init \", dt_failure_tol); + gkyl_moment_app_cout(app, stdout, \"%d consecutive times. Aborting simulation ....\\n\", num_failures_max); + + calc_field_energy(&fe_trig, app, t_curr, true); + calc_integrated_mom(&im_trig, app, t_curr, true); + write_data(&io_trig, app, t_curr, true); + + break; + } + } + else { + num_failures = 0; + } + + step += 1; + } + + calc_field_energy(&fe_trig, app, t_curr, false); + calc_integrated_mom(&im_trig, app, t_curr, false); + write_data(&io_trig, app, t_curr, false); + gkyl_moment_app_stat_write(app); + + struct gkyl_moment_stat stat = gkyl_moment_app_stat(app); + + gkyl_moment_app_cout(app, stdout, \"\\n\"); + gkyl_moment_app_cout(app, stdout, \"Number of update calls %ld\\n\", stat.nup); + gkyl_moment_app_cout(app, stdout, \"Number of failed time-steps %ld\\n\", stat.nfail); + gkyl_moment_app_cout(app, stdout, \"Species updates took %g secs\\n\", stat.species_tm); + gkyl_moment_app_cout(app, stdout, \"Field updates took %g secs\\n\", stat.field_tm); + gkyl_moment_app_cout(app, stdout, \"Source updates took %g secs\\n\", stat.sources_tm); + gkyl_moment_app_cout(app, stdout, \"Total updates took %g secs\\n\", stat.total_tm); + +freeresources: + // Free resources after simulation completion. + gkyl_wv_eqn_release(~a); + gkyl_comm_release(comm); + gkyl_moment_app_release(app); + +mpifinalize: +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Finalize(); + } +#endif + + return 0; +} + +" + name + name + parameter-def + name + nx + (- x1 x0) + parameter-assign + cfl + t-final + name + parameter-ctx-set + (string-titlecase name) + init-func-code + name + name + name + name + name + parameter-ctx + (string-upcase name) + name + name + (string-titlecase name) + name + x0 + x0 + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_code_generator_roe_vector.rkt b/provable-algorithms/finite_volume/gkyl_code_generator_roe_vector.rkt new file mode 100644 index 00000000..df448586 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_code_generator_roe_vector.rkt @@ -0,0 +1,1335 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide gkyl-generate-roe-vector2-1d-header + gkyl-generate-roe-vector2-1d-priv-header + gkyl-generate-roe-vector2-1d-source + gkyl-generate-roe-vector2-1d-regression) + +;; ------------------------------------------------------------------------------------- +;; Header for Gkeyll Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------------------------- +(define (gkyl-generate-roe-vector2-1d-header pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate Gkeyll C header code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define parameters (hash-ref pde-system 'parameters)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-comment (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) + parameters) "\n")] + [else "*"])) + + (define code + (format " +#pragma once + +#include + +// Type of Riemann-solver to use: +enum gkyl_wv_~a_rp { + WV_~a_RP_ROE = 0, // Default (Roe fluxes). +}; + +// Input context, packaged as a struct. +struct gkyl_wv_~a_inp { + ~a + + enum gkyl_wv_~a_rp rp_type; // Type of Riemann-solver to use. + bool use_gpu; // Whether the wave equation object is on the host (false) or the device (true). +}; + +/** +* Create a new ~a equations object. +* +~a +* @param use_gpu Whether the wave equation object is on the host (false) or the device (true). +* @return Pointer to the ~a equations object. +*/ +struct gkyl_wv_eqn* +gkyl_wv_~a_new(~a bool use_gpu); + +/** +* Create a new ~a equations object, from an input context struct. +* +* @param inp Input context struct. +* @return Pointer to the ~a equations object. +*/ +struct gkyl_wv_eqn* +gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp); +" + name + (string-upcase name) + name + parameter-def + name + name + parameter-comment + name + name + parameter-sig + name + name + name + name + )) + code) + +;; --------------------------------------------------------------------------------------------- +;; Private Header for Gkeyll Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; --------------------------------------------------------------------------------------------- +(define (gkyl-generate-roe-vector2-1d-priv-header pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate Gkeyll C private header code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define parameters (hash-ref pde-system 'parameters)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-comment (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) + parameters) "\n")] + [else "*"])) + + (define code + (format " +#pragma once + +// Private header, not for direct use in user-facing code. + +#include +#include +#include +#include +#include +#include + +struct wv_~a { + struct gkyl_wv_eqn eqn; // Base equation object. + ~a +}; + +/** +* Compute maximum absolute wave speed. +* +~a +* @param q Conserved variable vector. +* @return Maximum absolute wave speed for a given q. +*/ +GKYL_CU_D +static inline double +gkyl_~a_max_abs_speed(~a const double* q); + +/** +* Compute flux vector. Assumes rotation to local coordinate system. +* +~a +* @param q Conserved variable vector. +* @param flux Flux vector in direction 'dir' (output). +*/ +GKYL_CU_D +void +gkyl_~a_flux(~a const double* q, double* flux); + +/** +* Compute eigenvalues of the flux Jacobian. Assumes rotation to local coordinate system. +* +~a +* @param q Conserved variable vector. +* @param flux_deriv Flux Jacobian eigenvalues in direction 'dir' (output). +*/ +GKYL_CU_D +void +gkyl_~a_flux_deriv(~a const double* q, double* flux_deriv); + +/** +* Compute Riemann variables given the conserved variables. +* +* @param eqn Base equation object. +* @param qstate Current state vector. +* @param qin Conserved variable vector (input). +* @param wout Riemann variable vector (output). +*/ +GKYL_CU_D +static inline void +cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout); + +/** +* Compute conserved variables given the Riemann variables. +* +* @param eqn Base equation object. +* @param qstate Current state vector. +* @param win Riemann variable vector (input). +* @param qout Conserved variable vector (output). +*/ +GKYL_CU_D +static inline void +riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double *qout); + +/** +* Boundary condition function for applying wall boundary conditions for the ~a equations. +* +* @param eqn Base equation object. +* @param t Current simulation time. +* @param nc Number of boundary cells to which to apply wall boundary conditions. +* @param skin Skin cells in boundary region (from which values are copied). +* @param ghost Ghost cells in boundary region (to which values are copied). +* @param ctx Context to pass to the function. +*/ +GKYL_CU_D +static void +~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); + +/** +* Boundary condition function for applying no-slip boundary conditions for the ~a equations. +* +* @param eqn Base equation object. +* @param t Current simulation time. +* @param nc Number of boundary cells to which to apply no-slip boundary conditions. +* @param skin Skin cells in boundary region (from which values are copied). +* @param ghost Ghost cells in boundary region (to which values are copied). +* @param ctx Context to pass to the function. +*/ +GKYL_CU_D +static void +~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); + +/** +* Rotate state vector from global to local coordinate frame. +* +* @param eqn Base equation object. +* @param tau1 First tangent vector of the coordinate frame. +* @param tau2 Second tangent vector of the coordinate frame. +* @param norm Normal vector of the coordinate frame. +* @param qglobal State vector in global coordinate frame (input). +* @param qlocal State vector in local coordinate frame (output). +*/ +GKYL_CU_D +static inline void +rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, + double* GKYL_RESTRICT qlocal); + +/** +* Rotate state vector from local to global coordinate frame. +* +* @param eqn Base equation object. +* @param tau1 First tangent vector of the coordinate frame. +* @param tau2 Second tangent vector of the coordinate frame. +* @param norm Normal vector of the coordinate frame. +* @param qlocal State vector in local coordinate frame (input). +* @param qglobal State vector in global coordinate frame (output). +*/ +GKYL_CU_D +static inline void +rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, + double* GKYL_RESTRICT qglobal); + +/** +* Compute waves and speeds using Roe fluxes. +* +* @param eqn Base equation object. +* @param delta Jump across interface to split. +* @param ql Conserved variables on the left of the interface. +* @param qr Conserved variables on the right of the interface. +* @param waves Waves (output). +* @param s Wave speeds (output). +* @return Maximum wave speed. +*/ +GKYL_CU_D +static double +wave_roe(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s); + +/** +* Compute fluctuations using Roe fluxes. +* +* @param eqn Base equation object. +* @param ql Conserved variable vector on the left of the interface. +* @param qr Conserved variable vector on the right of the interface. +* @param waves Waves (input). +* @param s Wave speeds (input). +* @param amdq Left-moving fluctuations (output). +* @param apdq Right-moving fluctuations (output). +*/ +GKYL_CU_D +static void +qfluct_roe(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq); + +/** +* Compute waves and speeds using Roe fluxes (with potential fallback). +* +* @param eqn Base equation object. +* @param type Type of Riemann-solver flux to use. +* @param delta Jump across interface to split. +* @param ql Conserved variables on the left of the interface. +* @param qr Conserved variables on the right of the interface. +* @param waves Waves (output). +* @param s Wave speeds (output). +* @return Maximum wave speed. +*/ +GKYL_CU_D +static double +wave_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s); + +/** +* Compute fluctuations using Roe fluxes (with potential fallback), +* +* @param eqn Base equation object. +* @param type Type of Riemann-solver flux to use. +* @param ql Conserved variable vector on the left of the interface. +* @param qr Conserved variable vector on the right of the interface. +* @param waves Waves (input). +* @param s Wave speeds (input). +* @param amdq Left-moving fluctuations (output). +* @param apdq Right-moving fluctuations (output). +*/ +GKYL_CU_D +static void +qfluct_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, + double* amdq, double* apdq); + +/** +* Compute jump in flux given two conserved variable states. +* +* @param eqn Base equation object. +* @param ql Conserved variable vector on the left of the interface (input). +* @param qr Conserved variable vector on the right of the interface (input). +* @param flux_jump Jump in flux vector (output). +* @return Maximum wave speeds for states ql and qr. +*/ +GKYL_CU_D +static double +flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump); + +/** +* Determine whether invariant domain of the ~a equations is satisfied. +* +* @param eqn Base equation object. +* @param q Conserved variable vector. +* @return Whether the invariant domain is satisfied. +*/ +GKYL_CU_D +static bool +check_inv(const struct gkyl_wv_eqn* eqn, const double* q); + +/** +* Compute maximum wave speed from a conserved variable vector. +* +* @param eqn Base equation object. +* @param q Conserved variable vector. +* @return Maximum absolute wave speed. +*/ +GKYL_CU_D +static double +max_speed(const struct gkyl_wv_eqn* eqn, const double* q); + +/** +* Convert conserved variables to diagnostic variables. +* +* @param eqn Base equation object. +* @param qin Conserved variable vector (input). +* @param diag Diagnostic variable vector (output). +*/ +GKYL_CU_D +static inline void +~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag); + +/** +* Compute forcing/source term vector from conserved variable vector. +* +* @param eqn Base equation object. +* @param qin Conserved variable vector (input). +* @param sout Forcing/source term vector (output). +*/ +GKYL_CU_DH +static inline void +~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout); + +/** +* Free ~a equations object. +* +* @param ref Reference counter for ~a equations. +*/ +void +gkyl_~a_free(const struct gkyl_ref_count* ref); +" + name + parameter-def + parameter-comment + name + parameter-sig + parameter-comment + name + parameter-sig + parameter-comment + name + parameter-sig + name + name + name + name + name + name + name + name + name + name + )) + code) + +;; ------------------------------------------------------------------------------------- +;; Source for Gkeyll Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------------------------- +(define (gkyl-generate-roe-vector2-1d-source pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate Gkeyll C source code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define flux-deriv-codes (map (lambda (flux-deriv-expr) + (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "q[0]") + (list-ref cons-codes 1) "q[1]")) max-speed-codes)) + (define flux-uis (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "q[0]") + (list-ref cons-codes 1) "q[1]")) flux-codes)) + (define flux-deriv-uis (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "q[0]") + (list-ref cons-codes 1) "q[1]")) flux-deriv-codes)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) " = " + name "->" (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-sig (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-name (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append (convert-expr (list-ref parameter 1)) ",")) + parameters))] + [else ""])) + (define parameter-field (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + (define parameter-field-set (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append name "->" (convert-expr (list-ref parameter 1)) + " = inp->" (convert-expr (list-ref parameter 1)) ";")) + parameters) "\n")] + [else ""])) + + (define code + (format " +#include +#include + +#include +#include +#include +#include + +static inline double +gkyl_~a_max_abs_speed(~a const double* q) +{ + return fmax(~a, ~a); +} + +void +gkyl_~a_flux(~a const double* q, double* flux) +{ + flux[0] = ~a; + flux[1] = ~a; +} + +void +gkyl_~a_flux_deriv(~a const double* q, double* flux_deriv) +{ + flux_deriv[0] = ~a; + flux_deriv[1] = ~a; +} + +static inline void +cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout) +{ + // TODO: This should use a proper L matrix. + for (int i = 0; i < 2; i++) { + wout[i] = qin[i]; + } +} + +static inline void +riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double* qout) +{ + // TODO: This should use a proper L matrix. + for (int i = 0; i < 2; i++) { + qout[i] = win[i]; + } +} + +static void +~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) +{ + for (int i = 0; i < 2; i++) { + ghost[i] = skin[i]; + } +} + +static void +~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) +{ + for (int i = 0; i < 2; i++) { + ghost[i] = skin[i]; + } +} + +static inline void +rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, + double* GKYL_RESTRICT qlocal) +{ + for (int i = 0; i < 2; i++) { + qlocal[i] = qglobal[i]; + } +} + +static inline void +rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, + double* GKYL_RESTRICT qglobal) +{ + for (int i = 0; i < 2; i++) { + qglobal[i] = qlocal[i]; + } +} + +static double +wave_roe(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + double *fl = gkyl_malloc(sizeof(double) * 2); + double *fr = gkyl_malloc(sizeof(double) * 2); + gkyl_~a_flux(~a ql, fl); + gkyl_~a_flux(~a qr, fr); + + double *fl_deriv = gkyl_malloc(sizeof(double) * 2); + double *fr_deriv = gkyl_malloc(sizeof(double) * 2); + gkyl_~a_flux_deriv(~a ql, fl_deriv); + gkyl_~a_flux_deriv(~a qr, fr_deriv); + + double *a_roe = gkyl_malloc(sizeof(double) * 2); + for (int i = 0; i < 2; i++) { + a_roe[i] = 0.5 * (fl_deriv[i] + fr_deriv[i]); + } + + double *w0 = &waves[0], *w1 = &waves[2]; + for (int i = 0; i < 2; i++) { + w0[i] = 0.5 * ((qr[i] - ql[i]) - (fr[i] - fl[i]) / fmax(a_roe[0], a_roe[1])); + w1[i] = 0.5 * ((qr[i] - ql[i]) + (fr[i] - fl[i]) / fmax(a_roe[0], a_roe[1])); + } + + for (int i = 0; i < 2; i++) { + s[i] = a_roe[i]; + } + + gkyl_free(fl); + gkyl_free(fr); + + gkyl_free(fl_deriv); + gkyl_free(fr_deriv); + + return fmax(s[0], s[1]); +} + +static void +qfluct_roe(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq) +{ + const double *w0 = &waves[0], *w1 = &waves[2]; + double s0m = fmin(0.0, s[0]), s1m = fmin(0.0, s[1]); + double s0p = fmax(0.0, s[0]), s1p = fmax(0.0, s[1]); + + for (int i = 0; i < 2; i++) { + amdq[i] = (s0m * w0[i]) + (s1m * w1[i]); + apdq[i] = (s0p * w0[i]) + (s1p * w1[i]); + } +} + +static double +wave_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s) +{ + return wave_roe(eqn, delta, ql, qr, waves, s); +} + +static void +qfluct_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, + double* amdq, double* apdq) +{ + return qfluct_roe(eqn, ql, qr, waves, s, amdq, apdq); +} + +static double +flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + double *fr = gkyl_malloc(sizeof(double)); + double *fl = gkyl_malloc(sizeof(double)); + gkyl_~a_flux(~a ql, fl); + gkyl_~a_flux(~a qr, fr); + + for (int i = 0; i < 2; i++) { + flux_jump[i] = fr[i] - fl[i]; + } + + double amaxl = gkyl_~a_max_abs_speed(~a ql); + double amaxr = gkyl_~a_max_abs_speed(~a qr); + + gkyl_free(fr); + gkyl_free(fl); + + return fmax(amaxl, amaxr); +} + +static bool +check_inv(const struct gkyl_wv_eqn* eqn, const double* q) +{ + return true; // All states are assumed to be valid. +} + +static double +max_speed(const struct gkyl_wv_eqn* eqn, const double* q) +{ + const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); + ~a + + return gkyl_~a_max_abs_speed(~a q); +} + +static inline void +~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag) +{ + for (int i = 0; i < 2; i++) { + diag[i] = qin[i]; + } +} + +static inline void +~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout) +{ + for (int i = 0; i < 2; i++) { + sout[i] = 0.0; + } +} + +void +gkyl_~a_free(const struct gkyl_ref_count* ref) +{ + struct gkyl_wv_eqn* base = container_of(ref, struct gkyl_wv_eqn, ref_count); + + if (gkyl_wv_eqn_is_cu_dev(base)) { + // Free inner on_dev object. + struct wv_~a *~a = container_of(base->on_dev, struct wv_~a, eqn); + gkyl_cu_free(~a); + } + + struct wv_~a *~a = container_of(base, struct wv_~a, eqn); + gkyl_free(~a); +} + +struct gkyl_wv_eqn* +gkyl_wv_~a_new(~a bool use_gpu) +{ + return gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { + ~a + .rp_type = WV_~a_RP_ROE, + .use_gpu = use_gpu, + } + ); +} + +struct gkyl_wv_eqn* +gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp) +{ + struct wv_~a *~a = gkyl_malloc(sizeof(struct wv_~a)); + + ~a->eqn.type = GKYL_EQN_~a; + ~a->eqn.num_equations = 2; + ~a->eqn.num_diag = 2; + + ~a + + if (inp->rp_type == WV_~a_RP_ROE) { + ~a->eqn.num_waves = 2; + ~a->eqn.waves_func = wave_roe_l; + ~a->eqn.qfluct_func = qfluct_roe_l; + } + + ~a->eqn.flux_jump = flux_jump; + ~a->eqn.check_inv_func = check_inv; + ~a->eqn.max_speed_func = max_speed; + ~a->eqn.rotate_to_local_func = rot_to_local; + ~a->eqn.rotate_to_global_func = rot_to_global; + + ~a->eqn.wall_bc_func = ~a_wall; + ~a->eqn.no_slip_bc_func = ~a_no_slip; + + ~a->eqn.cons_to_riem = cons_to_riem; + ~a->eqn.riem_to_cons = riem_to_cons; + + ~a->eqn.cons_to_diag = ~a_cons_to_diag; + + ~a->eqn.source_func = ~a_source; + + ~a->eqn.flags = 0; + GKYL_CLEAR_CU_ALLOC(~a->eqn.flags); + ~a->eqn.ref_count = gkyl_ref_count_init(gkyl_~a_free); + ~a->eqn.on_dev = &~a->eqn; // On the CPU, the equation object points to itself. + + return &~a->eqn; +} +" + name + name + name + parameter-sig + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + name + parameter-sig + (list-ref flux-uis 0) + (list-ref flux-uis 1) + name + parameter-sig + (list-ref flux-deriv-uis 0) + (list-ref flux-deriv-uis 1) + name + name + name + name + name + parameter-def + name + parameter-name + name + parameter-name + name + parameter-name + name + parameter-name + name + name + name + parameter-def + name + parameter-name + name + parameter-name + name + parameter-name + name + parameter-name + name + name + name + parameter-def + name + parameter-name + name + name + name + name + name + name + name + name + name + name + name + name + parameter-sig + name + name + parameter-field + (string-upcase name) + name + name + name + name + name + name + (string-upcase name) + name + name + parameter-field-set + (string-upcase name) + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------ +;; C Regression Test for Gkeyll Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------------------------------------ +(define (gkyl-generate-roe-vector2-1d-regression pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate a Gkeyll C regression test for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define parameters (hash-ref pde-system 'parameters)) + + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define parameter-def (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-assign (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 2))"; // Additional simulation parameter.")) + parameters) "\n")] + [else ""])) + (define parameter-ctx-set (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = " + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + (define parameter-ctx (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "." (convert-expr (list-ref parameter 1)) " = ctx." + (convert-expr (list-ref parameter 1)) ",")) + parameters) "\n")] + [else ""])) + + (define code + (format " +#include +#include +#include +#include + +#include +#include +#include +#include + +#include + +#ifdef GKYL_HAVE_MPI +#include +#include +#endif + +#include + +struct ~a_roe_ctx +{ + // Simulation parameters. + int Nx; // Cell count (x-direction). + double Lx; // Domain size (x-direction). + ~a + double cfl_frac; // CFL coefficient. + + double t_end; // Final simulation time. + int num_frames; // Number of output frames. + int field_energy_calcs; // Number of times to calculate field energy. + int integrated_mom_calcs; // Number of times to calculate integrated moments. + double dt_failure_tol; // Minimum allowable fraction of initial time-step. + int num_failures_max; // Maximum allowable number of consecutive small time-steps. +}; + +struct ~a_roe_ctx +create_ctx(void) +{ + // Simulation parameters. + int Nx = ~a; // Cell count (x-direction). + double Lx = ~a; // Domain size (x-direction). + ~a + double cfl_frac = ~a; // CFL coefficient. + + double t_end = ~a; // Final simulation time. + int num_frames = 1; // Number of output frames. + int field_energy_calcs = INT_MAX; // Number of times to calculate field energy. + int integrated_mom_calcs = INT_MAX; // Number of times to calculate integrated moments. + double dt_failure_tol = 1.0e-4; // Minimum allowable fraction of initial time-step. + int num_failures_max = 20; // Maximum allowable number of consecutive small time-steps. + + struct ~a_roe_ctx ctx = { + .Nx = Nx, + .Lx = Lx, + ~a + .cfl_frac = cfl_frac, + .t_end = t_end, + .num_frames = num_frames, + .field_energy_calcs = field_energy_calcs, + .integrated_mom_calcs = integrated_mom_calcs, + .dt_failure_tol = dt_failure_tol, + .num_failures_max = num_failures_max, + }; + + return ctx; +} + +void +eval~aInit(double t, const double* GKYL_RESTRICT xn, double* GKYL_RESTRICT fout, void* ctx) +{ + double x = xn[0]; + + // Set conserved quantities. + fout[0] = ~a; + fout[1] = ~a; +} + +void +write_data(struct gkyl_tm_trigger* iot, gkyl_moment_app* app, double t_curr, bool force_write) +{ + if (gkyl_tm_trigger_check_and_bump(iot, t_curr) || force_write) { + int frame = iot->curr - 1; + if (force_write) { + frame = iot->curr; + } + + gkyl_moment_app_write(app, t_curr, frame); + gkyl_moment_app_write_field_energy(app); + gkyl_moment_app_write_integrated_mom(app); + } +} + +void +calc_field_energy(struct gkyl_tm_trigger* fet, gkyl_moment_app* app, double t_curr, bool force_calc) +{ + if (gkyl_tm_trigger_check_and_bump(fet, t_curr) || force_calc) { + gkyl_moment_app_calc_field_energy(app, t_curr); + } +} + +void +calc_integrated_mom(struct gkyl_tm_trigger* imt, gkyl_moment_app* app, double t_curr, bool force_calc) +{ + if (gkyl_tm_trigger_check_and_bump(imt, t_curr) || force_calc) { + gkyl_moment_app_calc_integrated_mom(app, t_curr); + } +} + +int +main(int argc, char **argv) +{ + struct gkyl_app_args app_args = parse_app_args(argc, argv); + +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Init(&argc, &argv); + } +#endif + + if (app_args.trace_mem) { + gkyl_cu_dev_mem_debug_set(true); + gkyl_mem_debug_set(true); + } + + struct ~a_roe_ctx ctx = create_ctx(); // Context for initialization functions. + + int NX = APP_ARGS_CHOOSE(app_args.xcells[0], ctx.Nx); + + // ~a equation. + struct gkyl_wv_eqn *~a = gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { + ~a + .rp_type = WV_~a_RP_ROE, + .use_gpu = app_args.use_gpu, + } + ); + + struct gkyl_moment_species fluid = { + .name = \"~a\", + .equation = ~a, + .evolve = true, + .init = eval~aInit, + .ctx = &ctx, + }; + + int nrank = 1; // Number of processes in simulation. +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Comm_size(MPI_COMM_WORLD, &nrank); + } +#endif + + // Create global range. + int cells[] = { NX }; + int dim = sizeof(cells) / sizeof(cells[0]); + + int cuts[dim]; +#ifdef GKYL_HAVE_MPI + for (int d = 0; d < dim; d++) { + if (app_args.use_mpi) { + cuts[d] = app_args.cuts[d]; + } + else { + cuts[d] = 1; + } + } +#else + for (int d = 0; d < dim; d++) { + cuts[d] = 1; + } +#endif + + // Construct communicator for use in app. + struct gkyl_comm *comm; +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + comm = gkyl_mpi_comm_new( &(struct gkyl_mpi_comm_inp) { + .mpi_comm = MPI_COMM_WORLD, + } + ); + } + else { + comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { + .use_gpu = app_args.use_gpu + } + ); + } +#else + comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { + .use_gpu = app_args.use_gpu + } + ); +#endif + + int my_rank; + gkyl_comm_get_rank(comm, &my_rank); + int comm_size; + gkyl_comm_get_size(comm, &comm_size); + + int ncuts = 1; + for (int d = 0; d < dim; d++) { + ncuts *= cuts[d]; + } + + if (ncuts != comm_size) { + if (my_rank == 0) { + fprintf(stderr, \"*** Number of ranks, %d, does not match total cuts, %d!\\n\", comm_size, ncuts); + } + goto mpifinalize; + } + + // Moment app. + struct gkyl_moment app_inp = { + .name = \"~a_roe\", + + .ndim = 1, + .lower = { ~a }, + .upper = { ~a + ctx.Lx }, + .cells = { NX }, + + .num_periodic_dir = 0, + .periodic_dirs = { }, + .cfl_frac = ctx.cfl_frac, + + .num_species = 1, + .species = { fluid }, + + .parallelism = { + .use_gpu = app_args.use_gpu, + .cuts = { app_args.cuts[0] }, + .comm = comm, + }, + }; + + // Create app object. + gkyl_moment_app *app = gkyl_moment_app_new(&app_inp); + + // Initial and final simulation times. + double t_curr = 0.0, t_end = ctx.t_end; + + // Initialize simulation. + int frame_curr = 0; + if (app_args.is_restart) { + struct gkyl_app_restart_status status = gkyl_moment_app_read_from_frame(app, app_args.restart_frame); + + if (status.io_status != GKYL_ARRAY_RIO_SUCCESS) { + gkyl_moment_app_cout(app, stderr, \"*** Failed to read restart file! (%s)\\n\", gkyl_array_rio_status_msg(status.io_status)); + goto freeresources; + } + + frame_curr = status.frame; + t_curr = status.stime; + + gkyl_moment_app_cout(app, stdout, \"Restarting from frame %d\", frame_curr); + gkyl_moment_app_cout(app, stdout, \" at time = %g\\n\", t_curr); + } + else { + gkyl_moment_app_apply_ic(app, t_curr); + } + + // Create trigger for field energy. + int field_energy_calcs = ctx.field_energy_calcs; + struct gkyl_tm_trigger fe_trig = { .dt = t_end / field_energy_calcs, .tcurr = t_curr, .curr = frame_curr }; + + calc_field_energy(&fe_trig, app, t_curr, false); + + // Create trigger for integrated moments. + int integrated_mom_calcs = ctx.integrated_mom_calcs; + struct gkyl_tm_trigger im_trig = { .dt = t_end / integrated_mom_calcs, .tcurr = t_curr, .curr = frame_curr }; + + calc_integrated_mom(&im_trig, app, t_curr, false); + + // Create trigger for IO. + int num_frames = ctx.num_frames; + struct gkyl_tm_trigger io_trig = { .dt = t_end / num_frames, .tcurr = t_curr, .curr = frame_curr }; + + write_data(&io_trig, app, t_curr, false); + + // Compute initial guess of maximum stable time-step. + double dt = t_end - t_curr; + + // Initialize small time-step check. + double dt_init = -1.0, dt_failure_tol = ctx.dt_failure_tol; + int num_failures = 0, num_failures_max = ctx.num_failures_max; + + long step = 1; + while ((t_curr < t_end) && (step <= app_args.num_steps)) { + gkyl_moment_app_cout(app, stdout, \"Taking time-step %ld at t = %g ...\", step, t_curr); + struct gkyl_update_status status = gkyl_moment_update(app, dt); + gkyl_moment_app_cout(app, stdout, \" dt = %g\\n\", status.dt_actual); + + if (!status.success) { + gkyl_moment_app_cout(app, stdout, \"** Update method failed! Aborting simulation ....\\n\"); + break; + } + + t_curr += status.dt_actual; + dt = status.dt_suggested; + + calc_field_energy(&fe_trig, app, t_curr, false); + calc_integrated_mom(&im_trig, app, t_curr, false); + write_data(&io_trig, app, t_curr, false); + + if (dt_init < 0.0) { + dt_init = status.dt_actual; + } + else if (status.dt_actual < dt_failure_tol * dt_init) { + num_failures += 1; + + gkyl_moment_app_cout(app, stdout, \"WARNING: Time-step dt = %g\", status.dt_actual); + gkyl_moment_app_cout(app, stdout, \" is below %g*dt_init ...\", dt_failure_tol); + gkyl_moment_app_cout(app, stdout, \" num_failures = %d\\n\", num_failures); + if (num_failures >= num_failures_max) { + gkyl_moment_app_cout(app, stdout, \"ERROR: Time-step was below %g*dt_init \", dt_failure_tol); + gkyl_moment_app_cout(app, stdout, \"%d consecutive times. Aborting simulation ....\\n\", num_failures_max); + + calc_field_energy(&fe_trig, app, t_curr, true); + calc_integrated_mom(&im_trig, app, t_curr, true); + write_data(&io_trig, app, t_curr, true); + + break; + } + } + else { + num_failures = 0; + } + + step += 1; + } + + calc_field_energy(&fe_trig, app, t_curr, false); + calc_integrated_mom(&im_trig, app, t_curr, false); + write_data(&io_trig, app, t_curr, false); + gkyl_moment_app_stat_write(app); + + struct gkyl_moment_stat stat = gkyl_moment_app_stat(app); + + gkyl_moment_app_cout(app, stdout, \"\\n\"); + gkyl_moment_app_cout(app, stdout, \"Number of update calls %ld\\n\", stat.nup); + gkyl_moment_app_cout(app, stdout, \"Number of failed time-steps %ld\\n\", stat.nfail); + gkyl_moment_app_cout(app, stdout, \"Species updates took %g secs\\n\", stat.species_tm); + gkyl_moment_app_cout(app, stdout, \"Field updates took %g secs\\n\", stat.field_tm); + gkyl_moment_app_cout(app, stdout, \"Source updates took %g secs\\n\", stat.sources_tm); + gkyl_moment_app_cout(app, stdout, \"Total updates took %g secs\\n\", stat.total_tm); + +freeresources: + // Free resources after simulation completion. + gkyl_wv_eqn_release(~a); + gkyl_comm_release(comm); + gkyl_moment_app_release(app); + +mpifinalize: +#ifdef GKYL_HAVE_MPI + if (app_args.use_mpi) { + MPI_Finalize(); + } +#endif + + return 0; +} + +" + name + name + parameter-def + name + nx + (- x1 x0) + parameter-assign + cfl + t-final + name + parameter-ctx-set + (string-titlecase name) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + name + name + name + name + name + parameter-ctx + (string-upcase name) + name + name + (string-titlecase name) + name + x0 + x0 + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_test_inviscid_burgers.rkt b/provable-algorithms/finite_volume/gkyl_test_inviscid_burgers.rkt new file mode 100644 index 00000000..1e12a917 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_test_inviscid_burgers.rkt @@ -0,0 +1,275 @@ +#lang racket + +(require "gkyl_code_generator_lax.rkt") +(require "gkyl_code_generator_roe.rkt") +(require "prover_core.rkt") +(provide (all-from-out "gkyl_code_generator_lax.rkt")) +(provide (all-from-out "gkyl_code_generator_roe.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D inviscid Burgers' equation: du/dt + u du/dx = 0. +(define pde-inviscid-burgers + (hash + 'name "burgers" + 'cons-expr `u ; conserved variable: u + 'flux-expr `(* 0.5 u u) ; flux function: f(u) = 0.5 * u^2 + 'max-speed-expr `(abs u) ; local wave-speed: alpha = |u| + 'parameters `() + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -3.0) +(define x1 3.0) +(define t-final 0.5) +(define cfl 0.95) +(define init-func `(cond + [(< (abs x) 1.0) 3.0] + [else -1.0])) + +;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-lax-header + (gkyl-generate-lax-friedrichs-scalar-1d-header pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_burgers_lax.h" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-header))) + +;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-lax-priv-header + (gkyl-generate-lax-friedrichs-scalar-1d-priv-header pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_burgers_lax_priv.h" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-priv-header))) + +;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-lax-source + (gkyl-generate-lax-friedrichs-scalar-1d-source pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_burgers_lax.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-source))) + +;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-lax-regression + (gkyl-generate-lax-friedrichs-scalar-1d-regression pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_burgers_lax.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-regression))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-hyperbolicity + (call-with-output-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-inviscid-burgers-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-cfl-stability + (call-with-output-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-cfl-stability pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-inviscid-burgers-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-local-lipschitz + (call-with-output-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-inviscid-burgers-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the Gkeyll header code for a Roe solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-roe-header + (gkyl-generate-roe-scalar-1d-header pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_burgers_roe.h" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-header))) + +;; Synthesize the Gkeyll private header code for a Roe solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-roe-priv-header + (gkyl-generate-roe-scalar-1d-priv-header pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_burgers_roe_priv.h" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-priv-header))) + +;; Synthesize the Gkeyll source code for a Roe solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-roe-source + (gkyl-generate-roe-scalar-1d-source pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_burgers_roe.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-source))) + +;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-roe-regression + (gkyl-generate-roe-scalar-1d-regression pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_burgers_roe.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-regression))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-roe-hyperbolicity + (call-with-output-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-hyperbolicity pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-inviscid-burgers-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-roe-flux-conservation + (call-with-output-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-flux-conservation pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-inviscid-burgers-roe-flux-conservation) +(display "\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_x.rkt b/provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_x.rkt new file mode 100644 index 00000000..41641cdb --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_x.rkt @@ -0,0 +1,339 @@ +#lang racket + +(require "gkyl_code_generator_lax_vector.rkt") +(require "gkyl_code_generator_roe_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) +(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D isothermal Euler equations (density and x-momentum components). +(define pde-system-isothermal-euler-mom-x + (hash + 'name "isothermal_euler_mom_x" + 'cons-exprs (list + `rho + `mom_x) ; conserved variables: density, x-momentum + 'flux-exprs (list + `mom_x + `(+ (/ (* mom_x mom_x) rho) (* rho vt vt))) ; flux vector + 'max-speed-exprs (list + `(abs (- (/ mom_x rho) vt)) + `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds + 'parameters (list + `(define vt 1.0)) ; thermal velocity: vt = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 0.0) +(define x1 1.0) +(define t-final 0.1) +(define cfl 0.95) +(define init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))) + +;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-lax-header + (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_x_lax.h" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-lax-header))) + +;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-lax-priv-header + (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_x_lax_priv.h" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-lax-priv-header))) + +;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-lax-source + (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_isothermal_euler_mom_x_lax.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-lax-source))) + +;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-lax-regression + (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_isothermal_euler_mom_x_lax.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-lax-regression))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-lax-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-x-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-x-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-lax-cfl-stability + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-isothermal-euler-mom-x-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D isothermal Euler equation (density and x-momentum components). +(define proof-isothermal-euler-mom-x-lax-local-lipschitz + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-isothermal-euler-mom-x-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the Gkeyll header code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-roe-header + (gkyl-generate-roe-vector2-1d-header pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_x_roe.h" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-roe-header))) + +;; Synthesize the Gkeyll private header code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-roe-priv-header + (gkyl-generate-roe-vector2-1d-priv-header pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_x_roe_priv.h" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-roe-priv-header))) + +;; Synthesize the Gkeyll source code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-roe-source + (gkyl-generate-roe-vector2-1d-source pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_isothermal_euler_mom_x_roe.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-roe-source))) + +;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-roe-regression + (gkyl-generate-roe-vector2-1d-regression pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_isothermal_euler_mom_x_roe.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-roe-regression))) + + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-roe-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-x-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-x-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-roe-flux-conservation + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-isothermal-euler-mom-x-roe-flux-conservation) +(display "\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_yz.rkt b/provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_yz.rkt new file mode 100644 index 00000000..23d8eaf1 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_test_isothermal_euler_mom_yz.rkt @@ -0,0 +1,333 @@ +#lang racket + +(require "gkyl_code_generator_lax_vector.rkt") +(require "gkyl_code_generator_roe_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) +(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D isothermal Euler equations (y- and z-momentum components). +(define pde-system-isothermal-euler-mom-yz + (hash + 'name "isothermal_euler_mom_yz" + 'cons-exprs (list + `mom_y + `mom_z) ; conserved variables: y-momentum, z-momentum + 'flux-exprs (list + `(* mom_y u) + `(* mom_z u)) ; flux vector + 'max-speed-exprs (list + `(abs u) + `(abs u)) ; local wave-speeds + 'parameters (list + `(define u 0.0)) ; advection velocity: 0.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 0.0) +(define x1 1.0) +(define t-final 0.1) +(define cfl 0.95) +(define init-funcs (list 0.0 0.0)) + +;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-lax-header + (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_yz_lax.h" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-lax-header))) + +;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-lax-priv-header + (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_yz_lax_priv.h" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-lax-priv-header))) + +;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-lax-source + (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_isothermal_euler_mom_yz_lax.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-lax-source))) + +;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-lax-regression + (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_isothermal_euler_mom_yz_lax.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-lax-regression))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-lax-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-yz-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-yz-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-lax-cfl-stability + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-isothermal-euler-mom-yz-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D isothermal Euler equation (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-lax-local-lipschitz + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-isothermal-euler-mom-yz-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the Gkeyll header code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-roe-header + (gkyl-generate-roe-vector2-1d-header pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_yz_roe.h" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-roe-header))) + +;; Synthesize the Gkeyll private header code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-roe-priv-header + (gkyl-generate-roe-vector2-1d-priv-header pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_yz_roe_priv.h" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-roe-priv-header))) + +;; Synthesize the Gkeyll source code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-roe-source + (gkyl-generate-roe-vector2-1d-source pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_isothermal_euler_mom_yz_roe.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-roe-source))) + +;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-roe-regression + (gkyl-generate-roe-vector2-1d-regression pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_isothermal_euler_mom_yz_roe.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-roe-regression))) + + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-roe-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-yz-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-yz-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-roe-flux-conservation + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-isothermal-euler-mom-yz-roe-flux-conservation) +(display "\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_test_limiters.rkt b/provable-algorithms/finite_volume/gkyl_test_limiters.rkt new file mode 100644 index 00000000..16ea8902 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_test_limiters.rkt @@ -0,0 +1,219 @@ +#lang racket + +(require "gkyl_code_generator_lax.rkt") +(require "prover_core.rkt") +(provide (all-from-out "gkyl_code_generator_lax.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "min_mod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize Gkeyll code (to be plugged into wave_prop.c) for the minmod flux limiter. +(define code-limiter-minmod + (gkyl-generate-flux-limiter limiter-minmod)) + +;; Output the flux limiter code to a file. +(with-output-to-file "gkyl_code/minmod_flux_limiter.c" + #:exists 'replace + (lambda () + (display code-limiter-minmod))) + +(display "Minmod flux limiter properties: \n\n") + +;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the minmod flux limiter. +(define proof-limiter-minmod-symmetry + (call-with-output-file "proofs/proof_limiter_minmod_symmetry.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-symmetry limiter-minmod))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_minmod_symmetry.rkt") + +;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. +(display "Symmetric (equivalent action on forward and backward gradients): ") +(display proof-limiter-minmod-symmetry) +(display "\n") + +;; Attempt to prove second-order TVD (total variation diminishing) of the minmod flux limiter. +(define proof-limiter-minmod-tvd + (call-with-output-file "proofs/proof_limiter_minmod_tvd.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-tvd limiter-minmod))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_minmod_tvd.rkt") + +;; Show whether the second-order TVD (total variation diminishing) property is satisfied. +(display "Second-order TVD (total variation diminishing): ") +(display proof-limiter-minmod-tvd) +(display "\n\n\n") + +;; Define the superbee flux limiter. +(define limiter-superbee + (hash + 'name "superbee" + 'limiter-expr `(max 0.0 (min (* 2.0 r) 1.0) (min r 2.0)) + 'limiter-ratio `r + )) + +;; Synthesize Gkeyll code (to be plugged into wave_prop.c) for the superbee flux limiter. +(define code-limiter-superbee + (gkyl-generate-flux-limiter limiter-superbee)) + +;; Output the flux limiter code to a file. +(with-output-to-file "gkyl_code/superbee_flux_limiter.c" + #:exists 'replace + (lambda () + (display code-limiter-superbee))) + +(display "Superbee flux limiter properties: \n\n") + +;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the superbee flux limiter. +(define proof-limiter-superbee-symmetry + (call-with-output-file "proofs/proof_limiter_superbee_symmetry.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-symmetry limiter-superbee))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_superbee_symmetry.rkt") + +;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. +(display "Symmetric (equivalent action on forward and backward gradients): ") +(display proof-limiter-superbee-symmetry) +(display "\n") + +;; Attempt to prove second-order TVD (total variation diminishing) of the superbee flux limiter. +(define proof-limiter-superbee-tvd + (call-with-output-file "proofs/proof_limiter_superbee_tvd.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-tvd limiter-superbee))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_superbee_tvd.rkt") + +;; Show whether the second-order TVD (total variation diminishing) property is satisfied. +(display "Second-order TVD (total variation diminishing): ") +(display proof-limiter-superbee-tvd) +(display "\n\n\n") + +;; Define the monotonized-centered flux limiter. +(define limiter-monotonized-centered + (hash + 'name "monotonized_centered" + 'limiter-expr `(max 0.0 (min (* 2.0 r) (/ (+ 1.0 r) 2.0) 2.0)) + 'limiter-ratio `r + )) + +;; Synthesize Gkeyll code (to be plugged into wave_prop.c) for the monotonized-centered flux limiter. +(define code-limiter-monotonized-centered + (gkyl-generate-flux-limiter limiter-monotonized-centered)) + +;; Output the flux limiter code to a file. +(with-output-to-file "gkyl_code/monotonized_centered_flux_limiter.c" + #:exists 'replace + (lambda () + (display code-limiter-monotonized-centered))) + +(display "Monotonized-centered flux limiter properties: \n\n") + +;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the monotonized-centered flux limiter. +(define proof-limiter-monotonized-centered-symmetry + (call-with-output-file "proofs/proof_limiter_monotonized_centered_symmetry.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-symmetry limiter-monotonized-centered))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_monotonized_centered_symmetry.rkt") + +;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. +(display "Symmetric (equivalent action on forward and backward gradients): ") +(display proof-limiter-monotonized-centered-symmetry) +(display "\n") + +;; Attempt to prove second-order TVD (total variation diminishing) of the monotonized-centered flux limiter. +(define proof-limiter-monotonized-centered-tvd + (call-with-output-file "proofs/proof_limiter_monotonized_centered_tvd.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-tvd limiter-monotonized-centered))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_monotonized_centered_tvd.rkt") + +;; Show whether the second-order TVD (total variation diminishing) property is satisfied. +(display "Second-order TVD (total variation diminishing): ") +(display proof-limiter-monotonized-centered-tvd) +(display "\n\n\n") + +;; Define the van Leer flux limiter. +(define limiter-van-leer + (hash + 'name "van_leer" + 'limiter-expr `(/ (+ r (abs r)) (+ 1.0 (abs r))) + 'limiter-ratio `r + )) + +;; Synthesize Gkeyll code (to be plugged into wave_prop.c) for the van Leer flux limiter. +(define code-limiter-van-leer + (gkyl-generate-flux-limiter limiter-van-leer)) + +;; Output the flux limiter code to a file. +(with-output-to-file "gkyl_code/van_leer_flux_limiter.c" + #:exists 'replace + (lambda () + (display code-limiter-van-leer))) + +(display "Van Leer flux limiter properties: \n\n") + +;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the van Leer flux limiter. +(define proof-limiter-van-leer-symmetry + (call-with-output-file "proofs/proof_limiter_van_leer_symmetry.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-symmetry limiter-van-leer))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_van_leer_symmetry.rkt") + +;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. +(display "Symmetric (equivalent action on forward and backward gradients): ") +(display proof-limiter-van-leer-symmetry) +(display "\n") + +;; Attempt to prove second-order TVD (total variation diminishing) of the van Leer flux limiter. +(define proof-limiter-van-leer-tvd + (call-with-output-file "proofs/proof_limiter_van_leer_tvd.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-tvd limiter-van-leer))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_van_leer_tvd.rkt") + +;; Show whether the second-order TVD (total variation diminishing) property is satisfied. +(display "Second-order TVD (total variation diminishing): ") +(display proof-limiter-van-leer-tvd) +(display "\n\n\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_test_linear_advection.rkt b/provable-algorithms/finite_volume/gkyl_test_linear_advection.rkt new file mode 100644 index 00000000..78058245 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_test_linear_advection.rkt @@ -0,0 +1,276 @@ +#lang racket + +(require "gkyl_code_generator_lax.rkt") +(require "gkyl_code_generator_roe.rkt") +(require "prover_core.rkt") +(provide (all-from-out "gkyl_code_generator_lax.rkt")) +(provide (all-from-out "gkyl_code_generator_roe.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D linear advection equation: du/dt + d(au)/dx = 0. +(define pde-linear-advection + (hash + 'name "advect" + 'cons-expr `u ; conserved variable: u + 'flux-expr `(* a u) ; flux function: f(u) = a * u + 'max-speed-expr `(abs a) ; local wave-speed: alpha = |a| + 'parameters (list + `(define a 1.0)) ; advection speed: a = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 0.0) +(define x1 2.0) +(define t-final 0.5) +(define cfl 0.95) +(define init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])) + +;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D linear advection equation. +(define code-linear-advection-lax-header + (gkyl-generate-lax-friedrichs-scalar-1d-header pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_advect_lax.h" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-header))) + +;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D linear advection equation. +(define code-linear-advection-lax-priv-header + (gkyl-generate-lax-friedrichs-scalar-1d-priv-header pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_advect_lax_priv.h" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-priv-header))) + +;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D linear advection equation. +(define code-linear-advection-lax-source + (gkyl-generate-lax-friedrichs-scalar-1d-source pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_advect_lax.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-source))) + +;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D linear advection equation. +(define code-linear-advection-lax-regression + (gkyl-generate-lax-friedrichs-scalar-1d-regression pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_advect_lax.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-regression))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D linear advection equation. +(define proof-linear-advection-lax-hyperbolicity + (call-with-output-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-linear-advection-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D linear advection equation. +(define proof-linear-advection-lax-cfl-stability + (call-with-output-file "proofs/proof_linear_advection_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-cfl-stability pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-linear-advection-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D linear advection equation. +(define proof-linear-advection-lax-local-lipschitz + (call-with-output-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-linear-advection-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the Gkeyll header code for a Roe solver for the 1D linear advection equation. +(define code-linear-advection-roe-header + (gkyl-generate-roe-scalar-1d-header pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_advect_roe.h" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-header))) + +;; Synthesize the Gkeyll private header code for a Roe solver for the 1D linear advection equation. +(define code-linear-advection-roe-priv-header + (gkyl-generate-roe-scalar-1d-priv-header pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_advect_roe_priv.h" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-priv-header))) + +;; Synthesize the Gkeyll source code for a Roe solver for the 1D linear advection equation. +(define code-linear-advection-roe-source + (gkyl-generate-roe-scalar-1d-source pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_advect_roe.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-source))) + +;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D linear advection equation. +(define code-linear-advection-roe-regression + (gkyl-generate-roe-scalar-1d-regression pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_advect_roe.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-regression))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D linear advection equation. +(define proof-linear-advection-roe-hyperbolicity + (call-with-output-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-hyperbolicity pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-linear-advection-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D linear advection equation. +(define proof-linear-advection-roe-flux-conservation + (call-with-output-file "proofs/proof_linear_advection_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-flux-conservation pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-linear-advection-roe-flux-conservation) +(display "\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Bx_psi.rkt b/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Bx_psi.rkt new file mode 100644 index 00000000..28f8056f --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Bx_psi.rkt @@ -0,0 +1,339 @@ +#lang racket + +(require "gkyl_code_generator_lax_vector.rkt") +(require "gkyl_code_generator_roe_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) +(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D Maxwell equations (Bx and psi components). +(define pde-system-maxwell-1d-Bx-psi + (hash + 'name "maxwell_Bxpsi" + 'cons-exprs (list + `Bx + `psi) ; conserved variables: magnetic field (x-component), magnetic field correction potential (psi). + 'flux-exprs (list + `(* b_fact psi) + `(* b_fact (* (* c c) Bx))) ; flux vector + 'max-speed-exprs (list + `(abs (* b_fact c)) + `(abs (* b_fact c))) ; local wave-speeds + 'parameters (list + `(define c 1.0) ; speed of light: c = 1.0 + `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 + `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.5) +(define x1 1.5) +(define t-final 1.0) +(define cfl 0.95) +(define init-funcs (list + 0.0 + `(cond + [(< x 0.0) 0.5] + [else -0.5]))) + +;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-lax-header + (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Bxpsi_lax.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-lax-header))) + +;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-lax-priv-header + (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Bxpsi_lax_priv.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-lax-priv-header))) + +;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-lax-source + (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_maxwell_Bxpsi_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-lax-source))) + +;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-lax-regression + (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_maxwell_Bxpsi_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-lax-regression))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-lax-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Bx-psi-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Bx-psi-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-lax-cfl-stability + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-maxwell-1d-Bx-psi-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components) +(define proof-maxwell-1d-Bx-psi-lax-local-lipschitz + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-maxwell-1d-Bx-psi-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the Gkeyll header code for a Roe solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-roe-header + (gkyl-generate-roe-vector2-1d-header pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Bxpsi_roe.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-roe-header))) + +;; Synthesize the Gkeyll private header code for a Roe solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-roe-priv-header + (gkyl-generate-roe-vector2-1d-priv-header pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Bxpsi_roe_priv.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-roe-priv-header))) + +;; Synthesize the Gkeyll source code for a Roe solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-roe-source + (gkyl-generate-roe-vector2-1d-source pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_maxwell_Bxpsi_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-roe-source))) + +;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-roe-regression + (gkyl-generate-roe-vector2-1d-regression pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_maxwell_Bxpsi_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-roe-regression))) + + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-roe-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Bx-psi-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Bx-psi-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-roe-flux-conservation + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-maxwell-1d-Bx-psi-roe-flux-conservation) +(display "\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ex_phi.rkt b/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ex_phi.rkt new file mode 100644 index 00000000..4c18a8b6 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ex_phi.rkt @@ -0,0 +1,339 @@ +#lang racket + +(require "gkyl_code_generator_lax_vector.rkt") +(require "gkyl_code_generator_roe_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) +(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D Maxwell equations (Ex and phi components). +(define pde-system-maxwell-1d-Ex-phi + (hash + 'name "maxwell_Exphi" + 'cons-exprs (list + `Ex + `phi) ; conserved variables: electric field (x-component), electric field correction potential (phi). + 'flux-exprs (list + `(* e_fact (* (* c c) phi)) + `(* e_fact Ex)) ; flux vector + 'max-speed-exprs (list + `(abs (* c e_fact)) + `(abs (* c e_fact))) ; local wave-speeds + 'parameters (list + `(define c 1.0) ; speed of light: c = 1.0 + `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 + `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.5) +(define x1 1.5) +(define t-final 1.0) +(define cfl 0.95) +(define init-funcs (list + 0.0 + `(cond + [(< x 0.0) 0.5] + [else -0.5]))) + +;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-lax-header + (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Exphi_lax.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-lax-header))) + +;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-lax-priv-header + (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Exphi_lax_priv.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-lax-priv-header))) + +;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-lax-source + (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_maxwell_Exphi_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-lax-source))) + +;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-lax-regression + (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_maxwell_Exphi_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-lax-regression))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-lax-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ex-phi-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ex-phi-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-lax-cfl-stability + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-maxwell-1d-Ex-phi-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components) +(define proof-maxwell-1d-Ex-phi-lax-local-lipschitz + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-maxwell-1d-Ex-phi-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the Gkeyll header code for a Roe solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-roe-header + (gkyl-generate-roe-vector2-1d-header pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Exphi_roe.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-roe-header))) + +;; Synthesize the Gkeyll private header code for a Roe solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-roe-priv-header + (gkyl-generate-roe-vector2-1d-priv-header pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Exphi_roe_priv.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-roe-priv-header))) + +;; Synthesize the Gkeyll source code for a Roe solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-roe-source + (gkyl-generate-roe-vector2-1d-source pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_maxwell_Exphi_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-roe-source))) + +;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-roe-regression + (gkyl-generate-roe-vector2-1d-regression pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_maxwell_Exphi_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-roe-regression))) + + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-roe-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ex-phi-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ex-phi-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-roe-flux-conservation + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-maxwell-1d-Ex-phi-roe-flux-conservation) +(display "\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ey_Bz.rkt b/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ey_Bz.rkt new file mode 100644 index 00000000..3d0d02e5 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ey_Bz.rkt @@ -0,0 +1,339 @@ +#lang racket + +(require "gkyl_code_generator_lax_vector.rkt") +(require "gkyl_code_generator_roe_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) +(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D Maxwell equations (Ey and Bz components). +(define pde-system-maxwell-1d-Ey-Bz + (hash + 'name "maxwell_EyBz" + 'cons-exprs (list + `Ey + `Bz) ; conserved variables: electric field (y-component), magnetic field (z-component) + 'flux-exprs (list + `(* (* c c) Bz) + `Ey) ; flux vector + 'max-speed-exprs (list + `(abs c) + `(abs c)) ; local wave-speeds + 'parameters (list + `(define c 1.0) ; speed of light: c = 1.0 + `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 + `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.5) +(define x1 1.5) +(define t-final 1.0) +(define cfl 0.95) +(define init-funcs (list + 0.0 + `(cond + [(< x 0.0) 0.5] + [else -0.5]))) + +;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-lax-header + (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EyBz_lax.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-lax-header))) + +;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-lax-priv-header + (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EyBz_lax_priv.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-lax-priv-header))) + +;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-lax-source + (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_maxwell_EyBz_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-lax-source))) + +;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-lax-regression + (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_maxwell_EyBz_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-lax-regression))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-lax-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ey-Bz-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ey-Bz-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-lax-cfl-stability + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-maxwell-1d-Ey-Bz-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components) +(define proof-maxwell-1d-Ey-Bz-lax-local-lipschitz + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-maxwell-1d-Ey-Bz-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the Gkeyll header code for a Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-roe-header + (gkyl-generate-roe-vector2-1d-header pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EyBz_roe.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-roe-header))) + +;; Synthesize the Gkeyll private header code for a Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-roe-priv-header + (gkyl-generate-roe-vector2-1d-priv-header pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EyBz_roe_priv.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-roe-priv-header))) + +;; Synthesize the Gkeyll source code for a Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-roe-source + (gkyl-generate-roe-vector2-1d-source pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_maxwell_EyBz_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-roe-source))) + +;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-roe-regression + (gkyl-generate-roe-vector2-1d-regression pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_maxwell_EyBz_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-roe-regression))) + + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-roe-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ey-Bz-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ey-Bz-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-roe-flux-conservation + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-maxwell-1d-Ey-Bz-roe-flux-conservation) +(display "\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ez_By.rkt b/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ez_By.rkt new file mode 100644 index 00000000..20ecb1c7 --- /dev/null +++ b/provable-algorithms/finite_volume/gkyl_test_maxwell_1d_Ez_By.rkt @@ -0,0 +1,339 @@ +#lang racket + +(require "gkyl_code_generator_lax_vector.rkt") +(require "gkyl_code_generator_roe_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) +(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D Maxwell equations (Ez and By components). +(define pde-system-maxwell-1d-Ez-By + (hash + 'name "maxwell_EzBy" + 'cons-exprs (list + `Ez + `By) ; conserved variables: electric field (z-component), magnetic field (y-component) + 'flux-exprs (list + `(* -1.0 (* (* c c) By)) + `(* -1.0 Ez)) ; flux vector + 'max-speed-exprs (list + `(abs c) + `(abs c)) ; local wave-speeds + 'parameters (list + `(define c 1.0) ; speed of light: c = 1.0 + `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 + `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.5) +(define x1 1.5) +(define t-final 1.0) +(define cfl 0.95) +(define init-funcs (list + 0.0 + `(cond + [(< x 0.0) 0.5] + [else -0.5]))) + +;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-lax-header + (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EzBy_lax.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-lax-header))) + +;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-lax-priv-header + (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EzBy_lax_priv.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-lax-priv-header))) + +;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-lax-source + (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_maxwell_EzBy_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-lax-source))) + +;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-lax-regression + (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_maxwell_EzBy_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-lax-regression))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-lax-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ez-By-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ez-By-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-lax-cfl-stability + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-maxwell-1d-Ez-By-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components) +(define proof-maxwell-1d-Ez-By-lax-local-lipschitz + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-maxwell-1d-Ez-By-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the Gkeyll header code for a Roe solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-roe-header + (gkyl-generate-roe-vector2-1d-header pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EzBy_roe.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-roe-header))) + +;; Synthesize the Gkeyll private header code for a Roe solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-roe-priv-header + (gkyl-generate-roe-vector2-1d-priv-header pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the private header code to a file. +(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EzBy_roe_priv.h" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-roe-priv-header))) + +;; Synthesize the Gkeyll source code for a Roe solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-roe-source + (gkyl-generate-roe-vector2-1d-source pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the source code to a file. +(with-output-to-file "gkyl_code/wv_maxwell_EzBy_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-roe-source))) + +;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-roe-regression + (gkyl-generate-roe-vector2-1d-regression pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the regression test to a file. +(with-output-to-file "gkyl_code/rt_maxwell_EzBy_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-roe-regression))) + + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-roe-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ez-By-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ez-By-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-roe-flux-conservation + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-maxwell-1d-Ez-By-roe-flux-conservation) +(display "\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/prover_core.rkt b/provable-algorithms/finite_volume/prover_core.rkt new file mode 100644 index 00000000..23c39345 --- /dev/null +++ b/provable-algorithms/finite_volume/prover_core.rkt @@ -0,0 +1,1284 @@ +#lang racket + +(require racket/trace) +(current-prefix-in " ") +(current-prefix-out " ") + +(provide symbolic-diff + symbolic-simp-rule + symbolic-simp + is-real + flux-deriv-replace + symbolic-roe-function + is-non-negative + variable-transform + symbolic-simp-positive-rule + symbolic-simp-positive + evaluate-limit-rule + evaluate-limit + prove-lax-friedrichs-scalar-1d-hyperbolicity + prove-lax-friedrichs-scalar-1d-cfl-stability + prove-lax-friedrichs-scalar-1d-local-lipschitz + prove-lax-friedrichs-scalar-2d-hyperbolicity + prove-lax-friedrichs-scalar-2d-cfl-stability + prove-lax-friedrichs-scalar-2d-local-lipschitz + prove-roe-scalar-1d-hyperbolicity + prove-roe-scalar-1d-flux-conservation + prove-roe-scalar-2d-hyperbolicity + prove-roe-scalar-2d-flux-conservation + prove-flux-limiter-symmetry + prove-flux-limiter-tvd) + +;; Lightweight symbolic differentiator (differentiates expr with respect to var). +(define (symbolic-diff expr var) + (match expr + ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. + [(? symbol? symb) (cond + [(eq? symb var) 1.0] + [else 0.0])] + + ;; If expr is a numerical constant, then it differentiates to 0. + [(? number?) 0.0] + + ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] + ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] + + ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. + [`(* . ,terms) + (define n (length terms)) + (define (mult xs) (cons '* xs)) ; Multiplication helper function. + + ((lambda (sums) (cond + [(null? (cdr sums)) (car sums)] + [else (cons '+ sums)])) + (let loop ([i 0]) + (cond + [(= i n) `()] + [else + ;; Evaluate the derivative of the i-th term in the product. + (let ([di (symbolic-diff (list-ref terms i) var)]) + (cons + (mult (for/list ([j (in-range n)]) + (cond + [(= j i) di] + [else (list-ref terms j)]))) + (loop (add1 i))))])))] + + ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. + [`(/ ,x ,y) + `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] + + ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). + [`(abs ,arg) + `(* (sgn ,arg) ,(symbolic-diff arg var))] + + ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. + [`(sgn ,arg) 0.0] + + ;; Otherwise, return false. + [else #f])) + +;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). +(define (symbolic-simp-rule expr) + (match expr + ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. + [`(+ 0 ,x) `,x] + [`(+ 0.0 ,x) `,x] + [`(+ -0.0 ,x) `,x] + + ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. + [`(* 1 ,x) `,x] + [`(* 1.0 ,x) `,x] + + ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. + [`(* 0 ,x) 0] + [`(* 0.0 ,x) 0.0] + [`(* -0.0 ,x) 0.0] + + ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. + [`(- ,x 0) `,x] + [`(- ,x 0.0) `,x] + [`(- ,x -0.0) `,x] + + ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). + [`(- 0 ,x) `(* -1 ,x)] + [`(- 0.0 ,x) `(* -1.0 ,x)] + [`(- -0.0 ,x) `(* -1.0 ,x)] + + ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. + [`(/ ,x 1) `,x] + [`(/ ,x 1.0) `,x] + + ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). + [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] + [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] + + ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). + [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] + [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] + + ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. + [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] + [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] + + ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients + [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] + [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] + + ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. + [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] + + ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). + [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] + + ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). + [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] + + ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). + [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] + + ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). + [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] + + ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). + [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] + + ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). + [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] + ;; Likewise for differences. + [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] + + ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. + [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] + + ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). + [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] + + ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). + [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] + + ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. + [`(sqrt (* ,x ,x)) `,x] + [`(* (sqrt ,x) (sqrt ,x)) `,x] + + ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). + [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] + ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). + [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] + + ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). + [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] + + ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. + [`(sqrt ,(and x (? number?))) (sqrt x)] + + ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. + [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] + [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] + + ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., + [`(abs ,(and x (? number?))) (abs x)] + + ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). + [`(abs (* -1 ,x)) `(abs ,x)] + [`(abs (* -1.0 ,x)) `(abs ,x)] + + ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). + [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] + [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + + ;; If expr is of the form (x + x), thens implify to (2.0 * x). + [`(+ ,x ,x) `(* 2.0 ,x)] + + ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). + [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] + + ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). + [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] + + ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). + [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] + + ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). + [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] + + ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). + [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] + [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] + + ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). + [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] + + ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). + [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] + + ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). + [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] + [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + + ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). + [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] + + ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). + [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] + + ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. + [`(/ 0 ,x) 0] + [`(/ 0.0 ,x) 0.0] + [`(/ -0.0 ,x) 0.0] + + ;; If expr is of the form (x / x), then simplify to 1.0 + [`(/ ,x ,x) 1.0] + + ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). + [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] + ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). + [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] + + ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). + [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] + + ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). + [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] + [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] + + ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). + [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] + [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] + + ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for differences. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. + [`(* . ,terms) + `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for quotients. + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. + [`(sqrt ,arg) + `(sqrt ,(symbolic-simp-rule arg))] + + ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. + [`(abs ,arg) + `(abs ,(symbolic-simp-rule arg))] + + ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). + [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] + [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] + + ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). + [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). + [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] + + ;; Otherwise, return the expression. + [else expr])) + +;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). +(define (symbolic-simp expr) + (define simp-expr (symbolic-simp-rule expr)) + + (cond + [(equal? simp-expr expr) expr] + [else (symbolic-simp simp-expr)])) + +;; Recursively determine whether an expression corresponds to a real number. +(define (is-real expr cons-vars parameters) + (match expr + ;; Real numbers are trivially real. + [(? real?) #t] + + ;; Conserved variables are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (not (equal? (member arg cons-vars) #f)))) #t] + + ;; Simulation parameters are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (equal? arg (list-ref parameter 1))) parameters)))) #t] + + ;; The outcome of a conditional operation is real if both branches yield real numbers. + [`(cond + [,cond1 ,expr1] + [else ,expr2]) + (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] + + ;; The sum, difference, product, or quotient of two real numbers is always real. + [`(+ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(- . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(* . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(/ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + + ;; Otherwise, assume false. + [else #f])) + +;; Recursively replace conserved variable expressions within the flux derivative expression (for Roe functions). +(define (flux-deriv-replace flux-deriv-expr cons-expr new-cons-expr) + (match flux-deriv-expr + ;; If the flux derivative expression is just the conserved variable expression, then return the new conserved variable expression. + [(? (lambda (arg) + (equal? arg cons-expr))) new-cons-expr] + + ;; If the flux derivative expression consists of a sum, difference, product, or quotient, then recursively apply replacement to each term. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + [`(- . ,terms) + `(- ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + [`(* . ,terms) + `(* ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + + ;; Otherwise, return the flux derivative expression. + [else flux-deriv-expr])) + +;; Compute the symbolic Roe function (averaged flux derivative). +(define (symbolic-roe-function flux-deriv-expr cons-expr) + (symbolic-simp `(+ (* 0.5 ,(flux-deriv-replace flux-deriv-expr cons-expr (string->symbol (string-append (symbol->string cons-expr) "L")))) + (* 0.5 ,(flux-deriv-replace flux-deriv-expr cons-expr (string->symbol (string-append (symbol->string cons-expr) "R"))))))) + +;; Determine whether an expression is non-negative. +(define (is-non-negative expr parameters) + (match expr + ;; A non-negative number is, trivially, non-negative. + [(? (lambda (arg) + (and (number? arg) (or (>= arg 0) (>= arg 0.0))))) #t] + + ;; Simulation parameters that are non-negative are, trivially, non-negative. + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (and (equal? arg (list-ref parameter 1)) + (or (>= (list-ref parameter 2) 0) + (>= (list-ref parameter 2) 0.0)))) parameters)))) #t] + + ;; The sum, product, or quotient of two non-negative numbers is always non-negative. + [`(+ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] + [`(* ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] + [`(/ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] + + ;; Otherwise, assume false. + [else #f])) + +;; Recursively ransform all occurrences of a given variable within an expression to a new variable. +(define (variable-transform expr var new-var) + (cond + ;; Replace any occurrence of var in expr with new-var. + [(symbol? expr) (cond + [(equal? expr var) new-var] + [else expr])] + + ;; Recursively apply variable-transform to all subexpressions. + [(pair? expr) (map (lambda (subexpr) + (variable-transform subexpr var new-var)) expr)] + + ;; Otherwise, return the expression. + [else expr])) + +;; Lightweight symbolic simplification rules, assuming strict positivity of pos-var. +(define (symbolic-simp-positive-rule expr pos-var) + (match expr + ;; If expr is of the form (abs(x) / y), with y strictly positive, then simplify to abs(x / y). + [`(/ (abs ,x) ,pos-var) `(abs (/ ,x ,pos-var))] + + ;; If expr is of the form abs(x), abs(1 / x) or abs(1.0 / x), with x strictly positive, then simplify to x, (1 / x) or (1.0 / x). + [`(abs ,pos-var) pos-var] + [`(abs (/ 1 ,pos-var)) `(/ 1 ,pos-var)] + [`(abs (/ 1.0 ,pos-var)) `(/ 1.0 ,pos-var)] + + ;; If expr is of the form sgn(x), with x strictly positive, then simplify to 1.0. + [`(sgn ,pos-var) 1.0] + + ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. + [`(abs ,x) + `(abs ,(symbolic-simp-positive-rule x pos-var))] + + ;; If expr is of the form (max(x, y) / z) or (min(x, y) / z), with z strictly positive, then simplify to max((x / z), (y / z)) or min((x / z), (y / z)). + [`(/ (max ,x ,y) ,pos-var) `(max (/ ,y ,pos-var) (/ ,x ,pos-var))] + [`(/ (min ,x ,y) ,pos-var) `(min (/ ,y ,pos-var) (/ ,x ,pos-var))] + + ;; If expr is of the form (max(x, y, z) / w) or (min(x, y, z) / w), with w strictly positive, then simplify to max((x / w), (y / w), (z / w)) or min((x / w), (y / w), (z / w)). + [`(/ (max ,x ,y ,z) ,pos-var) `(max (/ ,z ,pos-var) (/ ,y ,pos-var) (/ ,x ,pos-var))] + [`(/ (min ,x ,y, z) ,pos-var) `(min (/ ,z ,pos-var) (/ ,y ,pos-var) (/ ,x ,pos-var))] + + ;; If expr is a max or a min of the form max(x, y, ...) or min(x, y, ...), then apply symbolic simplification to each term x, y, ... in the function. + [`(max . ,terms) + `(max ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] + [`(min . ,terms) + `(min ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] + + ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] + ;; Likewise for differences. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] + + ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. + [`(* . ,terms) + `(* ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] + ;; Likewise for quotients. + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] + + ;; Otherwise, return the expression. + [else expr])) + +;; Recursively apply the symbolic simplification rules (assuming strict positivity of pos-var) until the expression stops changing (fixed point). +(define (symbolic-simp-positive expr pos-var) + (define simp-pos-expr (symbolic-simp-positive-rule expr pos-var)) + + (cond + [(equal? simp-pos-expr expr) expr] + [else (symbolic-simp-positive simp-pos-expr pos-var)])) + +;; Lightweight symbolic limit evaluation rules (computes limit of expr as var approaches lim). +(define (evaluate-limit-rule expr var lim) + (match expr + ;; If expr is of the form max(x, y) for numeric x and y, then just evaluate the maximum of the pair. Likewise for minima. + [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] + [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] + + ;; If expr is of the form max(x, y, z) for numeric x, y and z, then just evaluate the maximum of the triple. Likewise for minima. + [`(max ,(and x (? number?)) ,(and y (? number?)) ,(and z (? number?))) (max x y z)] + [`(min ,(and x (? number?)) ,(and y (? number?)) ,(and z (? number?))) (min x y z)] + + ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value. + [`(abs ,(and x (? number?))) (abs x)] + + ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. + [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] + [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] + + ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients. + [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] + [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] + + ;; If expr is of the form max(expr1, expr2), then evaluate the limits of the interior expr1 and expr2. Likewise for minima. + [`(max ,x ,y) `(max ,(evaluate-limit-rule x var lim) ,(evaluate-limit-rule y var lim))] + [`(min ,x ,y) `(min ,(evaluate-limit-rule x var lim) ,(evaluate-limit-rule y var lim))] + + ;; If expr is of the form max(expr1, expr2, expr3), then evaluate the limits of the interior expr1, expr2 and expr3. Likewise for minima. + [`(max ,x ,y ,z) `(max ,(evaluate-limit-rule x var lim) ,(evaluate-limit-rule y var lim) ,(evaluate-limit-rule z var lim))] + [`(min ,x ,y ,z) `(min ,(evaluate-limit-rule x var lim) ,(evaluate-limit-rule y var lim) ,(evaluate-limit-rule z var lim))] + + ;; If expr is of the form abs(expr1), then evaluate the limit of the interior expr1. + [`(abs ,x) `(abs ,(evaluate-limit-rule x var lim))] + + ;; If expr is a sum of the form (x + y + ...), then evaluate the limits each term x, y, ... in the sum. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (evaluate-limit-rule term var lim)) terms))] + ;; Likewise for differences. + [`(- . ,terms) + `(- ,@(map (lambda (term) (evaluate-limit-rule term var lim)) terms))] + + ;; If expr is a product of the form (x * y * ...), then evaluate the limits each term x, y, ... in the product. + [`(* . ,terms) + `(* ,@(map (lambda (term) (evaluate-limit-rule term var lim)) terms))] + ;; Likewise for quotients. + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (evaluate-limit-rule term var lim)) terms))] + + ;; Otherwise, return the expression. + [else expr])) + +;; Recursively apply the limit evaluation rules until the expression stops changing (fixed point). +(define (evaluate-limit expr var limit) + (define limit-val (variable-transform expr var limit)) + (define limit-expr (evaluate-limit-rule limit-val var limit)) + + (cond + [(equal? limit-expr expr) expr] + [else (evaluate-limit limit-expr var limit)])) + +;; ---------------------------------------------------------------------------------------- +;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE +;; ---------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-scalar-1d-hyperbolicity pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 1D scalar PDE specified by `pde`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the derivative of the flux function is real (otherwise, return false). + [(not (is-real (symbolic-simp (symbolic-diff flux-expr cons-expr)) (list cons-expr) parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + + out) +(trace prove-lax-friedrichs-scalar-1d-hyperbolicity) + +;; ---------------------------------------------------------------------------------------- +;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE +;; ---------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-scalar-1d-cfl-stability pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 1D scalar PDE specified by `pde`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the absolute value of the derivative of the flux function is symbolically equivalent to the maximum wave-speed estimate (otherwise, return false). + [(not (equal? (symbolic-simp `(abs ,(symbolic-diff flux-expr cons-expr))) + (symbolic-simp max-speed-expr))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + + out) +(trace prove-lax-friedrichs-scalar-1d-cfl-stability) + +;; ------------------------------------------------------------------------------------------------------------------------------------ +;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------------------------------------------------------------------ +(define (prove-lax-friedrichs-scalar-1d-local-lipschitz pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 1D scalar PDE specified by `pde`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace is-non-negative) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the flux function is convex, i.e. that the second derivative of the flux function is strictly non-negative (otherwise, return false). + [(let ([deriv (symbolic-simp (symbolic-diff (symbolic-simp (symbolic-diff flux-expr cons-expr)) cons-expr))]) + (not (is-non-negative deriv parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace is-non-negative) + + out) +(trace prove-lax-friedrichs-scalar-1d-local-lipschitz) + +;; ---------------------------------------------------------------------------------------- +;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 2D Scalar PDE +;; ---------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-scalar-2d-hyperbolicity pde + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 2D scalar PDE specified by `pde`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the derivatives of the flux function are real (otherwise, return false). + [(not (is-real (symbolic-simp (symbolic-diff flux-expr-x cons-expr)) (list cons-expr) parameters)) #f] + [(not (is-real (symbolic-simp (symbolic-diff flux-expr-y cons-expr)) (list cons-expr) parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + + out) +(trace prove-lax-friedrichs-scalar-2d-hyperbolicity) + +;; ---------------------------------------------------------------------------------------- +;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for 2D Scalar PDE +;; ---------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-scalar-2d-cfl-stability pde + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 2D scalar PDE specified by `pde`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the absolute value sof the derivatives of the flux function are symbolically equivalent to the maximum wave-speed estimates (otherwise, return false). + [(not (equal? (symbolic-simp `(abs ,(symbolic-diff flux-expr-x cons-expr))) + (symbolic-simp max-speed-expr-x))) #f] + [(not (equal? (symbolic-simp `(abs ,(symbolic-diff flux-expr-y cons-expr))) + (symbolic-simp max-speed-expr-y))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + + out) +(trace prove-lax-friedrichs-scalar-2d-cfl-stability) + +;; ------------------------------------------------------------------------------------------------------------------------------------ +;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 2D Scalar PDE +;; ------------------------------------------------------------------------------------------------------------------------------------ +(define (prove-lax-friedrichs-scalar-2d-local-lipschitz pde + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 2D scalar PDE specified by `pde`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace is-non-negative) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the flux functions are convex, i.e. that the second derivatives of the flux functions are strictly non-negative (otherwise, return false). + [(let ([deriv (symbolic-simp (symbolic-diff (symbolic-simp (symbolic-diff flux-expr-x cons-expr)) cons-expr))]) + (not (is-non-negative deriv parameters))) #f] + [(let ([deriv (symbolic-simp (symbolic-diff (symbolic-simp (symbolic-diff flux-expr-y cons-expr)) cons-expr))]) + (not (is-non-negative deriv parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace is-non-negative) + + out) +(trace prove-lax-friedrichs-scalar-2d-local-lipschitz) + +;; ------------------------------------------------------------------------- +;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------- +(define (prove-roe-scalar-1d-hyperbolicity pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Prove that the Roe finite-volume method preserves hyperbolicity for the 1D scalar PDE specified by `pde`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-roe-function) + (trace flux-deriv-replace) + + (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the Roe function is real (otherwise, return false). + [(not (is-real (symbolic-roe-function flux-deriv cons-expr) (list + (string->symbol (string-append (symbol->string cons-expr) "L")) + (string->symbol (string-append (symbol->string cons-expr) "R"))) parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-roe-function) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-scalar-1d-hyperbolicity) + +;; ----------------------------------------------------------------------------------------------- +;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 1D Scalar PDE +;; ----------------------------------------------------------------------------------------------- +(define (prove-roe-scalar-1d-flux-conservation pde + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 1D scalar PDE specified by `pde`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-roe-function) + (trace flux-deriv-replace) + + (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) + + (define roe-jump (symbolic-simp `(* ,(symbolic-roe-function flux-deriv cons-expr) (- ,(string->symbol (string-append (symbol->string cons-expr) "L")) + ,(string->symbol (string-append (symbol->string cons-expr) "R")))))) + (define flux-jump (symbolic-simp `(- ,(flux-deriv-replace flux-expr cons-expr (string->symbol (string-append (symbol->string cons-expr) "L"))) + ,(flux-deriv-replace flux-expr cons-expr (string->symbol (string-append (symbol->string cons-expr) "R")))))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the jump in the flux function is equal to the product of the Roe function and the jump in the conserved variable (otherwise, return false). + [(not (equal? roe-jump flux-jump)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-roe-function) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-scalar-1d-flux-conservation) + +;; ------------------------------------------------------------------------- +;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 2D Scalar PDE +;; ------------------------------------------------------------------------- +(define (prove-roe-scalar-2d-hyperbolicity pde + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Prove that the Roe finite-volume method preserves hyperbolicity for the 2D scalar PDE specified by `pde`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-roe-function) + (trace flux-deriv-replace) + + (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) + (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the Roe functions are real (otherwise, return false). + [(not (is-real (symbolic-roe-function flux-deriv-x cons-expr) (list + (string->symbol (string-append (symbol->string cons-expr) "L")) + (string->symbol (string-append (symbol->string cons-expr) "R"))) parameters)) #f] + [(not (is-real (symbolic-roe-function flux-deriv-y cons-expr) (list + (string->symbol (string-append (symbol->string cons-expr) "L")) + (string->symbol (string-append (symbol->string cons-expr) "R"))) parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-roe-function) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-scalar-2d-hyperbolicity) + +;; ----------------------------------------------------------------------------------------------- +;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 2D Scalar PDE +;; ----------------------------------------------------------------------------------------------- +(define (prove-roe-scalar-2d-flux-conservation pde + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 2D scalar PDE specified by `pde`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-roe-function) + (trace flux-deriv-replace) + + (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) + (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) + + (define roe-jump-x (symbolic-simp `(* ,(symbolic-roe-function flux-deriv-x cons-expr) (- ,(string->symbol (string-append (symbol->string cons-expr) "L")) + ,(string->symbol (string-append (symbol->string cons-expr) "R")))))) + (define roe-jump-y (symbolic-simp `(* ,(symbolic-roe-function flux-deriv-y cons-expr) (- ,(string->symbol (string-append (symbol->string cons-expr) "L")) + ,(string->symbol (string-append (symbol->string cons-expr) "R")))))) + (define flux-jump-x (symbolic-simp `(- ,(flux-deriv-replace flux-expr-x cons-expr (string->symbol (string-append (symbol->string cons-expr) "L"))) + ,(flux-deriv-replace flux-expr-x cons-expr (string->symbol (string-append (symbol->string cons-expr) "R")))))) + (define flux-jump-y (symbolic-simp `(- ,(flux-deriv-replace flux-expr-y cons-expr (string->symbol (string-append (symbol->string cons-expr) "L"))) + ,(flux-deriv-replace flux-expr-y cons-expr (string->symbol (string-append (symbol->string cons-expr) "R")))))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the jumps in the flux functions are equal to the product of the Roe functions and the jumps in the conserved variable (otherwise, return false). + [(not (equal? roe-jump-x flux-jump-x)) #f] + [(not (equal? roe-jump-y flux-jump-y)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-roe-function) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-scalar-2d-flux-conservation) + +;; ------------------------------------------------- +;; Prove symmetry for a High-Resolution Flux Limiter +;; ------------------------------------------------- +(define (prove-flux-limiter-symmetry limiter) + "Prove that the high-resolution flux limiter specified by `limiter-code` acts symmetrically on forward and backward gradients." + + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (trace variable-transform) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-simp-positive) + (trace symbolic-simp-positive-rule) + + (define out (cond + ;; Check whether the symmetry property phi(r) / r = phi(1 / r) holds (otherwise, return false). + [(not (equal? (symbolic-simp + (symbolic-simp-positive (symbolic-simp (symbolic-simp-positive `(/ ,limiter-expr ,limiter-ratio) limiter-ratio)) limiter-ratio)) + (symbolic-simp + (symbolic-simp-positive (symbolic-simp (symbolic-simp-positive (variable-transform limiter-expr limiter-ratio `(/ 1.0 ,limiter-ratio)) + limiter-ratio)) limiter-ratio)))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace variable-transform) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-simp-positive) + (untrace symbolic-simp-positive-rule) + + out) +(trace prove-flux-limiter-symmetry) + +;; --------------------------------------------------------------------------------------- +;; Prove second-order TVD (total variation diminishing) for a High-Resolution Flux Limiter +;; --------------------------------------------------------------------------------------- +(define (prove-flux-limiter-tvd limiter) + "Prove that the high-resolution flux limiter specified by `limiter-code` is second-order TVD (total variation diminishing)." + + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (trace variable-transform) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-simp-positive) + (trace symbolic-simp-positive-rule) + (trace evaluate-limit) + (trace evaluate-limit-rule) + + (define limiter-convexity (symbolic-simp (symbolic-diff (symbolic-simp-positive (symbolic-simp (symbolic-diff + (symbolic-simp-positive + (symbolic-simp limiter-expr) limiter-ratio) limiter-ratio)) + limiter-ratio) limiter-ratio))) + (define limiter-mid (evaluate-limit limiter-expr limiter-ratio 1.0)) + (define limiter-boundary-left (evaluate-limit limiter-expr limiter-ratio 0.0)) + (define limiter-boundary-right (evaluate-limit limiter-expr limiter-ratio 2.0)) + (define limiter-infinity (evaluate-limit limiter-expr limiter-ratio +inf.0)) + + (define out (cond + ;; Check whether the limiter function is concave, i.e. that the second derivative of the limiter function is negative (otherwise, return false). + [(or (not (number? limiter-convexity)) (> limiter-convexity 0.0)) #f] + + ;; Check whether the limiter function limits to 1.0 at the midpoint r = 1.0 (otherwise, return false). + [(or (not (number? limiter-mid)) (not (equal? limiter-mid 1.0))) #f] + + ;; Check whether the limiter function limits to between 0.0 and 1.0 inclusive at the left (r = 0.0) boundary (otherwise, return false). + [(or (not (number? limiter-boundary-left)) (> limiter-boundary-left 1.0) (< limiter-boundary-left 0.0)) #f] + + ;; Check whether the limiter function limits to between 1.0 and 2.0 inclusive at the right (r = 2.0) boundary (otherwise, return false). + [(or (not (number? limiter-boundary-right)) (> limiter-boundary-right 2.0) (< limiter-boundary-right 1.0)) #f] + + ;; Check whether the limiter function limits to less than 2.0 inclusive as r approaches +infinity (otherwise, return false). + [(or (not (number? limiter-infinity)) (> limiter-infinity 2.0)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace variable-transform) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-simp-positive) + (untrace symbolic-simp-positive-rule) + (untrace evaluate-limit) + (untrace evaluate-limit-rule) + + out) +(trace prove-flux-limiter-tvd) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/prover_vector.rkt b/provable-algorithms/finite_volume/prover_vector.rkt new file mode 100644 index 00000000..78de9881 --- /dev/null +++ b/provable-algorithms/finite_volume/prover_vector.rkt @@ -0,0 +1,1916 @@ +#lang racket + +(require racket/trace) +(current-prefix-in " ") +(current-prefix-out " ") + +(provide symbolic-jacobian + symbolic-gradient + symbolic-hessian + symbolic-eigvals2 + symbolic-eigvals3 + is-non-zero + are-distinct + symbolic-roe-matrix + prove-lax-friedrichs-vector2-1d-hyperbolicity + prove-lax-friedrichs-vector2-1d-strict-hyperbolicity + prove-lax-friedrichs-vector2-1d-cfl-stability + prove-lax-friedrichs-vector2-1d-local-lipschitz + prove-lax-friedrichs-vector3-2d-hyperbolicity + prove-lax-friedrichs-vector3-2d-strict-hyperbolicity + prove-lax-friedrichs-vector3-2d-cfl-stability + prove-lax-friedrichs-vector3-2d-local-lipschitz + prove-roe-vector2-1d-hyperbolicity + prove-roe-vector2-1d-strict-hyperbolicity + prove-roe-vector2-1d-flux-conservation + prove-roe-vector3-2d-hyperbolicity + prove-roe-vector3-2d-strict-hyperbolicity + prove-roe-vector3-2d-flux-conservation) + +;; Lightweight symbolic differentiator (differentiates expr with respect to var). +(define (symbolic-diff expr var) + (match expr + ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. + [(? symbol? symb) (cond + [(eq? symb var) 1.0] + [else 0.0])] + + ;; If expr is a numerical constant, then it differentiates to 0. + [(? number?) 0.0] + + ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] + ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] + + ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. + [`(* . ,terms) + (define n (length terms)) + (define (mult xs) (cons '* xs)) ; Multiplication helper function. + + ((lambda (sums) (cond + [(null? (cdr sums)) (car sums)] + [else (cons '+ sums)])) + (let loop ([i 0]) + (cond + [(= i n) `()] + [else + ;; Evaluate the derivative of the i-th term in the product. + (let ([di (symbolic-diff (list-ref terms i) var)]) + (cons + (mult (for/list ([j (in-range n)]) + (cond + [(= j i) di] + [else (list-ref terms j)]))) + (loop (add1 i))))])))] + + ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. + [`(/ ,x ,y) + `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] + + ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). + [`(abs ,arg) + `(* (sgn ,arg) ,(symbolic-diff arg var))] + + ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. + [`(sgn ,arg) 0.0] + + ;; Otherwise, return false. + [else #f])) + +;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). +(define (symbolic-simp-rule expr) + (match expr + ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. + [`(+ 0 ,x) `,x] + [`(+ 0.0 ,x) `,x] + [`(+ -0.0 ,x) `,x] + + ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. + [`(* 1 ,x) `,x] + [`(* 1.0 ,x) `,x] + + ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. + [`(* 0 ,x) 0] + [`(* 0.0 ,x) 0.0] + [`(* -0.0 ,x) 0.0] + + ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. + [`(- ,x 0) `,x] + [`(- ,x 0.0) `,x] + [`(- ,x -0.0) `,x] + + ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). + [`(- 0 ,x) `(* -1 ,x)] + [`(- 0.0 ,x) `(* -1.0 ,x)] + [`(- -0.0 ,x) `(* -1.0 ,x)] + + ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. + [`(/ ,x 1) `,x] + [`(/ ,x 1.0) `,x] + + ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). + [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] + [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] + + ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). + [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] + [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] + + ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. + [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] + [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] + + ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients + [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] + [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] + + ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. + [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] + + ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). + [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] + + ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). + [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] + + ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). + [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] + + ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). + [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] + + ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). + [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] + + ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). + [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] + ;; Likewise for differences. + [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] + + ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. + [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] + + ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). + [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] + + ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). + [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] + + ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. + [`(sqrt (* ,x ,x)) `,x] + [`(* (sqrt ,x) (sqrt ,x)) `,x] + + ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). + [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] + ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). + [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] + + ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). + [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] + + ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. + [`(sqrt ,(and x (? number?))) (sqrt x)] + + ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. + [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] + [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] + + ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., + [`(abs ,(and x (? number?))) (abs x)] + + ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). + [`(abs (* -1 ,x)) `(abs ,x)] + [`(abs (* -1.0 ,x)) `(abs ,x)] + + ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). + [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] + [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + + ;; If expr is of the form (x + x), thens implify to (2.0 * x). + [`(+ ,x ,x) `(* 2.0 ,x)] + + ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). + [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] + + ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). + [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] + + ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). + [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] + + ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). + [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] + + ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). + [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] + [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] + + ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). + [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] + + ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). + [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] + + ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). + [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] + [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + + ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). + [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] + + ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). + [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] + + ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. + [`(/ 0 ,x) 0] + [`(/ 0.0 ,x) 0.0] + [`(/ -0.0 ,x) 0.0] + + ;; If expr is of the form (x / x), then simplify to 1.0 + [`(/ ,x ,x) 1.0] + + ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). + [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] + ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). + [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] + + ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). + [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] + + ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). + [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] + [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] + + ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). + [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] + [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] + + ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for differences. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. + [`(* . ,terms) + `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for quotients. + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. + [`(sqrt ,arg) + `(sqrt ,(symbolic-simp-rule arg))] + + ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. + [`(abs ,arg) + `(abs ,(symbolic-simp-rule arg))] + + ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). + [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] + [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] + + ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). + [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). + [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] + + ;; Otherwise, return the expression. + [else expr])) + +;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). +(define (symbolic-simp expr) + (define simp-expr (symbolic-simp-rule expr)) + + (cond + [(equal? simp-expr expr) expr] + [else (symbolic-simp simp-expr)])) + +;; Recursively determine whether an expression corresponds to a real number. +(define (is-real expr cons-vars parameters) + (match expr + ;; Real numbers are trivially real. + [(? real?) #t] + + ;; Conserved variables are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (not (equal? (member arg cons-vars) #f)))) #t] + + ;; Simulation parameters are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (equal? arg (list-ref parameter 1))) parameters)))) #t] + + ;; The outcome of a conditional operation is real if both branches yield real numbers. + [`(cond + [,cond1 ,expr1] + [else ,expr2]) + (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] + + ;; The sum, difference, product, or quotient of two real numbers is always real. + [`(+ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(- . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(* . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(/ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + + ;; Otherwise, assume false. + [else #f])) + +;; Recursively replace conserved variable expressions within the flux derivative expression (for Roe functions). +(define (flux-deriv-replace flux-deriv-expr cons-expr new-cons-expr) + (match flux-deriv-expr + ;; If the flux derivative expression is just the conserved variable expression, then return the new conserved variable expression. + [(? (lambda (arg) + (equal? arg cons-expr))) new-cons-expr] + + ;; If the flux derivative expression consists of a sum, difference, product, or quotient, then recursively apply replacement to each term. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + [`(- . ,terms) + `(- ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + [`(* . ,terms) + `(* ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] + + ;; Otherwise, return the flux derivative expression. + [else flux-deriv-expr])) + +;; Compute symbolic Jacobian matrix by mapping symbolic differentiation over exprs with respect to vars. +(define (symbolic-jacobian exprs vars) + (map (lambda (expr) + (map (lambda (var) + (symbolic-simp (symbolic-diff expr var))) + vars)) + exprs)) + +;; Compute symbolic gradient vector by applying symbolic differentiation to expr, mapped over vars. +(define (symbolic-gradient expr vars) + (map (lambda (var) + (symbolic-simp (symbolic-diff expr var))) + vars)) + +;; Compute symbolic Hessian matrix by computing the symbolic Jacobian matrix of the symbolic gradient vector of expr with respect to vars. +(define (symbolic-hessian expr vars) + (symbolic-jacobian (symbolic-gradient expr vars) vars)) + +;; Compute symbolic eigenvalues of a 2x2 symbolic matrix via explicit solution of the characteristic polynomial. +(define (symbolic-eigvals2 matrix) + (let ([a (list-ref (list-ref matrix 0) 0)] + [b (list-ref (list-ref matrix 0) 1)] + [c (list-ref (list-ref matrix 1) 0)] + [d (list-ref (list-ref matrix 1) 1)]) + (cond + ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a pair of zeroes. + [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0)) (list 0.0 0.0)] + + ;; Otherwise, calculate the eigenvalues explicitly. + [else (list `(* 0.5 (+ (- ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)) + `(* 0.5 (+ (+ ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)))]))) + +;; Compute symbolic eigenvalues of a 3x3 symbolic matrix (in restricted cases) via explicit solution of the characteristic polynomial. +(define (symbolic-eigvals3 matrix) + (let ([a (list-ref (list-ref matrix 0) 0)] + [b (list-ref (list-ref matrix 0) 1)] + [c (list-ref (list-ref matrix 0) 2)] + [d (list-ref (list-ref matrix 1) 0)] + [e (list-ref (list-ref matrix 1) 1)] + [f (list-ref (list-ref matrix 1) 2)] + [g (list-ref (list-ref matrix 2) 0)] + [h (list-ref (list-ref matrix 2) 1)] + [i (list-ref (list-ref matrix 2) 2)]) + (cond + ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a triple of zeroes. + [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0) (equal? e 0.0) (equal? f 0.0) (equal? g 0.0) (equal? h 0.0) (equal? i 0.0)) (list 0.0 0.0 0.0)] + + ;; If the matrix is in a restricted (tractable) form, calculate the eigenvalues explicitly. + [(and (equal? a 0.0) (equal? b 1.0) (equal? c 0.0) (equal? f 0.0)) + (list `(* 0.5 (- ,e (sqrt (+ (* 4.0 ,d) (* ,e ,e))))) `(* 0.5 (+ ,e (sqrt (+ (* 4.0 ,d) (* ,e ,e))))) i)] + [(and (equal? a 0.0) (equal? b 0.0) (equal? c 1.0) (equal? h 0.0)) + (list e `(* 0.5 (- ,i (sqrt (+ (* 4.0 ,g) (* ,i ,i))))) `(* 0.5 (+ ,i (sqrt (+ (* 4.0 ,g) (* ,i ,i))))))] + + ;; Otherwise, return false(s). + [else (list #f #f #f)]))) + +;; Determine whether an expression is non-zero. +(define (is-non-zero expr parameters) + (match expr + ;; A non-zero number is, trivially, non-zero. + [(? (lambda (arg) + (and (number? arg) (not (equal? arg 0)) (not (equal? arg 0.0))))) #t] + + ;; Simulation parameters that are non-zero are, trivially, non-zero. + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (and (equal? arg (list-ref parameter 1)) + (or (not (equal? (list-ref parameter 2) 0)) + (not (equal? (list-ref parameter 2) 0.0))))) parameters)))) #t] + + ;; The product of two non-zero numbers is always non-zero. + [`(* ,x ,y) (and (is-non-zero x parameters) (is-non-zero y parameters))] + + ;; Otherwise, assume false. + [else #f])) + +;; Recursively determine whether two expressions are distinct. +(define (are-distinct expr parameters) + (match expr + ;; Two numbers that are unequal are, trivially, distinct. + [(? (lambda (arg) + (and (number? (list-ref arg 0)) (number? (list-ref arg 1)) (not (equal? (list-ref arg 0) (list-ref arg 1)))))) #t] + + ;; Expressions of the form (expr, -expr) or (-expr, expr) are distinct, so long as expr is non-zero. + [`(,x (* -1 ,x)) (is-non-zero x parameters)] + [`(,x (* -1.0 ,x)) (is-non-zero x parameters)] + [`((* -1 ,x) ,x) (is-non-zero x parameters)] + [`((* -1.0 ,x) ,x) (is-non-zero x parameters)] + + ;; Expressions of the form ((x + y), (x - y)) or ((x - y), (x + y)) are distinct, so long as y is non-zero. + [`((+ ,x ,y) (- ,x ,y)) (is-non-zero y parameters)] + [`((- ,x ,y) (+ ,x ,y)) (is-non-zero y parameters)] + + ;; Expressions of the form (x, (x - y)) or (x, (x + y)) are distinct, so long as y is non-zero. + [`(,x (- ,x ,y)) (is-non-zero y parameters)] + [`(,x (+ ,x ,y)) (is-non-zero y parameters)] + + ;; Expressions of the form ((x - y), x) or ((x + y), x) are distinct, so long as y is non-zero. + [`((- ,x ,y) ,x) (is-non-zero y parameters)] + [`((+ ,x ,y) ,x) (is-non-zero y parameters)] + + ;; Otherwise, assume false. + [else #f])) + +;; Compute the symbolic Roe matrix (averaged flux Jacobian). +(define (symbolic-roe-matrix flux-jacobian cons-exprs) + (map (lambda (row) + (map (lambda (column) + (symbolic-simp `(+ (* 0.5 ,(flux-deriv-replace (flux-deriv-replace column (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")))) + (* 0.5 ,(flux-deriv-replace (flux-deriv-replace column (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))))) + row)) + flux-jacobian)) + +;; Determine whether an expression is non-negative. +(define (is-non-negative expr parameters) + (match expr + ;; A non-negative number is, trivially, non-negative. + [(? (lambda (arg) + (and (number? arg) (or (>= arg 0) (>= arg 0.0))))) #t] + + ;; Simulation parameters that are non-negative are, trivially, non-negative. + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (and (equal? arg (list-ref parameter 1)) + (or (>= (list-ref parameter 2) 0) + (>= (list-ref parameter 2) 0.0)))) parameters)))) #t] + + ;; The sum, product, or quotient of two non-negative numbers is always non-negative. + [`(+ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] + [`(* ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] + [`(/ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] + + ;; Otherwise, assume false. + [else #f])) + +;; ------------------------------------------------------------------------------------------------------------- +;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + + (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define flux-eigvals-simp (list + (symbolic-simp (list-ref flux-eigvals 0)) + (symbolic-simp (list-ref flux-eigvals 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the flux Jacobian are all real (otherwise, return false). + [(or (not (is-real (list-ref flux-eigvals-simp 0) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp 1) cons-exprs parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + + out) +(trace prove-lax-friedrichs-vector2-1d-hyperbolicity) + +;; -------------------------------------------------------------------------------------------------------------------- +;; Prove strict hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; -------------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Lax-Friedrichs finite-difference method preserves strict hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + (trace is-non-zero) + (trace are-distinct) + + (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define flux-eigvals-simp (list + (symbolic-simp (list-ref flux-eigvals 0)) + (symbolic-simp (list-ref flux-eigvals 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the flux Jacobian are all real (otherwise, return false). + [(or (not (is-real (list-ref flux-eigvals-simp 0) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the flux Jacobian are all distinct (otherwise, return false). + [(not (are-distinct flux-eigvals-simp parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + (untrace is-non-zero) + (untrace are-distinct) + + out) +(trace prove-lax-friedrichs-vector2-1d-strict-hyperbolicity) + +;; ------------------------------------------------------------------------------------------------------------- +;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + + (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define max-speed-exprs-simp (list + (symbolic-simp (list-ref max-speed-exprs 0)) + (symbolic-simp (list-ref max-speed-exprs 1)))) + (define flux-eigvals-simp (list + (symbolic-simp `(abs ,(list-ref flux-eigvals 0))) + (symbolic-simp `(abs ,(list-ref flux-eigvals 1))))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the absolute eigenvalues of the flux Jacobian are symbolically equivalent to the maximum wave-speed estimates (otherwise, return false). + [(or (equal? (member (list-ref flux-eigvals-simp 0) max-speed-exprs-simp) #f) + (equal? (member (list-ref flux-eigvals-simp 1) max-speed-exprs-simp) #f)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + + out) +(trace prove-lax-friedrichs-vector2-1d-cfl-stability) + +;; --------------------------------------------------------------------------------------------------------------------------------------------------------- +;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs +;; --------------------------------------------------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + (trace symbolic-gradient) + (trace symbolic-hessian) + (trace is-non-negative) + + (define hessian-mats (list + (symbolic-hessian (list-ref flux-exprs 0) cons-exprs) + (symbolic-hessian (list-ref flux-exprs 1) cons-exprs))) + (define hessian-eigvals (list + (symbolic-eigvals2 (list-ref hessian-mats 0)) + (symbolic-eigvals2 (list-ref hessian-mats 1)))) + (define hessian-eigvals-simp (list + (symbolic-simp (list-ref (list-ref hessian-eigvals 0) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals 0) 1)) + (symbolic-simp (list-ref (list-ref hessian-eigvals 1) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals 1) 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the flux function is convex, i.e. that the Hessian matrix for each flux component is positive semidefinite (otherwise, return false). + [(or (not (is-non-negative (list-ref hessian-eigvals-simp 0) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp 1) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp 2) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp 3) parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + (untrace symbolic-gradient) + (untrace symbolic-hessian) + (untrace is-non-negative) + + out) +(trace prove-lax-friedrichs-vector2-1d-local-lipschitz) + +;; ------------------------------------------------------------------------------------------------------------- +;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs +;; ------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector3-2d-hyperbolicity pde-system + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals3) + + (define flux-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) + (define flux-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) + (define flux-eigvals-simp-x (list + (symbolic-simp (list-ref flux-eigvals-x 0)) + (symbolic-simp (list-ref flux-eigvals-x 1)) + (symbolic-simp (list-ref flux-eigvals-x 2)))) + (define flux-eigvals-simp-y (list + (symbolic-simp (list-ref flux-eigvals-y 0)) + (symbolic-simp (list-ref flux-eigvals-y 1)) + (symbolic-simp (list-ref flux-eigvals-y 2)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the flux Jacobians are all real (otherwise, return false). + [(or (not (is-real (list-ref flux-eigvals-simp-x 0) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp-x 1) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp-x 2) cons-exprs parameters))) #f] + [(or (not (is-real (list-ref flux-eigvals-simp-y 0) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp-y 1) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp-y 2) cons-exprs parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals3) + + out) +(trace prove-lax-friedrichs-vector3-2d-hyperbolicity) + +;; -------------------------------------------------------------------------------------------------------------------- +;; Prove strict hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs +;; -------------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector3-2d-strict-hyperbolicity pde-system + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Prove that the Lax-Friedrichs finite-difference method preserves strict hyperbolicity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals3) + (trace is-non-zero) + (trace are-distinct) + + (define flux-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) + (define flux-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) + (define flux-eigvals-simp-x (list + (symbolic-simp (list-ref flux-eigvals-x 0)) + (symbolic-simp (list-ref flux-eigvals-x 1)) + (symbolic-simp (list-ref flux-eigvals-x 2)))) + (define flux-eigvals-simp-y (list + (symbolic-simp (list-ref flux-eigvals-y 0)) + (symbolic-simp (list-ref flux-eigvals-y 1)) + (symbolic-simp (list-ref flux-eigvals-y 2)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the flux Jacobians are all real (otherwise, return false). + [(or (not (is-real (list-ref flux-eigvals-simp-x 0) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp-x 1) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp-x 2) cons-exprs parameters))) #f] + [(or (not (is-real (list-ref flux-eigvals-simp-y 0) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp-y 1) cons-exprs parameters)) + (not (is-real (list-ref flux-eigvals-simp-y 2) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the flux Jacobians are all distinct (otherwise, return false). + [(not (are-distinct (list (list-ref flux-eigvals-simp-x 0) (list-ref flux-eigvals-simp-x 1)) parameters)) #f] + [(not (are-distinct (list (list-ref flux-eigvals-simp-x 0) (list-ref flux-eigvals-simp-x 2)) parameters)) #f] + [(not (are-distinct (list (list-ref flux-eigvals-simp-x 1) (list-ref flux-eigvals-simp-x 2)) parameters)) #f] + [(not (are-distinct (list (list-ref flux-eigvals-simp-y 0) (list-ref flux-eigvals-simp-y 1)) parameters)) #f] + [(not (are-distinct (list (list-ref flux-eigvals-simp-y 0) (list-ref flux-eigvals-simp-y 2)) parameters)) #f] + [(not (are-distinct (list (list-ref flux-eigvals-simp-y 1) (list-ref flux-eigvals-simp-y 2)) parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals3) + (untrace is-non-zero) + (untrace are-distinct) + + out) +(trace prove-lax-friedrichs-vector3-2d-strict-hyperbolicity) + +;; ------------------------------------------------------------------------------------------------------------- +;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs +;; ------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector3-2d-cfl-stability pde-system + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 2D coupled vector system of 3 PDEs specified by `pde-system`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals3) + + (define flux-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) + (define flux-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) + (define max-speed-exprs-simp-x (list + (symbolic-simp (list-ref max-speed-exprs-x 0)) + (symbolic-simp (list-ref max-speed-exprs-x 1)) + (symbolic-simp (list-ref max-speed-exprs-x 2)))) + (define max-speed-exprs-simp-y (list + (symbolic-simp (list-ref max-speed-exprs-y 0)) + (symbolic-simp (list-ref max-speed-exprs-y 1)) + (symbolic-simp (list-ref max-speed-exprs-y 2)))) + (define flux-eigvals-simp-x (list + (symbolic-simp `(abs ,(list-ref flux-eigvals-x 0))) + (symbolic-simp `(abs ,(list-ref flux-eigvals-x 1))) + (symbolic-simp `(abs ,(list-ref flux-eigvals-x 2))))) + (define flux-eigvals-simp-y (list + (symbolic-simp `(abs ,(list-ref flux-eigvals-y 0))) + (symbolic-simp `(abs ,(list-ref flux-eigvals-y 1))) + (symbolic-simp `(abs ,(list-ref flux-eigvals-y 2))))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the absolute eigenvalues of the flux Jacobians are symbolically equivalent to the maximum wave-speed estimates (otherwise, return false). + [(or (equal? (member (list-ref flux-eigvals-simp-x 0) max-speed-exprs-simp-x) #f) + (equal? (member (list-ref flux-eigvals-simp-x 1) max-speed-exprs-simp-x) #f) + (equal? (member (list-ref flux-eigvals-simp-x 2) max-speed-exprs-simp-x) #f)) #f] + [(or (equal? (member (list-ref flux-eigvals-simp-y 0) max-speed-exprs-simp-y) #f) + (equal? (member (list-ref flux-eigvals-simp-y 1) max-speed-exprs-simp-y) #f) + (equal? (member (list-ref flux-eigvals-simp-y 2) max-speed-exprs-simp-y) #f)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals3) + + out) +(trace prove-lax-friedrichs-vector3-2d-cfl-stability) + +;; --------------------------------------------------------------------------------------------------------------------------------------------------------- +;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 2D Coupled Vector System of 3 PDEs +;; --------------------------------------------------------------------------------------------------------------------------------------------------------- +(define (prove-lax-friedrichs-vector3-2d-local-lipschitz pde-system + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals3) + (trace symbolic-gradient) + (trace symbolic-hessian) + (trace is-non-negative) + + (define hessian-mats-x (list + (symbolic-hessian (list-ref flux-exprs-x 0) cons-exprs) + (symbolic-hessian (list-ref flux-exprs-x 1) cons-exprs) + (symbolic-hessian (list-ref flux-exprs-x 2) cons-exprs))) + (define hessian-mats-y (list + (symbolic-hessian (list-ref flux-exprs-y 0) cons-exprs) + (symbolic-hessian (list-ref flux-exprs-y 1) cons-exprs) + (symbolic-hessian (list-ref flux-exprs-y 2) cons-exprs))) + (define hessian-eigvals-x (list + (symbolic-eigvals3 (list-ref hessian-mats-x 0)) + (symbolic-eigvals3 (list-ref hessian-mats-x 1)) + (symbolic-eigvals3 (list-ref hessian-mats-x 2)))) + (define hessian-eigvals-y (list + (symbolic-eigvals3 (list-ref hessian-mats-y 0)) + (symbolic-eigvals3 (list-ref hessian-mats-y 1)) + (symbolic-eigvals3 (list-ref hessian-mats-y 2)))) + (define hessian-eigvals-simp-x (list + (symbolic-simp (list-ref (list-ref hessian-eigvals-x 0) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-x 0) 1)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-x 0) 2)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-x 1) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-x 1) 1)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-x 1) 2)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-x 2) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-x 2) 1)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-x 2) 2)))) + (define hessian-eigvals-simp-y (list + (symbolic-simp (list-ref (list-ref hessian-eigvals-y 0) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-y 0) 1)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-y 0) 2)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-y 1) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-y 1) 1)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-y 1) 2)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-y 2) 0)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-y 2) 1)) + (symbolic-simp (list-ref (list-ref hessian-eigvals-y 2) 2)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the flux functions are convex, i.e. that the Hessian matrices for each flux component are positive semidefinite (otherwise, return false). + [(or (not (is-non-negative (list-ref hessian-eigvals-simp-x 0) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-x 1) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp-x 2) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-x 3) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp-x 4) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-x 5) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp-x 6) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-x 7) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp-x 8) parameters))) #f] + [(or (not (is-non-negative (list-ref hessian-eigvals-simp-y 0) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-y 1) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp-y 2) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-y 3) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp-y 4) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-y 5) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp-y 6) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp-y 7) parameters)) + (not (is-non-negative (list-ref hessian-eigvals-simp-y 8) parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals3) + (untrace symbolic-gradient) + (untrace symbolic-hessian) + (untrace is-non-negative) + + out) +(trace prove-lax-friedrichs-vector3-2d-local-lipschitz) + +;; ---------------------------------------------------------------------------------------------- +;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; ---------------------------------------------------------------------------------------------- +(define (prove-roe-vector2-1d-hyperbolicity pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Roe finite-volume method preserves hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + (trace symbolic-roe-matrix) + (trace flux-deriv-replace) + + (define roe-matrix-eigvals (symbolic-eigvals2 (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs))) + (define roe-matrix-eigvals-simp (list + (symbolic-simp (list-ref roe-matrix-eigvals 0)) + (symbolic-simp (list-ref roe-matrix-eigvals 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the Roe matrix are all real (otherwise, return false). + [(or (not (is-real (list-ref roe-matrix-eigvals-simp 0) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters)) + (not (is-real (list-ref roe-matrix-eigvals-simp 1) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + (untrace symbolic-roe-matrix) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-vector2-1d-hyperbolicity) + +;; ----------------------------------------------------------------------------------------------------- +;; Prove strict hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; ----------------------------------------------------------------------------------------------------- +(define (prove-roe-vector2-1d-strict-hyperbolicity pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Roe finite-volume method preserves strict hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals2) + (trace symbolic-roe-matrix) + (trace flux-deriv-replace) + (trace is-non-zero) + (trace are-distinct) + + (define roe-matrix-eigvals (symbolic-eigvals2 (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs))) + (define roe-matrix-eigvals-simp (list + (symbolic-simp (list-ref roe-matrix-eigvals 0)) + (symbolic-simp (list-ref roe-matrix-eigvals 1)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the Roe matrix are all real (otherwise, return false). + [(or (not (is-real (list-ref roe-matrix-eigvals-simp 0) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters)) + (not (is-real (list-ref roe-matrix-eigvals-simp 1) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters))) #f] + + ;; Check whether the eigenvalues of the Roe matrix are all distinct (otherwise, return false). + [(not (are-distinct roe-matrix-eigvals-simp parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals2) + (untrace symbolic-roe-matrix) + (untrace flux-deriv-replace) + (untrace is-non-zero) + (untrace are-distinct) + + out) +(trace prove-roe-vector2-1d-strict-hyperbolicity) + +;; -------------------------------------------------------------------------------------------------------------------- +;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs +;; -------------------------------------------------------------------------------------------------------------------- +(define (prove-roe-vector2-1d-flux-conservation pde-system + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 1D coupled vector system of 2 PDEs specified by `pde-system`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-roe-matrix) + (trace flux-deriv-replace) + + (define roe-matrix (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs)) + (define cons-jump (list (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")))) + (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")))))) + + (define roe-jump (list (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix 0) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix 0) 1) ,(list-ref cons-jump 1)))) + (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix 1) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix 1) 1) ,(list-ref cons-jump 1)))))) + (define flux-jump (list (symbolic-simp `(- ,(flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs 0) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + ,(flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs 0) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))) + (symbolic-simp `(- ,(flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs 1) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + ,(flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs 1) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the jump in the flux vector is equal to the product of the Roe matrix and the jump in the conserved variable vector (otherwise, return false). + [(or (not (equal? (list-ref roe-jump 0) (list-ref flux-jump 0))) + (not (equal? (list-ref roe-jump 1) (list-ref flux-jump 1)))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-roe-matrix) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-vector2-1d-flux-conservation) + +;; ---------------------------------------------------------------------------------------------- +;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs +;; ---------------------------------------------------------------------------------------------- +(define (prove-roe-vector3-2d-hyperbolicity pde-system + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Prove that the Roe finite-volume method preserves hyperbolicity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals3) + (trace symbolic-roe-matrix) + (trace flux-deriv-replace) + + (define roe-matrix-eigvals-x (symbolic-eigvals3 (symbolic-roe-matrix (symbolic-jacobian flux-exprs-x cons-exprs) cons-exprs))) + (define roe-matrix-eigvals-y (symbolic-eigvals3 (symbolic-roe-matrix (symbolic-jacobian flux-exprs-y cons-exprs) cons-exprs))) + (define roe-matrix-eigvals-simp-x (list + (symbolic-simp (list-ref roe-matrix-eigvals-x 0)) + (symbolic-simp (list-ref roe-matrix-eigvals-x 1)) + (symbolic-simp (list-ref roe-matrix-eigvals-x 2)))) + (define roe-matrix-eigvals-simp-y (list + (symbolic-simp (list-ref roe-matrix-eigvals-y 0)) + (symbolic-simp (list-ref roe-matrix-eigvals-y 1)) + (symbolic-simp (list-ref roe-matrix-eigvals-y 2)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the Roe matrices are all real (otherwise, return false). + [(or (not (is-real (list-ref roe-matrix-eigvals-simp-x 0) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters)) + (not (is-real (list-ref roe-matrix-eigvals-simp-x 1) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters))) #f] + [(or (not (is-real (list-ref roe-matrix-eigvals-simp-y 0) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters)) + (not (is-real (list-ref roe-matrix-eigvals-simp-y 1) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals3) + (untrace symbolic-roe-matrix) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-vector3-2d-hyperbolicity) + +;; ----------------------------------------------------------------------------------------------------- +;; Prove strict hyperbolicity of the Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs +;; ----------------------------------------------------------------------------------------------------- +(define (prove-roe-vector3-2d-strict-hyperbolicity pde-system + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Prove that the Roe finite-volume method preserves strict hyperbolicity for the 2D coupled vector system of 3 PDEs specified by `pde-system`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-eigvals3) + (trace symbolic-roe-matrix) + (trace flux-deriv-replace) + (trace is-non-zero) + (trace are-distinct) + + (define roe-matrix-eigvals-x (symbolic-eigvals3 (symbolic-roe-matrix (symbolic-jacobian flux-exprs-x cons-exprs) cons-exprs))) + (define roe-matrix-eigvals-y (symbolic-eigvals3 (symbolic-roe-matrix (symbolic-jacobian flux-exprs-y cons-exprs) cons-exprs))) + (define roe-matrix-eigvals-simp-x (list + (symbolic-simp (list-ref roe-matrix-eigvals-x 0)) + (symbolic-simp (list-ref roe-matrix-eigvals-x 1)) + (symbolic-simp (list-ref roe-matrix-eigvals-x 2)))) + (define roe-matrix-eigvals-simp-y (list + (symbolic-simp (list-ref roe-matrix-eigvals-y 0)) + (symbolic-simp (list-ref roe-matrix-eigvals-y 1)) + (symbolic-simp (list-ref roe-matrix-eigvals-y 2)))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the eigenvalues of the Roe matrices are all real (otherwise, return false). + [(or (not (is-real (list-ref roe-matrix-eigvals-simp-x 0) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters)) + (not (is-real (list-ref roe-matrix-eigvals-simp-x 1) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters))) #f] + [(or (not (is-real (list-ref roe-matrix-eigvals-simp-y 0) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters)) + (not (is-real (list-ref roe-matrix-eigvals-simp-y 1) (list + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))) parameters))) #f] + + ;; Check whether the eigenvalues of the Roe matrices are all distinct (otherwise, return false). + [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-x 0) (list-ref roe-matrix-eigvals-simp-x 1)) parameters)) #f] + [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-x 0) (list-ref roe-matrix-eigvals-simp-x 2)) parameters)) #f] + [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-x 1) (list-ref roe-matrix-eigvals-simp-x 2)) parameters)) #f] + [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-y 0) (list-ref roe-matrix-eigvals-simp-y 1)) parameters)) #f] + [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-y 0) (list-ref roe-matrix-eigvals-simp-y 2)) parameters)) #f] + [(not (are-distinct (list (list-ref roe-matrix-eigvals-simp-y 1) (list-ref roe-matrix-eigvals-simp-y 2)) parameters)) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-eigvals3) + (untrace symbolic-roe-matrix) + (untrace flux-deriv-replace) + (untrace is-non-zero) + (untrace are-distinct) + + out) +(trace prove-roe-vector3-2d-strict-hyperbolicity) + +;; -------------------------------------------------------------------------------------------------------------------- +;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 2D Coupled Vector System of 3 PDEs +;; -------------------------------------------------------------------------------------------------------------------- +(define (prove-roe-vector3-2d-flux-conservation pde-system + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 2D coupled vector system of 3 PDEs specified by `pde-system`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-jacobian) + (trace symbolic-roe-matrix) + (trace flux-deriv-replace) + + (define roe-matrix-x (symbolic-roe-matrix (symbolic-jacobian flux-exprs-x cons-exprs) cons-exprs)) + (define roe-matrix-y (symbolic-roe-matrix (symbolic-jacobian flux-exprs-y cons-exprs) cons-exprs)) + (define cons-jump (list (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) + ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")))) + (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) + ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")))) + (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L")) + ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R")))))) + + (define roe-jump-x (list (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-x 0) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix-x 0) 1) ,(list-ref cons-jump 1)) + (* ,(list-ref (list-ref roe-matrix-x 0) 2) ,(list-ref cons-jump 2)))) + (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-x 1) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix-x 1) 1) ,(list-ref cons-jump 1)) + (* ,(list-ref (list-ref roe-matrix-x 1) 2) ,(list-ref cons-jump 1)))) + (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-x 2) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix-x 2) 1) ,(list-ref cons-jump 1)) + (* ,(list-ref (list-ref roe-matrix-x 2) 2) ,(list-ref cons-jump 1)))))) + (define roe-jump-y (list (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-y 0) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix-y 0) 1) ,(list-ref cons-jump 1)) + (* ,(list-ref (list-ref roe-matrix-y 0) 2) ,(list-ref cons-jump 2)))) + (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-y 1) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix-y 1) 1) ,(list-ref cons-jump 1)) + (* ,(list-ref (list-ref roe-matrix-y 1) 2) ,(list-ref cons-jump 1)))) + (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix-y 2) 0) ,(list-ref cons-jump 0)) + (* ,(list-ref (list-ref roe-matrix-y 2) 1) ,(list-ref cons-jump 1)) + (* ,(list-ref (list-ref roe-matrix-y 2) 2) ,(list-ref cons-jump 1)))))) + (define flux-jump-x (list (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-x 0) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) + ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-x 0) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))) + (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-x 1) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) + ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-x 1) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))) + (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-x 2) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) + ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-x 2) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))))) + (define flux-jump-y (list (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-y 0) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) + ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-y 0) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))) + (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-y 1) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) + ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-y 1) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))) + (symbolic-simp `(- ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-y 2) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "L"))) + ,(flux-deriv-replace (flux-deriv-replace + (flux-deriv-replace (list-ref flux-exprs-y 2) (list-ref cons-exprs 0) + (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) + (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) + (list-ref cons-exprs 2) (string->symbol (string-append (symbol->string (list-ref cons-exprs 2)) "R"))))))) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the jumps in the flux vectors are equal to the products of the Roe matrices and the jumps in the conserved variable vector (otherwise, return false). + [(or (not (equal? (list-ref roe-jump-x 0) (list-ref flux-jump-x 0))) + (not (equal? (list-ref roe-jump-x 1) (list-ref flux-jump-x 1))) + (not (equal? (list-ref roe-jump-x 2) (list-ref flux-jump-x 2)))) #f] + [(or (not (equal? (list-ref roe-jump-y 0) (list-ref flux-jump-y 0))) + (not (equal? (list-ref roe-jump-y 1) (list-ref flux-jump-y 1))) + (not (equal? (list-ref roe-jump-y 2) (list-ref flux-jump-y 2)))) #f] + + ;; Otherwise, return true. + [else #t])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-jacobian) + (untrace symbolic-roe-matrix) + (untrace flux-deriv-replace) + + out) +(trace prove-roe-vector3-2d-flux-conservation) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_inviscid_burgers.rkt b/provable-algorithms/finite_volume/test_inviscid_burgers.rkt new file mode 100644 index 00000000..325a8663 --- /dev/null +++ b/provable-algorithms/finite_volume/test_inviscid_burgers.rkt @@ -0,0 +1,448 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "code_generator_core_2d.rkt") +(require "prover_core.rkt") +(provide (all-from-out "code_generator_core.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D inviscid Burgers' equation: du/dt + u du/dx = 0. +(define pde-inviscid-burgers + (hash + 'name "inviscid-burgers" + 'cons-expr `u ; conserved variable: u + 'flux-expr `(* 0.5 u u) ; flux function: f(u) = 0.5 * u^2 + 'max-speed-expr `(abs u) ; local wave-speed: alpha = |u| + 'parameters `() + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.0) +(define x1 1.0) +(define t-final 0.5) +(define cfl 0.95) +(define init-func `(cond + [(< x 0.0) 1.0] + [else 0.0])) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-lax + (generate-lax-friedrichs-scalar-1d pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax))) + +(display "1D Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-hyperbolicity + (call-with-output-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-inviscid-burgers-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-cfl-stability + (call-with-output-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-cfl-stability pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-inviscid-burgers-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-local-lipschitz + (call-with-output-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-inviscid-burgers-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D inviscid Burgers' equation. +(define code-inviscid-burgers-roe + (generate-roe-scalar-1d pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe))) + +(display "1D Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-roe-hyperbolicity + (call-with-output-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-hyperbolicity pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-inviscid-burgers-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-roe-flux-conservation + (call-with-output-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-flux-conservation pde-inviscid-burgers + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-inviscid-burgers-roe-flux-conservation) +(display "\n\n\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-inviscid-burgers-lax-minmod + (generate-lax-friedrichs-scalar-1d-second-order pde-inviscid-burgers limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-inviscid-burgers-roe-minmod + (generate-roe-scalar-1d-second-order pde-inviscid-burgers limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-minmod))) + +;; Define the 2D inviscid Burgers' equation: du/dt + u du/dx + u du/dy = 0. +(define pde-inviscid-burgers-2d + (hash + 'name "burgers-2d" + 'cons-expr `u ; conserved variable: u + 'flux-expr-x `(* 0.5 u u) ; x-flux function: f(u) = 0.5 * u^2 + 'flux-expr-y `(* 0.5 u u) ; y-flux function: f(u) = 0.5 * u^2 + 'max-speed-expr-x `(abs u) ; local wave-speed: alpha_x = |u| + 'max-speed-expr-y `(abs u) ; local wave-speed: alpha_y = |u| + 'parameters `() + )) + +;; Define 2D simulation parameters. +(define nx-2d 100) +(define ny-2d 100) +(define x0-2d 0.0) +(define x1-2d 2.0) +(define y0-2d 0.0) +(define y1-2d 2.0) +(define t-final-2d 0.5) +(define cfl-2d 0.95) +(define init-func-2d `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 2.0] + [else 0.0])) + +;; Synthesize the code for a Lax-Friedrichs solver for the 2D inviscid Burgers' equation. +(define code-inviscid-burgers-lax-2d + (generate-lax-friedrichs-scalar-2d pde-inviscid-burgers-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-2d))) + +(display "2D Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 2D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-hyperbolicity-2d + (call-with-output-file "proofs/proof_inviscid_burgers_lax_hyperbolicity_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-2d-hyperbolicity pde-inviscid-burgers-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_hyperbolicity_2d.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-inviscid-burgers-lax-hyperbolicity-2d) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 2D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-cfl-stability-2d + (call-with-output-file "proofs/proof_inviscid_burgers_lax_cfl_stability_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-2d-cfl-stability pde-inviscid-burgers-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_cfl_stability_2d.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-inviscid-burgers-lax-cfl-stability-2d) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 2D inviscid Burgers' equation. +(define proof-inviscid-burgers-lax-local-lipschitz-2d + (call-with-output-file "proofs/proof_inviscid_burgers_lax_local_lipschitz_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-2d-local-lipschitz pde-inviscid-burgers-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_local_lipschitz_2d.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-inviscid-burgers-lax-local-lipschitz-2d) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 2D inviscid Burgers' equation. +(define code-inviscid-burgers-roe-2d + (generate-roe-scalar-2d pde-inviscid-burgers-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-2d))) + +(display "2D Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 2D inviscid Burgers' equation. +(define proof-inviscid-burgers-roe-hyperbolicity-2d + (call-with-output-file "proofs/proof_inviscid_burgers_roe_hyperbolicity_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-2d-hyperbolicity pde-inviscid-burgers-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_hyperbolicity_2d.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-inviscid-burgers-roe-hyperbolicity-2d) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 2D inviscid Burgers' equation. +(define proof-inviscid-burgers-roe-flux-conservation-2d + (call-with-output-file "proofs/proof_inviscid_burgers_roe_flux_conservation_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-2d-flux-conservation pde-inviscid-burgers-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_flux_conservation_2d.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-inviscid-burgers-roe-flux-conservation-2d) +(display "\n") + +;; Synthesize the code for a Lax-Friedrichs solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-inviscid-burgers-lax-minmod-2d + (generate-lax-friedrichs-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax_minmod_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-minmod-2d))) + +;; Synthesize the code for a Roe solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-inviscid-burgers-roe-minmod-2d + (generate-roe-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe_minmod_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-minmod-2d))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_isothermal_euler_2d.rkt b/provable-algorithms/finite_volume/test_isothermal_euler_2d.rkt new file mode 100644 index 00000000..2340836f --- /dev/null +++ b/provable-algorithms/finite_volume/test_isothermal_euler_2d.rkt @@ -0,0 +1,350 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "code_generator_vector_2d.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "code_generator_core.rkt")) +(provide (all-from-out "code_generator_vector_2d.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 2D isothermal Euler equations (density, x-momentum and y-momentum components). +(define pde-system-isothermal-euler-2d + (hash + 'name "isothermal-euler-2d" + 'cons-exprs (list + `rho + `mom_x + `mom_y) ; conserved variables: density, x-momentum, y-momentum + 'flux-exprs-x (list + `mom_x + `(+ (/ (* mom_x mom_x) rho) (* rho vt vt)) + `(* mom_y (/ mom_x rho))) ; x-flux vector + 'flux-exprs-y (list + `mom_y + `(* mom_x (/ mom_y rho)) + `(+ (/ (* mom_y mom_y) rho) (* rho vt vt))) ; y-flux vector + 'max-speed-exprs-x (list + `(abs (- (/ mom_x rho) vt)) + `(abs (/ mom_x rho)) + `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds (x-direction) + 'max-speed-exprs-y (list + `(abs (- (/ mom_y rho) vt)) + `(abs (/ mom_y rho)) + `(abs (+ (/ mom_y rho) vt))) ; local wave-speeds (y-direction) + 'parameters (list + `(define vt 1.0)) ; thermal velocity: vt = 1.0 + )) + +;; Define 2D simulation parameters. +(define nx-2d 50) +(define ny-2d 50) +(define x0-2d 0.0) +(define x1-2d 2.0) +(define y0-2d 0.0) +(define y1-2d 2.0) +(define t-final-2d 0.2) +(define cfl-2d 0.9) +(define init-funcs-2d (list + `(cond + [(> y 1.0) + (cond + [(< x 1.0) 0.5323] + [else 1.5])] + [else + (cond + [(< x 1.0) 0.138] + [else 0.5323])]) + `(cond + [(> y 1.0) + (cond + [(< x 1.0) 1.206] + [else 0.0])] + [else + (cond + [(< x 1.0) 1.206] + [else 0.0])]) + `(cond + [(> y 1.0) + (cond + [(< x 1.0) 0.0] + [else 0.0])] + [else + (cond + [(< x 1.0) 1.206] + [else 1.206])]))) + +;; Synthesize the code for a Lax-Friedrichs solver for the 2D isothermal Euler equations. +(define code-isothermal-euler-lax-2d + (generate-lax-friedrichs-vector3-2d pde-system-isothermal-euler-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_lax_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-lax-2d))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 2D isothermal Euler equations. +(define proof-isothermal-euler-lax-hyperbolicity-2d + (call-with-output-file "proofs/proof_isothermal_euler_lax_hyperbolicity_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector3-2d-hyperbolicity pde-system-isothermal-euler-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_lax_hyperbolicity_2d.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-lax-hyperbolicity-2d) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 2D isothermal Euler equations. +(define proof-isothermal-euler-lax-strict-hyperbolicity-2d + (call-with-output-file "proofs/proof_isothermal_euler_lax_strict_hyperbolicity_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector3-2d-strict-hyperbolicity pde-system-isothermal-euler-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_lax_strict_hyperbolicity_2d.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-lax-strict-hyperbolicity-2d) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 2D isothermal Euler equations. +(define proof-isothermal-euler-lax-cfl-stability-2d + (call-with-output-file "proofs/proof_isothermal_euler_lax_cfl_stability_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector3-2d-cfl-stability pde-system-isothermal-euler-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_lax_cfl_stability_2d.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-isothermal-euler-lax-cfl-stability-2d) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 2D isothermal Euler equations. +(define proof-isothermal-euler-lax-local-lipschitz-2d + (call-with-output-file "proofs/proof_isothermal_euler_lax_local_lipschitz_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector3-2d-local-lipschitz pde-system-isothermal-euler-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_lax_local_lipschitz_2d.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-isothermal-euler-lax-local-lipschitz-2d) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 2D isothermal Euler equations. +(define code-isothermal-euler-roe-2d + (generate-roe-vector3-2d pde-system-isothermal-euler-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_roe_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-roe-2d))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 2D isothermal Euler equations. +(define proof-isothermal-euler-roe-hyperbolicity-2d + (call-with-output-file "proofs/proof_isothermal_euler_roe_hyperbolicity_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector3-2d-hyperbolicity pde-system-isothermal-euler-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_roe_hyperbolicity_2d.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-roe-hyperbolicity-2d) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 2D isothermal Euler equations. +(define proof-isothermal-euler-roe-strict-hyperbolicity-2d + (call-with-output-file "proofs/proof_isothermal_euler_roe_strict_hyperbolicity_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector3-2d-strict-hyperbolicity pde-system-isothermal-euler-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_roe_strict_hyperbolicity_2d.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-roe-strict-hyperbolicity-2d) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 2D isothermal Euler equations. +(define proof-isothermal-euler-roe-flux-conservation-2d + (call-with-output-file "proofs/proof_isothermal_euler_roe_flux_conservation_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector3-2d-flux-conservation pde-system-isothermal-euler-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_roe_flux_conservation_2d.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-isothermal-euler-roe-flux-conservation-2d) +(display "\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter). +(define code-isothermal-euler-lax-minmod-2d + (generate-lax-friedrichs-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_lax_minmod_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-lax-minmod-2d))) + +;; Synthesize the code for a Roe solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter). +(define code-isothermal-euler-roe-minmod-2d + (generate-roe-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_roe_minmod_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-roe-minmod-2d))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_isothermal_euler_mom_x.rkt b/provable-algorithms/finite_volume/test_isothermal_euler_mom_x.rkt new file mode 100644 index 00000000..86ba4a90 --- /dev/null +++ b/provable-algorithms/finite_volume/test_isothermal_euler_mom_x.rkt @@ -0,0 +1,282 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "code_generator_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "code_generator_core.rkt")) +(provide (all-from-out "code_generator_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D isothermal Euler equations (density and x-momentum components). +(define pde-system-isothermal-euler-mom-x + (hash + 'name "isothermal-euler-mom-x" + 'cons-exprs (list + `rho + `mom_x) ; conserved variables: density, x-momentum + 'flux-exprs (list + `mom_x + `(+ (/ (* mom_x mom_x) rho) (* rho vt vt))) ; flux vector + 'max-speed-exprs (list + `(abs (- (/ mom_x rho) vt)) + `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds + 'parameters (list + `(define vt 1.0)) ; thermal velocity: vt = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 0.0) +(define x1 1.0) +(define t-final 0.1) +(define cfl 0.95) +(define init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-lax + (generate-lax-friedrichs-vector2-1d pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_mom_x_lax.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-lax))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-lax-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-x-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-x-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-lax-cfl-stability + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-isothermal-euler-mom-x-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-lax-local-lipschitz + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-isothermal-euler-mom-x-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define code-isothermal-euler-mom-x-roe + (generate-roe-vector2-1d pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_mom_x_roe.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-roe))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-roe-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-x-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-x-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). +(define proof-isothermal-euler-mom-x-roe-flux-conservation + (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-isothermal-euler-mom-x + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-isothermal-euler-mom-x-roe-flux-conservation) +(display "\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-isothermal-euler-mom-x-lax-minmod + (generate-lax-friedrichs-vector2-1d-second-order pde-system-isothermal-euler-mom-x limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_mom_x_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-isothermal-euler-mom-x-roe-minmod + (generate-roe-vector2-1d-second-order pde-system-isothermal-euler-mom-x limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_mom_x_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-x-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_isothermal_euler_mom_yz.rkt b/provable-algorithms/finite_volume/test_isothermal_euler_mom_yz.rkt new file mode 100644 index 00000000..704bad70 --- /dev/null +++ b/provable-algorithms/finite_volume/test_isothermal_euler_mom_yz.rkt @@ -0,0 +1,276 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "code_generator_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "code_generator_core.rkt")) +(provide (all-from-out "code_generator_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D isothermal Euler equations (y- and z-momentum components). +(define pde-system-isothermal-euler-mom-yz + (hash + 'name "isothermal-euler-mom-yz" + 'cons-exprs (list + `mom_y + `mom_z) ; conserved variables: y-momentum, z-momentum + 'flux-exprs (list + `(* mom_y u) + `(* mom_z u)) ; flux vector + 'max-speed-exprs (list + `(abs u) + `(abs u)) ; local wave-speeds + 'parameters (list + `(define u 0.0)) ; advection velocity: 0.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 0.0) +(define x1 1.0) +(define t-final 0.1) +(define cfl 0.95) +(define init-funcs (list 0.0 0.0)) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-lax + (generate-lax-friedrichs-vector2-1d pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_mom_yz_lax.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-lax))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-lax-mom-yz-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-lax-mom-yz-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-yz-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-lax-cfl-stability + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-isothermal-euler-mom-yz-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-lax-local-lipschitz + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-isothermal-euler-mom-yz-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define code-isothermal-euler-mom-yz-roe + (generate-roe-vector2-1d pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_mom_yz_roe.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-roe))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-roe-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-yz-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-isothermal-euler-mom-yz-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). +(define proof-isothermal-euler-mom-yz-roe-flux-conservation + (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-isothermal-euler-mom-yz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-isothermal-euler-mom-yz-roe-flux-conservation) +(display "\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-isothermal-euler-mom-yz-lax-minmod + (generate-lax-friedrichs-vector2-1d-second-order pde-system-isothermal-euler-mom-yz limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_mom_yz_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-isothermal-euler-mom-yz-roe-minmod + (generate-roe-vector2-1d-second-order pde-system-isothermal-euler-mom-yz limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_mom_yz_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-mom-yz-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_limiters.rkt b/provable-algorithms/finite_volume/test_limiters.rkt new file mode 100644 index 00000000..b125f8b8 --- /dev/null +++ b/provable-algorithms/finite_volume/test_limiters.rkt @@ -0,0 +1,177 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "prover_core.rkt") +(provide (all-from-out "code_generator_core.rkt")) + +;; Construct /proofs output directory if it does not already exist. +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +(display "Minmod flux limiter properties: \n\n") + +;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the minmod flux limiter. +(define proof-limiter-minmod-symmetry + (call-with-output-file "proofs/proof_limiter_minmod_symmetry.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-symmetry limiter-minmod))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_minmod_symmetry.rkt") + +;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. +(display "Symmetric (equivalent action on forward and backward gradients): ") +(display proof-limiter-minmod-symmetry) +(display "\n") + +;; Attempt to prove second-order TVD (total variation diminishing) of the minmod flux limiter. +(define proof-limiter-minmod-tvd + (call-with-output-file "proofs/proof_limiter_minmod_tvd.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-tvd limiter-minmod))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_minmod_tvd.rkt") + +;; Show whether the second-order TVD (total variation diminishing) property is satisfied. +(display "Second-order TVD (total variation diminishing): ") +(display proof-limiter-minmod-tvd) +(display "\n\n\n") + +;; Define the superbee flux limiter. +(define limiter-superbee + (hash + 'name "superbee" + 'limiter-expr `(max 0.0 (min (* 2.0 r) 1.0) (min r 2.0)) + 'limiter-ratio `r + )) + +(display "Superbee flux limiter properties: \n\n") + +;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the superbee flux limiter. +(define proof-limiter-superbee-symmetry + (call-with-output-file "proofs/proof_limiter_superbee_symmetry.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-symmetry limiter-superbee))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_superbee_symmetry.rkt") + +;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. +(display "Symmetric (equivalent action on forward and backward gradients): ") +(display proof-limiter-superbee-symmetry) +(display "\n") + +;; Attempt to prove second-order TVD (total variation diminishing) of the superbee flux limiter. +(define proof-limiter-superbee-tvd + (call-with-output-file "proofs/proof_limiter_superbee_tvd.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-tvd limiter-superbee))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_superbee_tvd.rkt") + +;; Show whether the second-order TVD (total variation diminishing) property is satisfied. +(display "Second-order TVD (total variation diminishing): ") +(display proof-limiter-superbee-tvd) +(display "\n\n\n") + +;; Define the monotonized-centered flux limiter. +(define limiter-monotonized-centered + (hash + 'name "monotonized-centered" + 'limiter-expr `(max 0.0 (min (* 2.0 r) (/ (+ 1.0 r) 2.0) 2.0)) + 'limiter-ratio `r + )) + +(display "Monotonized-centered flux limiter properties: \n\n") + +;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the monotonized-centered flux limiter. +(define proof-limiter-monotonized-centered-symmetry + (call-with-output-file "proofs/proof_limiter_monotonized_centered_symmetry.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-symmetry limiter-monotonized-centered))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_monotonized_centered_symmetry.rkt") + +;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. +(display "Symmetric (equivalent action on forward and backward gradients): ") +(display proof-limiter-monotonized-centered-symmetry) +(display "\n") + +;; Attempt to prove second-order TVD (total variation diminishing) of the monotonized-centered flux limiter. +(define proof-limiter-monotonized-centered-tvd + (call-with-output-file "proofs/proof_limiter_monotonized_centered_tvd.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-tvd limiter-monotonized-centered))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_monotonized_centered_tvd.rkt") + +;; Show whether the second-order TVD (total variation diminishing) property is satisfied. +(display "Second-order TVD (total variation diminishing): ") +(display proof-limiter-monotonized-centered-tvd) +(display "\n\n\n") + +;; Define the van Leer flux limiter. +(define limiter-van-leer + (hash + 'name "van-leer" + 'limiter-expr `(/ (+ r (abs r)) (+ 1.0 (abs r))) + 'limiter-ratio `r + )) + +(display "Van Leer flux limiter properties: \n\n") + +;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the van Leer flux limiter. +(define proof-limiter-van-leer-symmetry + (call-with-output-file "proofs/proof_limiter_van_leer_symmetry.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-symmetry limiter-van-leer))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_van_leer_symmetry.rkt") + +;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. +(display "Symmetric (equivalent action on forward and backward gradients): ") +(display proof-limiter-van-leer-symmetry) +(display "\n") + +;; Attempt to prove second-order TVD (total variation diminishing) of the van Leer flux limiter. +(define proof-limiter-van-leer-tvd + (call-with-output-file "proofs/proof_limiter_van_leer_tvd.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-flux-limiter-tvd limiter-van-leer))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_limiter_van_leer_tvd.rkt") + +;; Show whether the second-order TVD (total variation diminishing) property is satisfied. +(display "Second-order TVD (total variation diminishing): ") +(display proof-limiter-van-leer-tvd) +(display "\n\n\n") \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_linear_advection.rkt b/provable-algorithms/finite_volume/test_linear_advection.rkt new file mode 100644 index 00000000..d5b892a8 --- /dev/null +++ b/provable-algorithms/finite_volume/test_linear_advection.rkt @@ -0,0 +1,451 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "code_generator_core_2d.rkt") +(require "prover_core.rkt") +(provide (all-from-out "code_generator_core.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D linear advection equation: du/dt + d(au)/dx = 0. +(define pde-linear-advection + (hash + 'name "linear-advection" + 'cons-expr `u ; conserved variable: u + 'flux-expr `(* a u) ; flux function: f(u) = a * u + 'max-speed-expr `(abs a) ; local wave-speed: alpha = |a| + 'parameters (list + `(define a 1.0)) ; advection speed: a = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 0.0) +(define x1 2.0) +(define t-final 0.5) +(define cfl 0.95) +(define init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D linear advection equation. +(define code-linear-advection-lax + (generate-lax-friedrichs-scalar-1d pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax))) + +(display "1D Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D linear advection equation. +(define proof-linear-advection-lax-hyperbolicity + (call-with-output-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-linear-advection-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D linear advection equation. +(define proof-linear-advection-lax-cfl-stability + (call-with-output-file "proofs/proof_linear_advection_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-cfl-stability pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-linear-advection-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D linear advection equation. +(define proof-linear-advection-lax-local-lipschitz + (call-with-output-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-linear-advection-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D linear advection equation. +(define code-linear-advection-roe + (generate-roe-scalar-1d pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe))) + +(display "1D Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D linear advection equation. +(define proof-linear-advection-roe-hyperbolicity + (call-with-output-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-hyperbolicity pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-linear-advection-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D linear advection equation. +(define proof-linear-advection-roe-flux-conservation + (call-with-output-file "proofs/proof_linear_advection_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-1d-flux-conservation pde-linear-advection + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-linear-advection-roe-flux-conservation) +(display "\n\n\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-linear-advection-lax-minmod + (generate-lax-friedrichs-scalar-1d-second-order pde-linear-advection limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-linear-advection-roe-minmod + (generate-roe-scalar-1d-second-order pde-linear-advection limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-minmod))) + +;; Define the 2D linear advection equation: du/dt + d(au)/dx + d(bu)/dy = 0. +(define pde-linear-advection-2d + (hash + 'name "linear-advection-2d" + 'cons-expr `u ; conserved variable: u + 'flux-expr-x `(* a u) ; x-flux function: f(u) = a * u + 'flux-expr-y `(* b u) ; y-flux function: f(u) = b * u + 'max-speed-expr-x `(abs a) ; local x wave-speed: alpha_x = |a| + 'max-speed-expr-y `(abs b) ; local y wave-speed: alpha_y = |b| + 'parameters (list + `(define a 1.0) + `(define b 1.0)) ; advection speesd: a = 1.0, b = 1.0 + )) + +;; Define 2D simulation parameters. +(define nx-2d 100) +(define ny-2d 100) +(define x0-2d 0.0) +(define x1-2d 2.0) +(define y0-2d 0.0) +(define y1-2d 2.0) +(define t-final-2d 0.5) +(define cfl-2d 0.95) +(define init-func-2d `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 1.0] + [else 0.0])) + +;; Synthesize the code for a Lax-Friedrichs solver for the 2D linear advection equation. +(define code-linear-advection-lax-2d + (generate-lax-friedrichs-scalar-2d pde-linear-advection-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-2d))) + +(display "2D Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 2D linear advection equation. +(define proof-linear-advection-lax-hyperbolicity-2d + (call-with-output-file "proofs/proof_linear_advection_lax_hyperbolicity_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-2d-hyperbolicity pde-linear-advection-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_hyperbolicity_2d.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-linear-advection-lax-hyperbolicity-2d) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 2D linear advection equation. +(define proof-linear-advection-lax-cfl-stability-2d + (call-with-output-file "proofs/proof_linear_advection_lax_cfl_stability_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-2d-cfl-stability pde-linear-advection-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_cfl_stability_2d.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-linear-advection-lax-cfl-stability-2d) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 2D linear advection equation. +(define proof-linear-advection-lax-local-lipschitz-2d + (call-with-output-file "proofs/proof_linear_advection_lax_local_lipschitz_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-lax-friedrichs-scalar-2d-local-lipschitz pde-linear-advection-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_local_lipschitz_2d.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-linear-advection-lax-local-lipschitz-2d) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 2D linear advection equation. +(define code-linear-advection-roe-2d + (generate-roe-scalar-2d pde-linear-advection-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-2d))) + +(display "2D Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 2D linear advection equation. +(define proof-linear-advection-roe-hyperbolicity-2d + (call-with-output-file "proofs/proof_linear_advection_roe_hyperbolicity_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-2d-hyperbolicity pde-linear-advection-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_hyperbolicity_2d.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-linear-advection-roe-hyperbolicity-2d) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 2D linear advection equation. +(define proof-linear-advection-roe-flux-conservation-2d + (call-with-output-file "proofs/proof_linear_advection_roe_flux_conservation_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n\n") + (prove-roe-scalar-2d-flux-conservation pde-linear-advection-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_flux_conservation_2d.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-linear-advection-roe-flux-conservation-2d) +(display "\n") + +;; Synthesize the code for a Lax-Friedrichs solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-linear-advection-lax-minmod-2d + (generate-lax-friedrichs-scalar-2d-second-order pde-linear-advection-2d limiter-minmod + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax_minmod_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-minmod-2d))) + +;; Synthesize the code for a Roe solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). +(define code-linear-advection-roe-minmod-2d + (generate-roe-scalar-2d-second-order pde-linear-advection-2d limiter-minmod + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe_minmod_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-minmod-2d))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_maxwell_1d_Bx_psi.rkt b/provable-algorithms/finite_volume/test_maxwell_1d_Bx_psi.rkt new file mode 100644 index 00000000..5c1f0fba --- /dev/null +++ b/provable-algorithms/finite_volume/test_maxwell_1d_Bx_psi.rkt @@ -0,0 +1,282 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "code_generator_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "code_generator_core.rkt")) +(provide (all-from-out "code_generator_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D Maxwell equations (Bx and psi components). +(define pde-system-maxwell-1d-Bx-psi + (hash + 'name "maxwell-1d-Bx-psi" + 'cons-exprs (list + `Bx + `psi) ; conserved variables: magnetic field (x-component), magnetic field correction potential (psi). + 'flux-exprs (list + `(* b_fact psi) + `(* b_fact (* (* c c) Bx))) ; flux vector + 'max-speed-exprs (list + `(abs (* b_fact c)) + `(abs (* b_fact c))) ; local wave-speeds + 'parameters (list + `(define c 1.0) ; speed of light: c = 1.0 + `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 + `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.5) +(define x1 1.5) +(define t-final 1.0) +(define cfl 0.95) +(define init-funcs (list + 0.0 + `(cond + [(< x 0.0) 0.5] + [else -0.5]))) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-lax + (generate-lax-friedrichs-vector2-1d pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Bx_psi_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-lax))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-lax-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Bx-psi-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Bx-psi-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-lax-cfl-stability + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-maxwell-1d-Bx-psi-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components) +(define proof-maxwell-1d-Bx-psi-lax-local-lipschitz + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-maxwell-1d-Bx-psi-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Bx and psi components). +(define code-maxwell-1d-Bx-psi-roe + (generate-roe-vector2-1d pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Bx_psi_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-roe))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-roe-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Bx-psi-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Bx-psi-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Bx and psi components). +(define proof-maxwell-1d-Bx-psi-roe-flux-conservation + (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Bx-psi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-maxwell-1d-Bx-psi-roe-flux-conservation) +(display "\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and psi components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-maxwell-1d-Bx-psi-lax-minmod + (generate-lax-friedrichs-vector2-1d-second-order pde-system-maxwell-1d-Bx-psi limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Bx_psi_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Bx and psi components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-maxwell-1d-Bx-psi-roe-minmod + (generate-roe-vector2-1d-second-order pde-system-maxwell-1d-Bx-psi limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Bx_psi_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Bx-psi-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_maxwell_1d_Ex_phi.rkt b/provable-algorithms/finite_volume/test_maxwell_1d_Ex_phi.rkt new file mode 100644 index 00000000..6293d7c6 --- /dev/null +++ b/provable-algorithms/finite_volume/test_maxwell_1d_Ex_phi.rkt @@ -0,0 +1,282 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "code_generator_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "code_generator_core.rkt")) +(provide (all-from-out "code_generator_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D Maxwell equations (Ex and phi components). +(define pde-system-maxwell-1d-Ex-phi + (hash + 'name "maxwell-1d-Ex-phi" + 'cons-exprs (list + `Ex + `phi) ; conserved variables: electric field (x-component), electric field correction potential (phi). + 'flux-exprs (list + `(* e_fact (* (* c c) phi)) + `(* e_fact Ex)) ; flux vector + 'max-speed-exprs (list + `(abs (* c e_fact)) + `(abs (* c e_fact))) ; local wave-speeds + 'parameters (list + `(define c 1.0) ; speed of light: c = 1.0 + `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 + `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.5) +(define x1 1.5) +(define t-final 1.0) +(define cfl 0.95) +(define init-funcs (list + 0.0 + `(cond + [(< x 0.0) 0.5] + [else -0.5]))) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-lax + (generate-lax-friedrichs-vector2-1d pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ex_phi_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-lax))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-lax-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ex-phi-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ex-phi-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-lax-cfl-stability + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-maxwell-1d-Ex-phi-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components) +(define proof-maxwell-1d-Ex-phi-lax-local-lipschitz + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-maxwell-1d-Ex-phi-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ex and phi components). +(define code-maxwell-1d-Ex-phi-roe + (generate-roe-vector2-1d pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ex_phi_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-roe))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-roe-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ex-phi-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ex-phi-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ex and phi components). +(define proof-maxwell-1d-Ex-phi-roe-flux-conservation + (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ex-phi + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-maxwell-1d-Ex-phi-roe-flux-conservation) +(display "\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-maxwell-1d-Ex-phi-lax-minmod + (generate-lax-friedrichs-vector2-1d-second-order pde-system-maxwell-1d-Ex-phi limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ex_phi_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ex and phi components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-maxwell-1d-Ex-phi-roe-minmod + (generate-roe-vector2-1d-second-order pde-system-maxwell-1d-Ex-phi limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ex_phi_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ex-phi-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_maxwell_1d_Ey_Bz.rkt b/provable-algorithms/finite_volume/test_maxwell_1d_Ey_Bz.rkt new file mode 100644 index 00000000..d8aa4816 --- /dev/null +++ b/provable-algorithms/finite_volume/test_maxwell_1d_Ey_Bz.rkt @@ -0,0 +1,282 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "code_generator_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "code_generator_core.rkt")) +(provide (all-from-out "code_generator_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D Maxwell equations (Ey and Bz components). +(define pde-system-maxwell-1d-Ey-Bz + (hash + 'name "maxwell-1d-Ey-Bz" + 'cons-exprs (list + `Ey + `Bz) ; conserved variables: electric field (y-component), magnetic field (z-component) + 'flux-exprs (list + `(* (* c c) Bz) + `Ey) ; flux vector + 'max-speed-exprs (list + `(abs c) + `(abs c)) ; local wave-speeds + 'parameters (list + `(define c 1.0) ; speed of light: c = 1.0 + `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 + `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.5) +(define x1 1.5) +(define t-final 1.0) +(define cfl 0.95) +(define init-funcs (list + 0.0 + `(cond + [(< x 0.0) 0.5] + [else -0.5]))) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-lax + (generate-lax-friedrichs-vector2-1d pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ey_Bz_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-lax))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-lax-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ey-Bz-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ey-Bz-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-lax-cfl-stability + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-maxwell-1d-Ey-Bz-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components) +(define proof-maxwell-1d-Ey-Bz-lax-local-lipschitz + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-maxwell-1d-Ey-Bz-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define code-maxwell-1d-Ey-Bz-roe + (generate-roe-vector2-1d pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ey_Bz_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-roe))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-roe-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ey-Bz-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ey-Bz-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ey and Bz components). +(define proof-maxwell-1d-Ey-Bz-roe-flux-conservation + (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ey-Bz + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-maxwell-1d-Ey-Bz-roe-flux-conservation) +(display "\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-maxwell-1d-Ey-Bz-lax-minmod + (generate-lax-friedrichs-vector2-1d-second-order pde-system-maxwell-1d-Ey-Bz limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ey_Bz_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ey and Bz components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-maxwell-1d-Ey-Bz-roe-minmod + (generate-roe-vector2-1d-second-order pde-system-maxwell-1d-Ey-Bz limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ey_Bz_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ey-Bz-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/finite_volume/test_maxwell_1d_Ez_By.rkt b/provable-algorithms/finite_volume/test_maxwell_1d_Ez_By.rkt new file mode 100644 index 00000000..3dfd256b --- /dev/null +++ b/provable-algorithms/finite_volume/test_maxwell_1d_Ez_By.rkt @@ -0,0 +1,282 @@ +#lang racket + +(require "code_generator_core.rkt") +(require "code_generator_vector.rkt") +(require "prover_core.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "code_generator_core.rkt")) +(provide (all-from-out "code_generator_vector.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D Maxwell equations (Ez and By components). +(define pde-system-maxwell-1d-Ez-By + (hash + 'name "maxwell-1d-Ez-By" + 'cons-exprs (list + `Ez + `By) ; conserved variables: electric field (z-component), magnetic field (y-component) + 'flux-exprs (list + `(* -1.0 (* (* c c) By)) + `(* -1.0 Ez)) ; flux vector + 'max-speed-exprs (list + `(abs c) + `(abs c)) ; local wave-speeds + 'parameters (list + `(define c 1.0) ; speed of light: c = 1.0 + `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 + `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 + )) + +;; Define simulation parameters. +(define nx 200) +(define x0 -1.5) +(define x1 1.5) +(define t-final 1.0) +(define cfl 0.95) +(define init-funcs (list + 0.0 + `(cond + [(< x 0.0) 0.5] + [else -0.5]))) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-lax + (generate-lax-friedrichs-vector2-1d pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ez_By_lax.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-lax))) + +(display "Lax-Friedrichs (finite-difference) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-lax-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ez-By-lax-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-lax-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ez-By-lax-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-lax-cfl-stability + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_cfl_stability.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_cfl_stability.rkt") + +;; Show whether CFL stability is satisfied. +(display "CFL stability: ") +(display proof-maxwell-1d-Ez-By-lax-cfl-stability) +(display "\n") + +;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components) +(define proof-maxwell-1d-Ez-By-lax-local-lipschitz + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_local_lipschitz.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_local_lipschitz.rkt") + +;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. +(display "Local Lipschitz continuity of discrete flux function: ") +(display proof-maxwell-1d-Ez-By-lax-local-lipschitz) +(display "\n\n\n") + +;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ez and By components). +(define code-maxwell-1d-Ez-By-roe + (generate-roe-vector2-1d pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ez_By_roe.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-roe))) + +(display "Roe (finite-volume) properties: \n\n") + +;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-roe-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_hyperbolicity.rkt") + +;; Show whether hyperbolicity is preserved. +(display "Hyperbolicity preservation: ") +(display proof-maxwell-1d-Ez-By-roe-hyperbolicity) +(display "\n") + +;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-roe-strict-hyperbolicity + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_strict_hyperbolicity.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_strict_hyperbolicity.rkt") + +;; Show whether strict hyperbolicity is preserved. +(display "Strict hyperbolicity preservation: ") +(display proof-maxwell-1d-Ez-By-roe-strict-hyperbolicity) +(display "\n") + +;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ez and By components). +(define proof-maxwell-1d-Ez-By-roe-flux-conservation + (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_flux_conservation.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover_core.rkt\")\n") + (display "(require \"../prover_vector.rkt\")\n\n") + (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ez-By + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_flux_conservation.rkt") + +;; Show whether flux conservation (jump continuity) is preserved. +(display "Flux conservation (jump continuity): ") +(display proof-maxwell-1d-Ez-By-roe-flux-conservation) +(display "\n") + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-maxwell-1d-Ez-By-lax-minmod + (generate-lax-friedrichs-vector2-1d-second-order pde-system-maxwell-1d-Ez-By limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ez_By_lax_minmod.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-lax-minmod))) + +;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ez and By components, with a second-order flux extrapolation using the minmod flux limiter). +(define code-maxwell-1d-Ez-By-roe-minmod + (generate-roe-vector2-1d-second-order pde-system-maxwell-1d-Ez-By limiter-minmod + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/maxwell_1d_Ez_By_roe_minmod.c" + #:exists 'replace + (lambda () + (display code-maxwell-1d-Ez-By-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_core_training.rkt b/provable-algorithms/neural_networks/code_generator_core_training.rkt new file mode 100644 index 00000000..d11c189d --- /dev/null +++ b/provable-algorithms/neural_networks/code_generator_core_training.rkt @@ -0,0 +1,1415 @@ +#lang racket + +(require "prover_core.rkt") +(provide convert-expr + remove-bracketed-expressions + remove-bracketed-expressions-from-file + flux-substitute + train-lax-friedrichs-scalar-1d + train-lax-friedrichs-scalar-1d-second-order + train-roe-scalar-1d + train-roe-scalar-1d-second-order) + +;; Lightweight converter from Racket expressions (expr) into strings representing equivalent C code. +(define (convert-expr expr) + (match expr + ;; If expr is a symbol, then convert it directly to a string. + [(? symbol? symb) (symbol->string symb)] + + ;; If expr is a numerical constant, then convert it directly to a string. + [(? number? num) (number->string num)] + + ;; If expr is a sum of the form (+ expr1 expr2 ...), then convert it to "(expr1 + expr2 + ...)" in C. + [`(+ . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " + ") ")"))] + ;; Likewise for differences. + [`(- . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " - ") ")"))] + + ;; If expr is a product of the form (* expr1 expr2 ...), then convert it to "(expr1 * expr2 * ...)" in C. + [`(* . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " * ") ")"))] + ;; Likewise for quotients. + [`(/ . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " / ") ")"))] + + ;; If expr is an absolute value of the form (abs expr1), then convert it to "fabs(expr1)" in C. + [`(abs ,arg) + (format "fabs(~a)" (convert-expr arg))] + + ;; If expr is a square root of the form (sqrt expr1), then convert it to "sqrt(expr1)" in C. + [`(sqrt ,arg) + (format "sqrt(~a)" (convert-expr arg))] + + ;; If expr is a maximum of the form (max expr1 expr2), then convert it to "fmax(expr1, expr2)" in C. + [`(max ,arg1 ,arg2) + (format "fmax(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a maximum of the form (max expr1 expr2 expr2), then convert it to "fmax(expr1, expr2, expr3)" in C. + [`(max ,arg1 ,arg2 ,arg3) + (format "fmax3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] + + ;; If expr is a minimum of the form (max expr1 expr2), then convert it to "fmin(expr1, expr2)" in C. + [`(min ,arg1 ,arg2) + (format "fmin(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a minimum of the form (max expr1 expr2 expr2), then convert it to "fmin(expr1, expr2, expr3)" in C. + [`(min ,arg1 ,arg2 ,arg3) + (format "fmin3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] + + ;; If expr is a variable assignment of the form (define expr1 expr2), then convert it to "expr1 = expr2" in C. + [`(define ,arg1 ,arg2) + (format "~a = ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a strict comparison of the form (< expr1 expr2), then convert it to "expr1 < expr2" in C. + [`(< ,arg1 ,arg2) + (format "~a < ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a comparison of the form (<= expr1 expr2), then convert it to "expr1 <= expr2" in C. + [`(<= ,arg1 ,arg2) + (format "~a <= ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a strict comparison of the form (> expr1 expr2), then convert it to "expr1 > expr2" in C. + [`(> ,arg1 ,arg2) + (format "~a > ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a comparison of the form (>= expr1 expr2), then convert it to "expr1 >= expr2" in C. + [`(>= ,arg1 ,arg2) + (format "~a >= ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a logical conjunction of the form (and expr1 expr2), then convert it to "expr1 && expr2" in C. + [`(and ,arg1 ,arg2) + (format "~a && ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is an equality comparison of the form (equal? expr1 expr2), then convert it to "expr1 == expr2" in C. + [`(equal? ,arg1 ,arg2) + (format "~a == ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a conditional of the form [(cond [cond1 expr1] [else expr2])], then convert it to the ternary operator "(cond1) ? expr1 : expr2" in C. + [`(cond + [,cond1 ,expr1] + [else ,expr2]) + (format "(~a) ? ~a : ~a" (convert-expr cond1) (convert-expr expr1) (convert-expr expr2))])) + +;; A simple boilerplate function for removing bracketed expressions from strings. +(define (remove-bracketed-expressions str) + (regexp-replace* #rx"\\[.*?\\]" str "")) + +;; A simple boilerplate function for removing bracketed expressions from files. +(define (remove-bracketed-expressions-from-file output-file) + (define content + (with-input-from-file output-file + (lambda () + (port->string (current-input-port))))) + (define cleaned + (remove-bracketed-expressions content)) + (with-output-to-file output-file #:exists 'replace + (lambda () + (display cleaned)))) + +(define (flux-substitute flux-expr cons-expr var-name) + (string-replace flux-expr cons-expr var-name)) + +;; ------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------------- +(define (train-lax-friedrichs-scalar-1d pde neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that trains a surrogate solver for the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define flux-um (flux-substitute flux-code cons-code "um")) + (define flux-ui (flux-substitute flux-code cons-code "ui")) + (define flux-up (flux-substitute flux-code cons-code "up")) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a scalar PDE in 1D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * sizeof(double)); + double *un = (double*) malloc((nx + 2) * sizeof(double)); + + // Arrays for storing training data. + float **input_data = (float**) malloc(nx * num_trains * sizeof(float*)); + float **output_data = (float**) malloc(nx * num_trains * sizeof(float*)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[i] = ~a; // init-func in C. + un[i] = ~a; // init-func in C. + } + + // Initialize neural network architecture. + kad_node_t *t_net; + kann_t *ann; + t_net = kann_layer_input(2); + + for (int i = 0; i < nn_depth; i++) { + t_net = kann_layer_dense(t_net, nn_width); + t_net = kad_tanh(t_net); + } + + t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); + ann = kann_new(t_net, 0); + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable. + for (int i = 1; i <= nx; i++) { + double um = u[i - 1]; + double ui = u[i]; + double up = u[i + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um = ~a; // f(u_{i - 1}). + double f_ui = ~a; // f(u_i). + double f_up = ~a; // f(u_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * alpha * (u_i - u_{i - 1}). + double fluxL = 0.5 * (f_um + f_ui) - 0.5 * alpha * (ui - um); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * alpha * (u_{i + 1} - u_i). + double fluxR = 0.5 * (f_ui + f_up) - 0.5 * alpha * (up - ui); + + // Update the conserved variable. + un[i] = ui - (dt / dx) * (fluxR - fluxL); + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + u[i] = un[i]; + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[1]; + u[nx + 1] = u[nx]; + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + + input_data[(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); + output_data[(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); + + input_data[(n * nx) + (i - 1)][0] = t; + input_data[(n * nx) + (i - 1)][1] = x; + output_data[(n * nx) + (i - 1)][0] = u[i]; + } + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + kann_mt(ann, num_threads, mini_size); + kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data, output_data); + + // Output neural network to disk. + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + kann_save(file_nm, ann); + + free(u); + free(un); + + kann_delete(ann); + + for (int i = 0; i < nx * num_trains; i++) { + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expression for local wave-speed estimate. + max-speed-local + ;; Left flux f(u_{i - 1}). + flux-um + ;; Middle flux f(u_i). + flux-ui + ;; Right flux f(u_{i + 1}). + flux-up + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Scalar PDE with a Second-Order Flux Extrapolation +;; ---------------------------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-scalar-1d-second-order pde limiter neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that trains a surrogate solver for the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method with a second-order flux extrapolation + using the flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umL (flux-substitute flux-code cons-code "umL")) + (define flux-umR (flux-substitute flux-code cons-code "umR")) + (define flux-uiL (flux-substitute flux-code cons-code "uiL")) + (define flux-uiR (flux-substitute flux-code cons-code "uiR")) + (define flux-upL (flux-substitute flux-code cons-code "upL")) + (define flux-upR (flux-substitute flux-code cons-code "upR")) + + (define flux-umR-evol (flux-substitute flux-code cons-code "umR_evol")) + (define flux-uiL-evol (flux-substitute flux-code cons-code "uiL_evol")) + (define flux-uiR-evol (flux-substitute flux-code cons-code "uiR_evol")) + (define flux-upL-evol (flux-substitute flux-code cons-code "upL_evol")) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a scalar PDE in 1D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Array for storing slopes. + double *slope = (double*) malloc((nx + 4) * sizeof(double)); + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * sizeof(double)); + double *un = (double*) malloc((nx + 4) * sizeof(double)); + + // Arrays for storing training data. + float **input_data = (float**) malloc(nx * num_trains * sizeof(float*)); + float **output_data = (float**) malloc(nx * num_trains * sizeof(float*)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[i] = ~a; // init-func in C. + un[i] = ~a; // init-func in C. + } + + // Initialize neural network architecture. + kad_node_t *t_net; + kann_t *ann; + t_net = kann_layer_input(2); + + for (int i = 0; i < nn_depth; i++) { + t_net = kann_layer_dense(t_net, nn_width); + t_net = kad_tanh(t_net); + } + + t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); + ann = kann_new(t_net, 0); + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + double r = (u[i] - u[i - 1]) / (u[i + 1] - u[i]); + double limiter = ~a; // limiter-r in C. + + slope[i] = limiter * (0.5 * ((u[i] - u[i - 1]) + (u[i + 1] - u[i]))); + } + + // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable. + for (int i = 2; i <= nx + 1; i++) { + // Extrapolate boundary states. + double umL = u[i - 1] - (0.5 * slope[i - 1]); + double umR = u[i - 1] + (0.5 * slope[i - 1]); + + double uiL = u[i] - (0.5 * slope[i]); + double uiR = u[i] + (0.5 * slope[i]); + + double upL = u[i + 1] - (0.5 * slope[i + 1]); + double upR = u[i + 1] + (0.5 * slope[i + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL = ~a; + double f_umR = ~a; + + double f_uiL = ~a; + double f_uiR = ~a; + + double f_upL = ~a; + double f_upR = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol = umR + ((dt / (2.0 * dx)) * (f_umL - f_umR)); + + double uiL_evol = uiL + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); + double uiR_evol = uiR + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); + + double upL_evol = upL + ((dt / (2.0 * dx)) * (f_upL - f_upR)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol = ~a; + double f_uiL_evol = ~a; + + double f_uiR_evol = ~a; + double f_upL_evol = ~a; + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * alpha * (u_{i, L+} - u_{i - 1, R+}). + double fluxL = 0.5 * (f_umR_evol + f_uiL_evol) - 0.5 * alpha * (uiL_evol - umR_evol); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * alpha * (u_{i + 1, L+} - u_{i, R+}). + double fluxR = 0.5 * (f_uiR_evol + f_upL_evol) - 0.5 * alpha * (upL_evol - uiR_evol); + + // Update the conserved variable. + un[i] = u[i] - (dt / dx) * (fluxR - fluxL); + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + u[i] = un[i]; + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[2]; + u[1] = u[2]; + u[nx + 2] = u[nx + 1]; + u[nx + 3] = u[nx + 1]; + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + + input_data[(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); + output_data[(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); + + input_data[(n * nx) + (i - 2)][0] = t; + input_data[(n * nx) + (i - 2)][1] = x; + output_data[(n * nx) + (i - 2)][0] = u[i]; + } + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + kann_mt(ann, num_threads, mini_size); + kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data, output_data); + + // Output neural network to disk. + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + kann_save(file_nm, ann); + + free(u); + free(un); + + kann_delete(ann); + + for (int i = 0; i < nx * num_trains; i++) { + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expression for local wave-speed estimate. + max-speed-local + ;; Expression for flux limiter function. + limiter-r + ;; Left negative flux f(u_{i - 1, L}). + flux-umL + ;; Right negative flux f(u_{i - 1, R}). + flux-umR + ;; Left central flux f(u_{i, L}). + flux-uiL + ;; Right central flux f(u_{i, R}). + flux-uiR + ;; Left positive flux f(u_{i + 1, L}). + flux-upL + ;; Right positive flux f(u_{i + 1, R}). + flux-upR + ;; Evolved right negative flux f(u_{i - 1, R+}). + flux-umR-evol + ;; Evolved left central flux f(u_{i, L+}). + flux-uiL-evol + ;; Evolved right central flux f(u_{i, R+}). + flux-uiR-evol + ;; Evolved left positive flux f(u_{i + 1, L+}). + flux-upL-evol + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ---------------------------------------------------------------- +;; Train a Roe (Finite-Volume) Surrogate Solver for a 1D Scalar PDE +;; ---------------------------------------------------------------- +(define (train-roe-scalar-1d pde neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that trains a surrogate solver for the 1D scalar PDE specified by `pde` using the Roe finite-volume method, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define flux-deriv-code (convert-expr flux-deriv)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define flux-um (flux-substitute flux-code cons-code "um")) + (define flux-ui (flux-substitute flux-code cons-code "ui")) + (define flux-up (flux-substitute flux-code cons-code "up")) + + (define flux-deriv-um (flux-substitute flux-deriv-code cons-code "um")) + (define flux-deriv-ui (flux-substitute flux-deriv-code cons-code "ui")) + (define flux-deriv-up (flux-substitute flux-deriv-code cons-code "up")) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a +// Train a Roe higher-order finite-volume surrogate solver for a scalar PDE in 1D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * sizeof(double)); + double *un = (double*) malloc((nx + 2) * sizeof(double)); + + // Arrays for storing training data. + float **input_data = (float**) malloc(nx * num_trains * sizeof(float*)); + float **output_data = (float**) malloc(nx * num_trains * sizeof(float*)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[i] = ~a; // init-func in C. + un[i] = ~a; // init-func in C. + } + + // Initialize neural network architecture. + kad_node_t *t_net; + kann_t *ann; + t_net = kann_layer_input(2); + + for (int i = 0; i < nn_depth; i++) { + t_net = kann_layer_dense(t_net, nn_width); + t_net = kad_tanh(t_net); + } + + t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); + ann = kann_new(t_net, 0); + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Roe approximation and update the conserved variable. + for (int i = 1; i <= nx; i++) { + double um = u[i - 1]; + double ui = u[i]; + double up = u[i + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um = ~a; // f(u_{i - 1}). + double f_ui = ~a; // f(u_i). + double f_up = ~a; // f(u_{i + 1}). + + // Evaluate flux derivative for each value of the conserved variable. + double f_deriv_um = ~a; // f'(u_{i - 1}). + double f_deriv_ui = ~a; // f'(u_i). + double f_deriv_up = ~a; // f'(u_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * |aL_roe| * (u_i - u_{i - 1}). + double aL_roe = 0.5 * (f_deriv_um + f_deriv_ui); + double fluxL = 0.5 * (f_um + f_ui) - 0.5 * fabs(aL_roe) * (ui - um); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * |aR_roe| * (u_{i + 1} - u_i). + double aR_roe = 0.5 * (f_deriv_ui + f_deriv_up); + double fluxR = 0.5 * (f_ui + f_up) - 0.5 * fabs(aR_roe) * (up - ui); + + // Update the conserved variable. + un[i] = ui - (dt / dx) * (fluxR - fluxL); + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + u[i] = un[i]; + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[1]; + u[nx + 1] = u[nx]; + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + + input_data[(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); + output_data[(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); + + input_data[(n * nx) + (i - 1)][0] = t; + input_data[(n * nx) + (i - 1)][1] = x; + output_data[(n * nx) + (i - 1)][0] = u[i]; + } + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + kann_mt(ann, num_threads, mini_size); + kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data, output_data); + + // Output neural network to disk. + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + kann_save(file_nm, ann); + + free(u); + free(un); + + kann_delete(ann); + + for (int i = 0; i < nx * num_trains; i++) { + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expression for local wave-speed estimate. + max-speed-local + ;; Left flux f(u_{i - 1}). + flux-um + ;; Middle flux f(u_i). + flux-ui + ;; Right flux f(u_{i + 1}). + flux-up + ;; Left flux derivative f'(u_{i - 1}). + flux-deriv-um + ;; Middle flux derivative f'(u_i). + flux-deriv-ui + ;; Right flux derivative f'(u_{i + 1}). + flux-deriv-up + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------------- +;; Train a Roe (Finite-Volume) Surrogate Solver for a 1D Scalar PDE with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------------------------- +(define (train-roe-scalar-1d-second-order pde limiter neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that trains a surrogate solver for the 1D scalar PDE specified by `pde` using the Roe finite-volume method with a second-order flux extrapolation + using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) + + (define cons-code (convert-expr cons-expr)) + (define flux-code (convert-expr flux-expr)) + (define flux-deriv-code (convert-expr flux-deriv)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umL (flux-substitute flux-code cons-code "umL")) + (define flux-umR (flux-substitute flux-code cons-code "umR")) + (define flux-uiL (flux-substitute flux-code cons-code "uiL")) + (define flux-uiR (flux-substitute flux-code cons-code "uiR")) + (define flux-upL (flux-substitute flux-code cons-code "upL")) + (define flux-upR (flux-substitute flux-code cons-code "upR")) + + (define flux-umR-evol (flux-substitute flux-code cons-code "umR_evol")) + (define flux-uiL-evol (flux-substitute flux-code cons-code "uiL_evol")) + (define flux-uiR-evol (flux-substitute flux-code cons-code "uiR_evol")) + (define flux-upL-evol (flux-substitute flux-code cons-code "upL_evol")) + + (define flux-deriv-umR-evol (flux-substitute flux-deriv-code cons-code "umR_evol")) + (define flux-deriv-uiL-evol (flux-substitute flux-deriv-code cons-code "uiL_evol")) + (define flux-deriv-uiR-evol (flux-substitute flux-deriv-code cons-code "uiR_evol")) + (define flux-deriv-upL-evol (flux-substitute flux-deriv-code cons-code "upL_evol")) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Train a Roe higher-order finite-volume surrogate solver for a scalar PDE in 1D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Array for storing slopes. + double *slope = (double*) malloc((nx + 4) * sizeof(double)); + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * sizeof(double)); + double *un = (double*) malloc((nx + 4) * sizeof(double)); + + // Arrays for storing training data. + float **input_data = (float**) malloc(nx * num_trains * sizeof(float*)); + float **output_data = (float**) malloc(nx * num_trains * sizeof(float*)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[i] = ~a; // init-func in C. + un[i] = ~a; // init-func in C. + } + + // Initialize neural network architecture. + kad_node_t *t_net; + kann_t *ann; + t_net = kann_layer_input(2); + + for (int i = 0; i < nn_depth; i++) { + t_net = kann_layer_dense(t_net, nn_width); + t_net = kad_tanh(t_net); + } + + t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); + ann = kann_new(t_net, 0); + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + double r = (u[i] - u[i - 1]) / (u[i + 1] - u[i]); + double limiter = ~a; // limiter-r in C. + + slope[i] = limiter * (0.5 * ((u[i] - u[i - 1]) + (u[i + 1] - u[i]))); + } + + // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable. + for (int i = 2; i <= nx + 1; i++) { + // Extrapolate boundary states. + double umL = u[i - 1] - (0.5 * slope[i - 1]); + double umR = u[i - 1] + (0.5 * slope[i - 1]); + + double uiL = u[i] - (0.5 * slope[i]); + double uiR = u[i] + (0.5 * slope[i]); + + double upL = u[i + 1] - (0.5 * slope[i + 1]); + double upR = u[i + 1] + (0.5 * slope[i + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL = ~a; + double f_umR = ~a; + + double f_uiL = ~a; + double f_uiR = ~a; + + double f_upL = ~a; + double f_upR = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol = umR + ((dt / (2.0 * dx)) * (f_umL - f_umR)); + + double uiL_evol = uiL + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); + double uiR_evol = uiR + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); + + double upL_evol = upL + ((dt / (2.0 * dx)) * (f_upL - f_upR)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol = ~a; + double f_uiL_evol = ~a; + + double f_uiR_evol = ~a; + double f_upL_evol = ~a; + + // Evaluate flux derivative for each value of the (evolved) conserved variable. + double f_deriv_umR_evol = ~a; + double f_deriv_uiL_evol = ~a; + + double f_deriv_uiR_evol = ~a; + double f_deriv_upL_evol = ~a; + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * |aL_roe| * (u_{i, L+} - u_{i - 1, R+}). + double aL_roe = 0.5 * (f_deriv_umR_evol + f_deriv_uiL_evol); + double fluxL = 0.5 * (f_umR_evol + f_uiL_evol) - 0.5 * fabs(aL_roe) * (uiL_evol - umR_evol); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * |aR_roe| * (u_{i + 1, L+} - u_{i, R+}). + double aR_roe = 0.5 * (f_deriv_uiR_evol + f_deriv_upL_evol); + double fluxR = 0.5 * (f_uiR_evol + f_upL_evol) - 0.5 * fabs(aR_roe) * (upL_evol - uiR_evol); + + // Update the conserved variable. + un[i] = u[i] - (dt / dx) * (fluxR - fluxL); + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + u[i] = un[i]; + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[2]; + u[1] = u[2]; + u[nx + 2] = u[nx + 1]; + u[nx + 3] = u[nx + 1]; + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + + input_data[(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); + output_data[(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); + + input_data[(n * nx) + (i - 2)][0] = t; + input_data[(n * nx) + (i - 2)][1] = x; + output_data[(n * nx) + (i - 2)][0] = u[i]; + } + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + kann_mt(ann, num_threads, mini_size); + kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data, output_data); + + // Output neural network to disk. + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + kann_save(file_nm, ann); + + free(u); + free(un); + free(slope); + + kann_delete(ann); + + for (int i = 0; i < nx * num_trains; i++) { + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expression for local wave-speed estimate. + max-speed-local + ;; Expression for flux limiter function. + limiter-r + ;; Left negative flux f(u_{i - 1, L}). + flux-umL + ;; Right negative flux f(u_{i - 1, R}). + flux-umR + ;; Left central flux f(u_{i, L}). + flux-uiL + ;; Right central flux f(u_{i, R}). + flux-uiR + ;; Left positive flux f(u_{i + 1, L}). + flux-upL + ;; Right positive flux f(u_{i + 1, R}). + flux-upR + ;; Evolved right negative flux f(u_{i - 1, R+}). + flux-umR-evol + ;; Evolved left central flux f(u_{i, L+}). + flux-uiL-evol + ;; Evolved right central flux f(u_{i, R+}). + flux-uiR-evol + ;; Evolved left positive flux f(u_{i + 1, L+}). + flux-upL-evol + ;; Evolved right negative flux derivative f'(u_{i - 1, R+}). + flux-deriv-umR-evol + ;; Evolved left central flux derivative f'(u_{i, L+}). + flux-deriv-uiL-evol + ;; Evolved right central flux derivative f'(u_{i, R+}). + flux-deriv-uiR-evol + ;; Evolved left positive flux derivative f'(u_{i + 1, L+}). + flux-deriv-upL-evol + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_core_training_2d.rkt b/provable-algorithms/neural_networks/code_generator_core_training_2d.rkt new file mode 100644 index 00000000..8939319c --- /dev/null +++ b/provable-algorithms/neural_networks/code_generator_core_training_2d.rkt @@ -0,0 +1,2325 @@ +#lang racket + +(require "prover_core.rkt") +(require "code_generator_core_training.rkt") +(provide train-lax-friedrichs-scalar-2d + train-lax-friedrichs-scalar-2d-second-order + train-roe-scalar-2d + train-roe-scalar-2d-second-order) + +;; ------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Scalar PDE +;; ------------------------------------------------------------------------------- +(define (train-lax-friedrichs-scalar-2d pde neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that trains a surrogate solver for the 2D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-code (convert-expr cons-expr)) + (define flux-code-x (convert-expr flux-expr-x)) + (define flux-code-y (convert-expr flux-expr-y)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define flux-um-x (flux-substitute flux-code-x cons-code "um_x")) + (define flux-ui-x (flux-substitute flux-code-x cons-code "ui_x")) + (define flux-up-x (flux-substitute flux-code-x cons-code "up_x")) + + (define flux-um-y (flux-substitute flux-code-y cons-code "um_y")) + (define flux-ui-y (flux-substitute flux-code-y cons-code "ui_y")) + (define flux-up-y (flux-substitute flux-code-y cons-code "up_y")) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a scalar PDE in 2D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + double **un = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * sizeof(double)); + un[i] = (double*) malloc((ny + 2) * sizeof(double)); + } + + // Arrays for storing training data. + float **input_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + float **output_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][j] = ~a; // init-func in C. + un[i][j] = ~a; // init-func in C. + } + } + + // Initialize neural network architecture. + kad_node_t *t_net; + kann_t *ann; + t_net = kann_layer_input(3); + + for (int i = 0; i < nn_depth; i++) { + t_net = kann_layer_dense(t_net, nn_width); + t_net = kad_tanh(t_net); + } + + t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); + ann = kann_new(t_net, 0); + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_y = u[i][j - 1]; + double ui_y = u[i][j]; + double up_y = u[i][j + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um_y = ~a; // f(u_{j - 1}). + double f_ui_y = ~a; // f(u_j). + double f_up_y = ~a; // f(u_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * alpha_y * (u_j - u_{j - 1}). + double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * alpha_y * (ui_y - um_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * alpha_y * (u_{j + 1} - u_j). + double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * alpha_y * (up_y - ui_y); + + // Update the conserved variable. + un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the x-direction. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_x = u[i - 1][j]; + double ui_x = u[i][j]; + double up_x = u[i + 1][j]; + + // Evaluate flux for each value of the conserved variable. + double f_um_x = ~a; // f(u_{i - 1}). + double f_ui_x = ~a; // f(u_i). + double f_up_x = ~a; // f(u_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * alpha_x * (u_i - u_{i - 1}). + double fluxL_x = 0.5 * (f_um_x + f_ui_x) - 0.5 * alpha_x * (ui_x - um_x); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * alpha_x * (u_{i + 1} - u_i). + double fluxR_x = 0.5 * (f_ui_x + f_up_x) - 0.5 * alpha_x * (up_x - ui_x); + + // Update the conserved variable. + un[i][j] = ui_x - (dt / dx) * (fluxR_x - fluxL_x); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_y = u[i][j - 1]; + double ui_y = u[i][j]; + double up_y = u[i][j + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um_y = ~a; // f(u_{j - 1}). + double f_ui_y = ~a; // f(u_j). + double f_up_y = ~a; // f(u_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * alpha_y * (u_j - u_{j - 1}). + double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * alpha_y * (ui_y - um_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * alpha_y * (u_{j + 1} - u_j). + double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * alpha_y * (up_y - ui_y); + + // Update the conserved variable. + un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j<= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); + output_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); + + input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; + input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; + input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; + output_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][j]; + } + } + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + kann_mt(ann, num_threads, mini_size); + kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data, output_data); + + // Output neural network to disk. + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + kann_save(file_nm, ann); + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + free(un[i]); + } + free(u); + free(un); + + kann_delete(ann); + + for (int i = 0; i < nx * ny * num_trains; i++) { + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). + flux-um-y + flux-ui-y + flux-up-y + ;; Left, middle, right fluxes in x-direction f(u_{i - 1}), f(u_i), f(u_{i + 1}). + flux-um-x + flux-ui-x + flux-up-x + ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). + flux-um-y + flux-ui-y + flux-up-y + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Scalar PDE with a Second-Order Flux Extrapolation +;; ---------------------------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-scalar-2d-second-order pde limiter neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that trains a surrogate solver for the 2D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method with a second-order flux extrapolation + using the flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-code (convert-expr cons-expr)) + (define flux-code-x (convert-expr flux-expr-x)) + (define flux-code-y (convert-expr flux-expr-y)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umL-x (flux-substitute flux-code-x cons-code "umL_x")) + (define flux-umR-x (flux-substitute flux-code-x cons-code "umR_x")) + (define flux-uiL-x (flux-substitute flux-code-x cons-code "uiL_x")) + (define flux-uiR-x (flux-substitute flux-code-x cons-code "uiR_x")) + (define flux-upL-x (flux-substitute flux-code-x cons-code "upL_x")) + (define flux-upR-x (flux-substitute flux-code-x cons-code "upR_x")) + + (define flux-umR-evol-x (flux-substitute flux-code-x cons-code "umR_evol_x")) + (define flux-uiL-evol-x (flux-substitute flux-code-x cons-code "uiL_evol_x")) + (define flux-uiR-evol-x (flux-substitute flux-code-x cons-code "uiR_evol_x")) + (define flux-upL-evol-x (flux-substitute flux-code-x cons-code "upL_evol_x")) + + (define flux-umL-y (flux-substitute flux-code-y cons-code "umL_y")) + (define flux-umR-y (flux-substitute flux-code-y cons-code "umR_y")) + (define flux-uiL-y (flux-substitute flux-code-y cons-code "uiL_y")) + (define flux-uiR-y (flux-substitute flux-code-y cons-code "uiR_y")) + (define flux-upL-y (flux-substitute flux-code-y cons-code "upL_y")) + (define flux-upR-y (flux-substitute flux-code-y cons-code "upR_y")) + + (define flux-umR-evol-y (flux-substitute flux-code-y cons-code "umR_evol_y")) + (define flux-uiL-evol-y (flux-substitute flux-code-y cons-code "uiL_evol_y")) + (define flux-uiR-evol-y (flux-substitute flux-code-y cons-code "uiR_evol_y")) + (define flux-upL-evol-y (flux-substitute flux-code-y cons-code "upL_evol_y")) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a scalar PDE in 2D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing slopes. + double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); + double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + slope_x[i] = (double*) malloc((ny + 4) * sizeof(double)); + slope_y[i] = (double*) malloc((ny + 4) * sizeof(double)); + } + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + double **un = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * sizeof(double)); + un[i] = (double*) malloc((ny + 4) * sizeof(double)); + } + + // Arrays for storing training data. + float **input_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + float **output_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][j] = ~a; // init-func in C. + un[i][j] = ~a; // init-func in C. + } + } + + // Initialize neural network architecture. + kad_node_t *t_net; + kann_t *ann; + t_net = kann_layer_input(3); + + for (int i = 0; i < nn_depth; i++) { + t_net = kann_layer_dense(t_net, nn_width); + t_net = kad_tanh(t_net); + } + + t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); + ann = kann_new(t_net, 0); + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); + } + } + + // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); + double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); + + double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); + double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); + + double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); + double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_y = ~a; + double f_umR_y = ~a; + + double f_uiL_y = ~a; + double f_uiR_y = ~a; + + double f_upL_y = ~a; + double f_upR_y = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); + + double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + + double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_y = ~a; + double f_uiL_evol_y = ~a; + + double f_uiR_evol_y = ~a; + double f_upL_evol_y = ~a; + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * alpha * (u_{j, L+} - u_{j - 1, R+}). + double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * alpha_y * (uiL_evol_y - umR_evol_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * alpha * (u_{j + 1, L+} - u_{j, R+}). + double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * alpha_y * (upL_evol_y - uiR_evol_y); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i - 1][j]) / (u[i + 1][j] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_x[i][j] = limiter * (0.5 * ((u[i][j] - u[i - 1][j]) + (u[i + 1][j] - u[i][j]))); + } + } + + // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the x-direction. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_x = u[i - 1][j] - (0.5 * slope_x[i - 1][j]); + double umR_x = u[i - 1][j] + (0.5 * slope_x[i - 1][j]); + + double uiL_x = u[i][j] - (0.5 * slope_x[i][j]); + double uiR_x = u[i][j] + (0.5 * slope_x[i][j]); + + double upL_x = u[i + 1][j] - (0.5 * slope_x[i + 1][j]); + double upR_x = u[i + 1][j] + (0.5 * slope_x[i + 1][j]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_x = ~a; + double f_umR_x = ~a; + + double f_uiL_x = ~a; + double f_uiR_x = ~a; + + double f_upL_x = ~a; + double f_upR_x = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_x = umR_x + ((dt / (2.0 * dx)) * (f_umL_x - f_umR_x)); + + double uiL_evol_x = uiL_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); + double uiR_evol_x = uiR_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); + + double upL_evol_x = upL_x + ((dt / (2.0 * dx)) * (f_upL_x - f_upR_x)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_x = ~a; + double f_uiL_evol_x = ~a; + + double f_uiR_evol_x = ~a; + double f_upL_evol_x = ~a; + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * alpha * (u_{i, L+} - u_{i - 1, R+}). + double fluxL_x = 0.5 * (f_umR_evol_x + f_uiL_evol_x) - 0.5 * alpha_x * (uiL_evol_x - umR_evol_x); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * alpha * (u_{i + 1, L+} - u_{i, R+}). + double fluxR_x = 0.5 * (f_uiR_evol_x + f_upL_evol_x) - 0.5 * alpha_x * (upL_evol_x - uiR_evol_x); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / dx) * (fluxR_x - fluxL_x); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); + } + } + + // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); + double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); + + double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); + double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); + + double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); + double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_y = ~a; + double f_umR_y = ~a; + + double f_uiL_y = ~a; + double f_uiR_y = ~a; + + double f_upL_y = ~a; + double f_upR_y = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); + + double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + + double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_y = ~a; + double f_uiL_evol_y = ~a; + + double f_uiR_evol_y = ~a; + double f_upL_evol_y = ~a; + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * alpha * (u_{j, L+} - u_{j - 1, R+}). + double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * alpha_y * (uiL_evol_y - umR_evol_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * alpha * (u_{j + 1, L+} - u_{j, R+}). + double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * alpha_y * (upL_evol_y - uiR_evol_y); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); + output_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); + + input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; + input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; + input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; + output_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][j]; + } + } + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + kann_mt(ann, num_threads, mini_size); + kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data, output_data); + + // Output neural network to disk. + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + kann_save(file_nm, ann); + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + free(un[i]); + free(slope_x[i]); + free(slope_y[i]); + } + free(u); + free(un); + free(slope_x); + free(slope_y); + + kann_delete(ann); + + for (int i = 0; i < nx * num_trains; i++) { + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). + flux-umL-y + flux-umR-y + ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). + flux-uiL-y + flux-uiR-y + ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). + flux-upL-y + flux-upR-y + ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). + flux-umR-evol-y + ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). + flux-uiL-evol-y + flux-uiR-evol-y + ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). + flux-upL-evol-y + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in x-direction f(u_{i - 1, L}), f(u_{i - 1, R}). + flux-umL-x + flux-umR-x + ;; Left/right central fluxes in x-direction f(u_{i, L}), f(u_{i, R}). + flux-uiL-x + flux-uiR-x + ;; Left/right positive fluxes in x-direction f(u_{i + 1, L}), f(u_{i + 1, R}). + flux-upL-x + flux-upR-x + ;; Evolved right negative flux in x-direction f(u_{i - 1, R+}). + flux-umR-evol-x + ;; Evolved left/right central fluxes in x-direction f(u_{i, L+}), f(u_{i, R+}). + flux-uiL-evol-x + flux-uiR-evol-x + ;; Evolved left positive flux in x-direction f(u_{i + 1, L+}). + flux-upL-evol-x + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). + flux-umL-y + flux-umR-y + ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). + flux-uiL-y + flux-uiR-y + ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). + flux-upL-y + flux-upR-y + ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). + flux-umR-evol-y + ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). + flux-uiL-evol-y + flux-uiR-evol-y + ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). + flux-upL-evol-y + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ---------------------------------------------------------------- +;; Train a Roe (Finite-Volume) Surrogate Solver for a 2D Scalar PDE +;; ---------------------------------------------------------------- +(define (train-roe-scalar-2d pde neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that trains a surrogate solver for the 2D scalar PDE specified by `pde` using the Roe finite-volume method, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) + (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) + + (define cons-code (convert-expr cons-expr)) + (define flux-code-x (convert-expr flux-expr-x)) + (define flux-code-y (convert-expr flux-expr-y)) + (define flux-deriv-code-x (convert-expr flux-deriv-x)) + (define flux-deriv-code-y (convert-expr flux-deriv-y)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define flux-um-x (flux-substitute flux-code-x cons-code "um_x")) + (define flux-ui-x (flux-substitute flux-code-x cons-code "ui_x")) + (define flux-up-x (flux-substitute flux-code-x cons-code "up_x")) + + (define flux-um-y (flux-substitute flux-code-y cons-code "um_y")) + (define flux-ui-y (flux-substitute flux-code-y cons-code "ui_y")) + (define flux-up-y (flux-substitute flux-code-y cons-code "up_y")) + + (define flux-deriv-um-x (flux-substitute flux-deriv-code-x cons-code "um_x")) + (define flux-deriv-ui-x (flux-substitute flux-deriv-code-x cons-code "ui_x")) + (define flux-deriv-up-x (flux-substitute flux-deriv-code-x cons-code "up_x")) + + (define flux-deriv-um-y (flux-substitute flux-deriv-code-y cons-code "um_y")) + (define flux-deriv-ui-y (flux-substitute flux-deriv-code-y cons-code "ui_y")) + (define flux-deriv-up-y (flux-substitute flux-deriv-code-y cons-code "up_y")) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a +// Train a Roe higher-order finite-volume surrogate solver for a scalar PDE in 2D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + double **un = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * sizeof(double)); + un[i] = (double*) malloc((ny + 2) * sizeof(double)); + } + + // Arrays for storing training data. + float **input_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + float **output_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][j] = ~a; // init-func in C. + un[i][j] = ~a; // init-func in C. + } + } + + // Initialize neural network architecture. + kad_node_t *t_net; + kann_t *ann; + t_net = kann_layer_input(3); + + for (int i = 0; i < nn_depth; i++) { + t_net = kann_layer_dense(t_net, nn_width); + t_net = kad_tanh(t_net); + } + + t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); + ann = kann_new(t_net, 0); + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Roe approximation and update the conserved variable in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_y = u[i][j - 1]; + double ui_y = u[i][j]; + double up_y = u[i][j + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um_y = ~a; // f(u_{j - 1}). + double f_ui_y = ~a; // f(u_j). + double f_up_y = ~a; // f(u_{j + 1}). + + // Evaluate flux derivative for each value of the conserved variable. + double f_deriv_um_y = ~a; // f'(u_{j - 1}). + double f_deriv_ui_y = ~a; // f'(u_j). + double f_deriv_up_y = ~a; // f'(u_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * |aL_roe_y| * (u_j - u_{j - 1}). + double aL_roe_y = 0.5 * (f_deriv_um_y + f_deriv_ui_y); + double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * fabs(aL_roe_y) * (ui_y - um_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * |aR_roe_y| * (u_{j + 1} - u_j). + double aR_roe_y = 0.5 * (f_deriv_ui_y + f_deriv_up_y); + double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * fabs(aR_roe_y) * (up_y - ui_y); + + // Update the conserved variable. + un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Compute fluxes with Roe approximation and update the conserved variable in the x-direction. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_x = u[i - 1][j]; + double ui_x = u[i][j]; + double up_x = u[i + 1][j]; + + // Evaluate flux for each value of the conserved variable. + double f_um_x = ~a; // f(u_{i - 1}). + double f_ui_x = ~a; // f(u_i). + double f_up_x = ~a; // f(u_{i + 1}). + + // Evaluate flux derivative for each value of the conserved variable. + double f_deriv_um_x = ~a; // f'(u_{i - 1}). + double f_deriv_ui_x = ~a; // f'(u_i). + double f_deriv_up_x = ~a; // f'(u_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * |aL_roe_x| * (u_i - u_{i - 1}). + double aL_roe_x = 0.5 * (f_deriv_um_x + f_deriv_ui_x); + double fluxL_x = 0.5 * (f_um_x + f_ui_x) - 0.5 * fabs(aL_roe_x) * (ui_x - um_x); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * |aR_roe_x| * (u_{i + 1} - u_i). + double aR_roe_x = 0.5 * (f_deriv_ui_x + f_deriv_up_x); + double fluxR_x = 0.5 * (f_ui_x + f_up_x) - 0.5 * fabs(aR_roe_x) * (up_x - ui_x); + + // Update the conserved variable. + un[i][j] = ui_x - (dt / dx) * (fluxR_x - fluxL_x); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Compute fluxes with Roe approximation and update the conserved variable in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double um_y = u[i][j - 1]; + double ui_y = u[i][j]; + double up_y = u[i][j + 1]; + + // Evaluate flux for each value of the conserved variable. + double f_um_y = ~a; // f(u_{j - 1}). + double f_ui_y = ~a; // f(u_j). + double f_up_y = ~a; // f(u_{j + 1}). + + // Evaluate flux derivative for each value of the conserved variable. + double f_deriv_um_y = ~a; // f'(u_{j - 1}). + double f_deriv_ui_y = ~a; // f'(u_j). + double f_deriv_up_y = ~a; // f'(u_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1}) + f(u_j)) - 0.5 * |aL_roe_y| * (u_j - u_{j - 1}). + double aL_roe_y = 0.5 * (f_deriv_um_y + f_deriv_ui_y); + double fluxL_y = 0.5 * (f_um_y + f_ui_y) - 0.5 * fabs(aL_roe_y) * (ui_y - um_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1}) + f(u_j)) - 0.5 * |aR_roe_y| * (u_{j + 1} - u_j). + double aR_roe_y = 0.5 * (f_deriv_ui_y + f_deriv_up_y); + double fluxR_y = 0.5 * (f_ui_y + f_up_y) - 0.5 * fabs(aR_roe_y) * (up_y - ui_y); + + // Update the conserved variable. + un[i][j] = ui_y - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + + un[0][j] = un[1][j]; + un[nx + 1][j] = un[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + + un[i][0] = un[i][1]; + un[i][ny + 1] = un[i][ny]; + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j<= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); + output_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); + + input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; + input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; + input_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; + output_data[(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][j]; + } + } + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + kann_mt(ann, num_threads, mini_size); + kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data, output_data); + + // Output neural network to disk. + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + kann_save(file_nm, ann); + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + free(un[i]); + } + free(u); + free(un); + + kann_delete(ann); + + for (int i = 0; i < nx * ny * num_trains; i++) { + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). + flux-um-y + flux-ui-y + flux-up-y + ;; Left, middle, right flux derivatives in y-direction f'(u_{j - 1}), f'(u_j), f'(u_{j + 1}). + flux-deriv-um-y + flux-deriv-ui-y + flux-deriv-up-y + ;; Left, middle, right fluxes in x-direction f(u_{i - 1}), f(u_i), f(u_{i + 1}). + flux-um-x + flux-ui-x + flux-up-x + ;; Left, middle, right flux derivatives in x-direction f'(u_{i - 1}), f'(u_i), f'(u_{i + 1}). + flux-deriv-um-x + flux-deriv-ui-x + flux-deriv-up-x + ;; Left, middle, right fluxes in y-direction f(u_{j - 1}), f(u_j), f(u_{j + 1}). + flux-um-y + flux-ui-y + flux-up-y + ;; Left, middle, right flux derivatives in y-direction f'(u_{j - 1}), f'(u_j), f'(u_{j + 1}). + flux-deriv-um-y + flux-deriv-ui-y + flux-deriv-up-y + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------------- +;; Train a Roe (Finite-Volume) Surrogate Solver for a 2D Scalar PDE with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------------------------- +(define (train-roe-scalar-2d-second-order pde limiter neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that trains a surrogate solver for the 2D scalar PDE specified by `pde` using the Roe finite-volume method with a second-order flux extrapolation + using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define flux-deriv-x (symbolic-simp (symbolic-diff flux-expr-x cons-expr))) + (define flux-deriv-y (symbolic-simp (symbolic-diff flux-expr-y cons-expr))) + + (define cons-code (convert-expr cons-expr)) + (define flux-code-x (convert-expr flux-expr-x)) + (define flux-code-y (convert-expr flux-expr-y)) + (define flux-deriv-code-x (convert-expr flux-deriv-x)) + (define flux-deriv-code-y (convert-expr flux-deriv-y)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umL-x (flux-substitute flux-code-x cons-code "umL_x")) + (define flux-umR-x (flux-substitute flux-code-x cons-code "umR_x")) + (define flux-uiL-x (flux-substitute flux-code-x cons-code "uiL_x")) + (define flux-uiR-x (flux-substitute flux-code-x cons-code "uiR_x")) + (define flux-upL-x (flux-substitute flux-code-x cons-code "upL_x")) + (define flux-upR-x (flux-substitute flux-code-x cons-code "upR_x")) + + (define flux-umR-evol-x (flux-substitute flux-code-x cons-code "umR_evol_x")) + (define flux-uiL-evol-x (flux-substitute flux-code-x cons-code "uiL_evol_x")) + (define flux-uiR-evol-x (flux-substitute flux-code-x cons-code "uiR_evol_x")) + (define flux-upL-evol-x (flux-substitute flux-code-x cons-code "upL_evol_x")) + + (define flux-deriv-umR-evol-x (flux-substitute flux-deriv-code-x cons-code "umR_evol_x")) + (define flux-deriv-uiL-evol-x (flux-substitute flux-deriv-code-x cons-code "uiL_evol_x")) + (define flux-deriv-uiR-evol-x (flux-substitute flux-deriv-code-x cons-code "uiR_evol_x")) + (define flux-deriv-upL-evol-x (flux-substitute flux-deriv-code-x cons-code "upL_evol_x")) + + (define flux-umL-y (flux-substitute flux-code-y cons-code "umL_y")) + (define flux-umR-y (flux-substitute flux-code-y cons-code "umR_y")) + (define flux-uiL-y (flux-substitute flux-code-y cons-code "uiL_y")) + (define flux-uiR-y (flux-substitute flux-code-y cons-code "uiR_y")) + (define flux-upL-y (flux-substitute flux-code-y cons-code "upL_y")) + (define flux-upR-y (flux-substitute flux-code-y cons-code "upR_y")) + + (define flux-umR-evol-y (flux-substitute flux-code-y cons-code "umR_evol_y")) + (define flux-uiL-evol-y (flux-substitute flux-code-y cons-code "uiL_evol_y")) + (define flux-uiR-evol-y (flux-substitute flux-code-y cons-code "uiR_evol_y")) + (define flux-upL-evol-y (flux-substitute flux-code-y cons-code "upL_evol_y")) + + (define flux-deriv-umR-evol-y (flux-substitute flux-deriv-code-y cons-code "umR_evol_y")) + (define flux-deriv-uiL-evol-y (flux-substitute flux-deriv-code-y cons-code "uiL_evol_y")) + (define flux-deriv-uiR-evol-y (flux-substitute flux-deriv-code-y cons-code "uiR_evol_y")) + (define flux-deriv-upL-evol-y (flux-substitute flux-deriv-code-y cons-code "upL_evol_y")) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Train a Roe higher-order finite-volume surrogate solver for a scalar PDE in 2D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing slopes. + double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); + double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + slope_x[i] = (double*) malloc((ny + 4) * sizeof(double)); + slope_y[i] = (double*) malloc((ny + 4) * sizeof(double)); + } + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + double **un = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * sizeof(double)); + un[i] = (double*) malloc((ny + 4) * sizeof(double)); + } + + // Arrays for storing training data. + float **input_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + float **output_data = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][j] = ~a; // init-func in C. + un[i][j] = ~a; // init-func in C. + } + } + + // Initialize neural network architecture. + kad_node_t *t_net; + kann_t *ann; + t_net = kann_layer_input(3); + + for (int i = 0; i < nn_depth; i++) { + t_net = kann_layer_dense(t_net, nn_width); + t_net = kad_tanh(t_net); + } + + t_net = kann_layer_cost(t_net, 1, KANN_C_MSE); + ann = kann_new(t_net, 0); + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); + } + } + + // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); + double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); + + double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); + double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); + + double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); + double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_y = ~a; + double f_umR_y = ~a; + + double f_uiL_y = ~a; + double f_uiR_y = ~a; + + double f_upL_y = ~a; + double f_upR_y = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); + + double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + + double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_y = ~a; + double f_uiL_evol_y = ~a; + + double f_uiR_evol_y = ~a; + double f_upL_evol_y = ~a; + + // Evaluate flux derivative for each value of the (evolved) conserved variable. + double f_deriv_umR_evol_y = ~a; + double f_deriv_uiL_evol_y = ~a; + + double f_deriv_uiR_evol_y = ~a; + double f_deriv_upL_evol_y = ~a; + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * |aL_roe_y| * (u_{j, L+} - u_{j - 1, R+}). + double aL_roe_y = 0.5 * (f_deriv_umR_evol_y + f_deriv_uiL_evol_y); + double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * fabs(aL_roe_y) * (uiL_evol_y - umR_evol_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * |aR_roe_y| * (u_{j + 1, L+} - u_{j, R+}). + double aR_roe_y = 0.5 * (f_deriv_uiR_evol_y + f_deriv_upL_evol_y); + double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * fabs(aR_roe_y) * (upL_evol_y - uiR_evol_y); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i - 1][j]) / (u[i + 1][j] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_x[i][j] = limiter * (0.5 * ((u[i][j] - u[i - 1][j]) + (u[i + 1][j] - u[i][j]))); + } + } + + // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the x-direction. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_x = u[i - 1][j] - (0.5 * slope_x[i - 1][j]); + double umR_x = u[i - 1][j] + (0.5 * slope_x[i - 1][j]); + + double uiL_x = u[i][j] - (0.5 * slope_x[i][j]); + double uiR_x = u[i][j] + (0.5 * slope_x[i][j]); + + double upL_x = u[i + 1][j] - (0.5 * slope_x[i + 1][j]); + double upR_x = u[i + 1][j] + (0.5 * slope_x[i + 1][j]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_x = ~a; + double f_umR_x = ~a; + + double f_uiL_x = ~a; + double f_uiR_x = ~a; + + double f_upL_x = ~a; + double f_upR_x = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_x = umR_x + ((dt / (2.0 * dx)) * (f_umL_x - f_umR_x)); + + double uiL_evol_x = uiL_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); + double uiR_evol_x = uiR_x + ((dt / (2.0 * dx)) * (f_uiL_x - f_uiR_x)); + + double upL_evol_x = upL_x + ((dt / (2.0 * dx)) * (f_upL_x - f_upR_x)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_x = ~a; + double f_uiL_evol_x = ~a; + + double f_uiR_evol_x = ~a; + double f_upL_evol_x = ~a; + + // Evaluate flux derivative for each value of the (evolved) conserved variable. + double f_deriv_umR_evol_x = ~a; + double f_deriv_uiL_evol_x = ~a; + + double f_deriv_uiR_evol_x = ~a; + double f_deriv_upL_evol_x = ~a; + + // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * |aL_roe_x| * (u_{i, L+} - u_{i - 1, R+}). + double aL_roe_x = 0.5 * (f_deriv_umR_evol_x + f_deriv_uiL_evol_x); + double fluxL_x = 0.5 * (f_umR_evol_x + f_uiL_evol_x) - 0.5 * fabs(aL_roe_x) * (uiL_evol_x - umR_evol_x); + + // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * |aR_roe_x| * (u_{i + 1, L+} - u_{i, R+}). + double aR_roe_x = 0.5 * (f_deriv_uiR_evol_x + f_deriv_upL_evol_x); + double fluxR_x = 0.5 * (f_uiR_evol_x + f_upL_evol_x) - 0.5 * fabs(aR_roe_x) * (upL_evol_x - uiR_evol_x); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / dx) * (fluxR_x - fluxL_x); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + double r = (u[i][j] - u[i][j - 1]) / (u[i][j + 1] - u[i][j]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][j] = limiter * (0.5 * ((u[i][j] - u[i][j - 1]) + (u[i][j + 1] - u[i][j]))); + } + } + + // Compute fluxes with Roe approximation (with a second-order flux extrapolation) and update the conserved variable in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + // Extrapolate boundary states. + double umL_y = u[i][j - 1] - (0.5 * slope_y[i][j - 1]); + double umR_y = u[i][j - 1] + (0.5 * slope_y[i][j - 1]); + + double uiL_y = u[i][j] - (0.5 * slope_y[i][j]); + double uiR_y = u[i][j] + (0.5 * slope_y[i][j]); + + double upL_y = u[i][j + 1] - (0.5 * slope_y[i][j + 1]); + double upR_y = u[i][j + 1] + (0.5 * slope_y[i][j + 1]); + + // Evaluate flux for each extrapolated boundary state. + double f_umL_y = ~a; + double f_umR_y = ~a; + + double f_uiL_y = ~a; + double f_uiR_y = ~a; + + double f_upL_y = ~a; + double f_upR_y = ~a; + + // Evolve each extrapolated boundary state. + double umR_evol_y = umR_y + ((dt / (4.0 * dy)) * (f_umL_y - f_umR_y)); + + double uiL_evol_y = uiL_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + double uiR_evol_y = uiR_y + ((dt / (4.0 * dy)) * (f_uiL_y - f_uiR_y)); + + double upL_evol_y = upL_y + ((dt / (4.0 * dy)) * (f_upL_y - f_upR_y)); + + // Evaluate flux for each value of the (evolved) conserved variable. + double f_umR_evol_y = ~a; + double f_uiL_evol_y = ~a; + + double f_uiR_evol_y = ~a; + double f_upL_evol_y = ~a; + + // Evaluate flux derivative for each value of the (evolved) conserved variable. + double f_deriv_umR_evol_y = ~a; + double f_deriv_uiL_evol_y = ~a; + + double f_deriv_uiR_evol_y = ~a; + double f_deriv_upL_evol_y = ~a; + + // Left interface flux: F_{j - 1/2} = 0.5 * (f(u_{j - 1, R+}) + f(u_{j, L+})) - 0.5 * |aL_roe_y| * (u_{j, L+} - u_{j - 1, R+}). + double aL_roe_y = 0.5 * (f_deriv_umR_evol_y + f_deriv_uiL_evol_y); + double fluxL_y = 0.5 * (f_umR_evol_y + f_uiL_evol_y) - 0.5 * fabs(aL_roe_y) * (uiL_evol_y - umR_evol_y); + + // Right interface flux: F_{j + 1/2} = 0.5 * (f(u_{j + 1, L+}) + f(u_{j, R+})) - 0.5 * |aR_roe_y| * (u_{j + 1, L+} - u_{j, R+}). + double aR_roe_y = 0.5 * (f_deriv_uiR_evol_y + f_deriv_upL_evol_y); + double fluxR_y = 0.5 * (f_uiR_evol_y + f_upL_evol_y) - 0.5 * fabs(aR_roe_y) * (upL_evol_y - uiR_evol_y); + + // Update the conserved variable. + un[i][j] = u[i][j] - (dt / (2.0 * dy)) * (fluxR_y - fluxL_y); + } + } + + // Copy un -> u (updated conserved variables to new conserved variables). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + u[i][j] = un[i][j]; + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + + un[0][j] = un[2][j]; + un[1][j] = un[2][j]; + un[nx + 2][j] = un[nx + 1][j]; + un[nx + 3][j] = un[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + + un[i][0] = un[i][2]; + un[i][1] = un[i][2]; + un[i][ny + 2] = un[i][ny + 1]; + un[i][ny + 3] = un[i][ny + 1]; + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); + output_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); + + input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; + input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; + input_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; + output_data[(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][j]; + } + } + } + + // Output solution to disk. + const char *fmt = \"%s_output_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + kann_mt(ann, num_threads, mini_size); + kann_train_fnn1(ann, 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data, output_data); + + // Output neural network to disk. + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + kann_save(file_nm, ann); + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + free(un[i]); + free(slope_x[i]); + free(slope_y[i]); + } + free(u); + free(un); + free(slope_x); + free(slope_y); + + kann_delete(ann); + + for (int i = 0; i < nx * num_trains; i++) { + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + init-func-code + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). + flux-umL-y + flux-umR-y + ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). + flux-uiL-y + flux-uiR-y + ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). + flux-upL-y + flux-upR-y + ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). + flux-umR-evol-y + ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). + flux-uiL-evol-y + flux-uiR-evol-y + ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). + flux-upL-evol-y + ;; Evolved right negative flux derivative in y-direction f'(u_{j - 1, R+}). + flux-deriv-umR-evol-y + ;; Evolved left/right central flux derivatives in y-direction f'(u_{j, L+}), f(u_{j, R+}). + flux-deriv-uiL-evol-y + flux-deriv-uiR-evol-y + ;; Evolved left positive flux derivative in y-direction f'(u_{j + 1, L+}). + flux-deriv-upL-evol-y + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in x-direction f(u_{i - 1, L}), f(u_{i - 1, R}). + flux-umL-x + flux-umR-x + ;; Left/right central fluxes in x-direction f(u_{i, L}), f(u_{i, R}). + flux-uiL-x + flux-uiR-x + ;; Left/right positive fluxes in x-direction f(u_{i + 1, L}), f(u_{i + 1, R}). + flux-upL-x + flux-upR-x + ;; Evolved right negative flux in x-direction f(u_{i - 1, R+}). + flux-umR-evol-x + ;; Evolved left/right central fluxes in x-direction f(u_{i, L+}), f(u_{i, R+}). + flux-uiL-evol-x + flux-uiR-evol-x + ;; Evolved left positive flux in x-direction f(u_{i + 1, L+}). + flux-upL-evol-x + ;; Evolved right negative flux derivative in x-direction f'(u_{i - 1, R+}). + flux-deriv-umR-evol-x + ;; Evolved left/right central flux derivatives in x-direction f'(u_{i, L+}), f(u_{i, R+}). + flux-deriv-uiL-evol-x + flux-deriv-uiR-evol-x + ;; Evolved left positive flux derivative in x-direction f'(u_{i + 1, L+}). + flux-deriv-upL-evol-x + ;; Expressions for flux limiter function. + limiter-r + ;; Left/right negative fluxes in y-direction f(u_{j - 1, L}), f(u_{j - 1, R}). + flux-umL-y + flux-umR-y + ;; Left/right central fluxes in y-direction f(u_{j, L}), f(u_{j, R}). + flux-uiL-y + flux-uiR-y + ;; Left/right positive fluxes in y-direction f(u_{j + 1, L}), f(u_{j + 1, R}). + flux-upL-y + flux-upR-y + ;; Evolved right negative flux in y-direction f(u_{j - 1, R+}). + flux-umR-evol-y + ;; Evolved left/right central fluxes in y-direction f(u_{j, L+}), f(u_{j, R+}). + flux-uiL-evol-y + flux-uiR-evol-y + ;; Evolved left positive flux in y-direction f(u_{j + 1, L+}). + flux-upL-evol-y + ;; Evolved right negative flux derivative in y-direction f'(u_{j - 1, R+}). + flux-deriv-umR-evol-y + ;; Evolved left/right central flux derivatives in y-direction f'(u_{j, L+}), f(u_{j, R+}). + flux-deriv-uiL-evol-y + flux-deriv-uiR-evol-y + ;; Evolved left positive flux derivative in y-direction f'(u_{j + 1, L+}). + flux-deriv-upL-evol-y + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_core_validation.rkt b/provable-algorithms/neural_networks/code_generator_core_validation.rkt new file mode 100644 index 00000000..909b841f --- /dev/null +++ b/provable-algorithms/neural_networks/code_generator_core_validation.rkt @@ -0,0 +1,976 @@ +#lang racket + +(provide validate-scalar-1d + validate-scalar-1d-second-order + validate-scalar-2d + validate-scalar-2d-second-order) + +;; Lightweight converter from Racket expressions (expr) into strings representing equivalent C code. +(define (convert-expr expr) + (match expr + ;; If expr is a symbol, then convert it directly to a string. + [(? symbol? symb) (symbol->string symb)] + + ;; If expr is a numerical constant, then convert it directly to a string. + [(? number? num) (number->string num)] + + ;; If expr is a sum of the form (+ expr1 expr2 ...), then convert it to "(expr1 + expr2 + ...)" in C. + [`(+ . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " + ") ")"))] + ;; Likewise for differences. + [`(- . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " - ") ")"))] + + ;; If expr is a product of the form (* expr1 expr2 ...), then convert it to "(expr1 * expr2 * ...)" in C. + [`(* . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " * ") ")"))] + ;; Likewise for quotients. + [`(/ . ,terms) + (let ([c-terms (map convert-expr terms)]) + (string-append "(" (string-join c-terms " / ") ")"))] + + ;; If expr is an absolute value of the form (abs expr1), then convert it to "fabs(expr1)" in C. + [`(abs ,arg) + (format "fabs(~a)" (convert-expr arg))] + + ;; If expr is a square root of the form (sqrt expr1), then convert it to "sqrt(expr1)" in C. + [`(sqrt ,arg) + (format "sqrt(~a)" (convert-expr arg))] + + ;; If expr is a maximum of the form (max expr1 expr2), then convert it to "fmax(expr1, expr2)" in C. + [`(max ,arg1 ,arg2) + (format "fmax(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a maximum of the form (max expr1 expr2 expr2), then convert it to "fmax(expr1, expr2, expr3)" in C. + [`(max ,arg1 ,arg2 ,arg3) + (format "fmax3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] + + ;; If expr is a minimum of the form (max expr1 expr2), then convert it to "fmin(expr1, expr2)" in C. + [`(min ,arg1 ,arg2) + (format "fmin(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a minimum of the form (max expr1 expr2 expr2), then convert it to "fmin(expr1, expr2, expr3)" in C. + [`(min ,arg1 ,arg2 ,arg3) + (format "fmin3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] + + ;; If expr is a variable assignment of the form (define expr1 expr2), then convert it to "expr1 = expr2" in C. + [`(define ,arg1 ,arg2) + (format "~a = ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a strict comparison of the form (< expr1 expr2), then convert it to "expr1 < expr2" in C. + [`(< ,arg1 ,arg2) + (format "~a < ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a comparison of the form (<= expr1 expr2), then convert it to "expr1 <= expr2" in C. + [`(<= ,arg1 ,arg2) + (format "~a <= ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a strict comparison of the form (> expr1 expr2), then convert it to "expr1 > expr2" in C. + [`(> ,arg1 ,arg2) + (format "~a > ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a comparison of the form (>= expr1 expr2), then convert it to "expr1 >= expr2" in C. + [`(>= ,arg1 ,arg2) + (format "~a >= ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is an equality comparison of the form (equal? expr1 expr2), then convert it to "expr1 == expr2" in C. + [`(equal? ,arg1 ,arg2) + (format "~a == ~a" (convert-expr arg1) (convert-expr arg2))] + + ;; If expr is a conditional of the form [(cond [cond1 expr1] [else expr2])], then convert it to the ternary operator "(cond1) ? expr1 : expr2" in C. + [`(cond + [,cond1 ,expr1] + [else ,expr2]) + (format "(~a) ? ~a : ~a" (convert-expr cond1) (convert-expr expr1) (convert-expr expr2))])) + +;; A simple boilerplate function for removing bracketed expressions from strings. +(define (remove-bracketed-expressions str) + (regexp-replace* #rx"\\[.*?\\]" str "")) + +;; A simple boilerplate function for removing bracketed expressions from files. +(define (remove-bracketed-expressions-from-file output-file) + (define content + (with-input-from-file output-file + (lambda () + (port->string (current-input-port))))) + (define cleaned + (remove-bracketed-expressions content)) + (with-output-to-file output-file #:exists 'replace + (lambda () + (display cleaned)))) + +(define (flux-substitute flux-expr cons-expr var-name) + (string-replace flux-expr cons-expr var-name)) + +;; ------------------------------------------------------------------------ +;; Validate an Arbitrary (First-Order) Surrogate Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------ +(define (validate-scalar-1d pde neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that validates a surrogate solver for the 1D scalar PDE specified by `pde` using any first-order method, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define cons-code (convert-expr cons-expr)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON SCALAR PDE: ~a +// Validate any first-order surrogate solver for a scalar PDE in 1D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Array for storing solution. + double *u = (double*) malloc((nx + 2) * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[i] = ~a; // init-func in C. + } + + // Load neural network architecture. + kann_t *ann; + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann = kann_load(file_nm); + + fclose(fptr); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + + float *input_data = (float*) malloc(2 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + + output_data = kann_apply1(ann, input_data); + + u[i] = output_data[0]; + + free(input_data); + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[1]; + u[nx + 1] = u[nx]; + + // Output solution to disk. + const char *fmt = \"%s_validation_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr; + fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + } + + fclose(fptr); + + // Increment time. + t += dt; + n += 1; + } + + free(u); + kann_delete(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + ;; PDE name for neural network input. + name + name + ;; Expression for local wave-speed estimate. + max-speed-local + ;; PDE name for file output. + name + name + )) + code) + +;; ------------------------------------------------------------------------- +;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------- +(define (validate-scalar-1d-second-order pde limiter neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Generate C code that validates a surrogate solver for the 1D scalar PDE specified by `pde` using any first-order method with any second-order flux extrapolation + using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define max-speed-expr (hash-ref pde 'max-speed-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + + (define cons-code (convert-expr cons-expr)) + (define max-speed-code (convert-expr max-speed-expr)) + (define init-func-code (convert-expr init-func)) + + (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Validate any first-order surrogate solver for a scalar PDE in 1D, with any second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Array for storing solution. + double *u = (double*) malloc((nx + 4) * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[i] = ~a; // init-func in C. + } + + // Load neural network architecture. + kann_t *ann; + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann = kann_load(file_nm); + + fclose(fptr); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + double local_alpha = ~a; // max-speed-expr in C. + + if (local_alpha > alpha) { + alpha = local_alpha; + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + + float *input_data = (float*) malloc(2 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + + output_data = kann_apply1(ann, input_data); + + u[i] = output_data[0]; + + free(input_data); + } + + // Apply simple boundary conditions (transmissive). + u[0] = u[2]; + u[1] = u[2]; + u[nx + 2] = u[nx + 1]; + u[nx + 3] = u[nx + 1]; + + // Output solution to disk. + const char *fmt = \"%s_validation_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr; + fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[i]); + } + } + + fclose(fptr); + + // Increment time. + t += dt; + n += 1; + } + + free(u); + kann_delete(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + ;; PDE name for neural network input. + name + name + ;; Expression for local wave-speed estimate. + max-speed-local + ;; PDE name for file output. + name + name + )) + code) + +;; ------------------------------------------------------------------------ +;; Validate an Arbitrary (First-Order) Surrogate Solver for a 2D Scalar PDE +;; ------------------------------------------------------------------------ +(define (validate-scalar-2d pde neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that validates a surrogate solver for the 2D scalar PDE specified by `pde` using any first-order method, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define cons-code (convert-expr cons-expr)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON SCALAR PDE: ~a +// Validate any first-order surrogate solver for a scalar PDE in 2D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Array for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * sizeof(double)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][j] = ~a; // init-func in C. + } + } + + // Load neural network architecture. + kann_t *ann; + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann = kann_load(file_nm); + + fclose(fptr); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + float *input_data = (float*) malloc(3 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + input_data[2] = y; + + output_data = kann_apply1(ann, input_data); + + u[i][j] = output_data[0]; + + free(input_data); + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + u[0][j] = u[1][j]; + u[nx + 1][j] = u[nx][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + u[i][0] = u[i][1]; + u[i][ny + 1] = u[i][ny]; + } + + // Output solution to disk. + const char *fmt = \"%s_validation_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr; + fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + } + + fclose(fptr); + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + } + free(u); + kann_delete(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; PDE name for file output. + name + name + )) + code) + +;; ------------------------------------------------------------------------- +;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 2D Scalar PDE +;; ------------------------------------------------------------------------- +(define (validate-scalar-2d-second-order pde limiter neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Generate C code that validates a surrogate solver for the 2D scalar PDE specified by `pde` using any first-order method with any second-order flux extrapolation + using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define name (hash-ref pde 'name)) + (define cons-expr (hash-ref pde 'cons-expr)) + (define max-speed-expr-x (hash-ref pde 'max-speed-expr-x)) + (define max-speed-expr-y (hash-ref pde 'max-speed-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + + (define cons-code (convert-expr cons-expr)) + (define max-speed-code-x (convert-expr max-speed-expr-x)) + (define max-speed-code-y (convert-expr max-speed-expr-y)) + (define init-func-code (convert-expr init-func)) + + (define max-speed-local-x (flux-substitute max-speed-code-x cons-code "u[i][j]")) + (define max-speed-local-y (flux-substitute max-speed-code-y cons-code "u[i][j]")) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON SCALAR PDE: ~a +// FLUX LIMITER: ~a +// Validate any first-order surrogate solver for a scalar PDE in 2D, with any second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Array for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * sizeof(double)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][j] = ~a; // init-func in C. + } + } + + // Load neural network architecture. + kann_t *ann; + const char *fmt = \"%s_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\"); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\"); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann = kann_load(file_nm); + + fclose(fptr); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double local_alpha_x = ~a; // max-speed-expr-x in C. + double local_alpha_y = ~a; // max-speed-expr-y in C. + + if (local_alpha_x > alpha_x) { + alpha_x = local_alpha_x; + } + if (local_alpha_y > alpha_y) { + alpha_y = local_alpha_y; + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j<= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + float *input_data = (float*) malloc(3 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + input_data[2] = y; + + output_data = kann_apply1(ann, input_data); + + u[i][j] = output_data[0]; + + free(input_data); + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + u[0][j] = u[2][j]; + u[1][j] = u[2][j]; + u[nx + 2][j] = u[nx + 1][j]; + u[nx + 3][j] = u[nx + 1][j]; + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + u[i][0] = u[i][2]; + u[i][1] = u[i][2]; + u[i][ny + 2] = u[i][ny + 1]; + u[i][ny + 3] = u[i][ny + 1]; + } + + // Output solution to disk. + const char *fmt = \"%s_validation_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", n); + + FILE *fptr; + fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][j]); + } + } + } + + fclose(fptr); + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + } + free(u); + kann_delete(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). + init-func-code + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + max-speed-local-x + max-speed-local-y + ;; PDE name for file output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_matrix_training.rkt b/provable-algorithms/neural_networks/code_generator_matrix_training.rkt new file mode 100644 index 00000000..905493ce --- /dev/null +++ b/provable-algorithms/neural_networks/code_generator_matrix_training.rkt @@ -0,0 +1,920 @@ +#lang racket + +(require "code_generator_core_training.rkt") +(provide train-lax-friedrichs-vector3-1d + train-lax-friedrichs-vector3-1d-second-order) + +;; ---------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Coupled Vector System of 3 PDEs +;; ---------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-vector3-1d pde-system neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 0.0] + [else 0.0]) + `(cond + [(< x 0.5) 7.5] + [else 2.5]))]) + "Generate C code that trains a surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") + (list-ref cons-codes 1) "um[1]") (list-ref cons-codes 2) "um[2]")) flux-codes)) + (define flux-uis (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") + (list-ref cons-codes 1) "ui[1]") (list-ref cons-codes 2) "ui[2]")) flux-codes)) + (define flux-ups (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") + (list-ref cons-codes 1) "up[1]") (list-ref cons-codes 2) "up[2]")) flux-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 3) + 0]") + (list-ref cons-codes 1) "u[(i * 3) + 1]") (list-ref cons-codes 2) "u[(i * 3) + 2]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 3 PDEs in 1D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * 3 * sizeof(double)); + double *un = (double*) malloc((nx + 2) * 3 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(3 * sizeof(double)); + + double *um = (double*) malloc(3 * sizeof(double)); + double *ui = (double*) malloc(3 * sizeof(double)); + double *up = (double*) malloc(3 * sizeof(double)); + + double *f_um = (double*) malloc(3 * sizeof(double)); + double *f_ui = (double*) malloc(3 * sizeof(double)); + double *f_up = (double*) malloc(3 * sizeof(double)); + + double *fluxL = (double*) malloc(3 * sizeof(double)); + double *fluxR = (double*) malloc(3 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(3 * sizeof(float**)); + float ***output_data = (float***) malloc(3 * sizeof(float**)); + + for (int i = 0; i < 3; i++) { + input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[(i * 3) + 0] = ~a; // init-funcs[0] in C. + u[(i * 3) + 1] = ~a; // init-funcs[1] in C. + u[(i * 3) + 2] = ~a; // init-funcs[2] in C. + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + t_net[i] = kann_layer_input(2); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + local_alpha[2] = ~a; // max-speed-exprs[2] in C. + + for (int j = 0; j < 3; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. + for (int i = 1; i <= nx; i++) { + for (int j = 0; j < 3; j++) { + um[j] = u[((i - 1) * 3) + j]; + ui[j] = u[(i * 3) + j]; + up[j] = u[((i + 1) * 3) + j]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um[0] = ~a; + f_um[1] = ~a; + f_um[2] = ~a; // F(U_{i - 1}). + + f_ui[0] = ~a; + f_ui[1] = ~a; + f_ui[2] = ~a; // F(U_i). + + f_up[0] = ~a; + f_up[1] = ~a; + f_up[2] = ~a; // F(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha * (U_i - U_{i - 1}). + for (int j = 0; j < 3; j++) { + fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * alpha * (ui[j] - um[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha * (U_{i + 1} - U_i). + for (int j = 0; j < 3; j++) { + fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * alpha * (up[j] - ui[j]); + } + + // Update the conserved variable vector. + for (int j = 0; j < 3; j++) { + un[(i * 3) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j < 3; j++) { + u[(i * 3) + j] = un[(i * 3) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 3; j++) { + u[(0 * 3) + j] = u[(1 * 3) + j]; + u[((nx + 1) * 3) + j] = u[(nx * 3) + j]; + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + + for (int j = 0; j < 3; j++) { + input_data[j][(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); + output_data[j][(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); + + input_data[j][(n * nx) + (i - 1)][0] = t; + input_data[j][(n * nx) + (i - 1)][1] = x; + output_data[j][(n * nx) + (i - 1)][0] = u[(i * 3) + j]; + } + } + } + + // Output solution to disk. + for (int j = 0; j < 3; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 3) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 3; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + free(u); + free(un); + + free(local_alpha); + + free(um); + free(ui); + free(up); + + free(f_um); + free(f_ui); + free(f_up); + + free(fluxL); + free(fluxR); + + for (int i = 0; i < 3; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 3; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + (list-ref max-speed-locals 2) + ;; Left flux vector F(u_{i - 1}). + (list-ref flux-ums 0) + (list-ref flux-ums 1) + (list-ref flux-ums 2) + ;; Middle flux vector F(u_i). + (list-ref flux-uis 0) + (list-ref flux-uis 1) + (list-ref flux-uis 2) + ;; Right flux vector F(u_{i + 1}). + (list-ref flux-ups 0) + (list-ref flux-ups 1) + (list-ref flux-ups 2) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-vector3-1d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 0.0] + [else 0.0]) + `(cond + [(< x 0.5) 7.5] + [else 2.5]))]) + "Generate C code that trains a surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method + with a second-order flux extrapolation using the limiter `limiter`, with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") + (list-ref cons-codes 1) "umL[1]") (list-ref cons-codes 2) "umL[2]")) flux-codes)) + (define flux-umRs (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") + (list-ref cons-codes 1) "umR[1]") (list-ref cons-codes 2) "umR[2]")) flux-codes)) + (define flux-uiLs (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") + (list-ref cons-codes 1) "uiL[1]") (list-ref cons-codes 2) "uiL[2]")) flux-codes)) + (define flux-uiRs (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") + (list-ref cons-codes 1) "uiR[1]") (list-ref cons-codes 2) "uiR[2]")) flux-codes)) + (define flux-upLs (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") + (list-ref cons-codes 1) "upL[1]") (list-ref cons-codes 2) "upL[2]")) flux-codes)) + (define flux-upRs (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") + (list-ref cons-codes 1) "upR[1]") (list-ref cons-codes 2) "upR[2]")) flux-codes)) + + (define flux-umR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") + (list-ref cons-codes 1) "umR_evol[1]") (list-ref cons-codes 2) "umR_evol[2]")) flux-codes)) + (define flux-uiL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") + (list-ref cons-codes 1) "uiL_evol[1]") (list-ref cons-codes 2) "uiL_evol[2]")) flux-codes)) + (define flux-uiR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") + (list-ref cons-codes 1) "uiR_evol[1]") (list-ref cons-codes 2) "uiR_evol[2]")) flux-codes)) + (define flux-upL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") + (list-ref cons-codes 1) "upL_evol[1]") (list-ref cons-codes 2) "upL_evol[2]")) flux-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 3) + 0]") + (list-ref cons-codes 1) "u[(i * 3) + 1]") (list-ref cons-codes 2) "u[(i * 3) + 2]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 3 PDEs in 1D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Array for storing slopes. + double *slope = (double*) malloc((nx + 4) * 3 * sizeof(double)); + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * 3 * sizeof(double)); + double *un = (double*) malloc((nx + 4) * 3 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(3 * sizeof(double)); + + double *umL = (double*) malloc(3 * sizeof(double)); + double *umR = (double*) malloc(3 * sizeof(double)); + double *uiL = (double*) malloc(3 * sizeof(double)); + double *uiR = (double*) malloc(3 * sizeof(double)); + double *upL = (double*) malloc(3 * sizeof(double)); + double *upR = (double*) malloc(3 * sizeof(double)); + + double *f_umL = (double*) malloc(3 * sizeof(double)); + double *f_umR = (double*) malloc(3 * sizeof(double)); + double *f_uiL = (double*) malloc(3 * sizeof(double)); + double *f_uiR = (double*) malloc(3 * sizeof(double)); + double *f_upL = (double*) malloc(3 * sizeof(double)); + double *f_upR = (double*) malloc(3 * sizeof(double)); + + double *umR_evol = (double*) malloc(3 * sizeof(double)); + double *uiL_evol = (double*) malloc(3 * sizeof(double)); + double *uiR_evol = (double*) malloc(3 * sizeof(double)); + double *upL_evol = (double*) malloc(3 * sizeof(double)); + + double *f_umR_evol = (double*) malloc(3 * sizeof(double)); + double *f_uiL_evol = (double*) malloc(3 * sizeof(double)); + double *f_uiR_evol = (double*) malloc(3 * sizeof(double)); + double *f_upL_evol = (double*) malloc(3 * sizeof(double)); + + double *fluxL = (double*) malloc(3 * sizeof(double)); + double *fluxR = (double*) malloc(3 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(3 * sizeof(float**)); + float ***output_data = (float***) malloc(3 * sizeof(float**)); + + for (int i = 0; i < 3; i++) { + input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[(i * 3) + 0] = ~a; // init-funcs[0] in C. + u[(i * 3) + 1] = ~a; // init-funcs[1] in C. + u[(i * 3) + 2] = ~a; // init-funcs[2] in C. + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + t_net[i] = kann_layer_input(2); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + local_alpha[2] = ~a; // max-speed-exprs[2] in C. + + for (int j = 0; j < 3; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 0; j < 3; j++) { + double r = (u[(i * 3) + j] - u[((i - 1) * 3) + j]) / (u[((i + 1) * 3) + j] - u[(i * 3) + j]); + double limiter = ~a; // limiter-r in C. + + slope[(i * 3) + j] = limiter * (0.5 * ((u[(i * 3) + j] - u[((i - 1) * 3) + j]) + (u[((i + 1) * 3) + j] - u[(i * 3) + j]))); + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. + for (int i = 2; i <= nx + 1; i++) { + // Extrapolate boundary states. + for (int j = 0; j < 3; j++) { + umL[j] = u[((i - 1) * 3) + j] - (0.5 * slope[((i - 1) * 3) + j]); + umR[j] = u[((i - 1) * 3) + j] + (0.5 * slope[((i - 1) * 3) + j]); + + uiL[j] = u[(i * 3) + j] - (0.5 * slope[(i * 3) + j]); + uiR[j] = u[(i * 3) + j] + (0.5 * slope[(i * 3) + j]); + + upL[j] = u[((i + 1) * 3) + j] - (0.5 * slope[((i + 1) * 3) + j]); + upR[j] = u[((i + 1) * 3) + j] + (0.5 * slope[((i + 1) * 3) + j]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL[0] = ~a; + f_umL[1] = ~a; + f_umL[2] = ~a; + f_umR[0] = ~a; + f_umR[1] = ~a; + f_umR[2] = ~a; + + f_uiL[0] = ~a; + f_uiL[1] = ~a; + f_uiL[2] = ~a; + f_uiR[0] = ~a; + f_uiR[1] = ~a; + f_uiR[2] = ~a; + + f_upL[0] = ~a; + f_upL[1] = ~a; + f_upL[2] = ~a; + f_upR[0] = ~a; + f_upR[1] = ~a; + f_upR[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int j = 0; j < 3; j++) { + umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); + + uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + + upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol[0] = ~a; + f_umR_evol[1] = ~a; + f_umR_evol[2] = ~a; // F(U_{i - 1, R+}) + f_uiL_evol[0] = ~a; + f_uiL_evol[1] = ~a; + f_uiL_evol[2] = ~a; // F(U_{i, L+}) + + f_uiR_evol[0] = ~a; + f_uiR_evol[1] = ~a; + f_uiR_evol[2] = ~a; // F(U_{i, R+}) + f_upL_evol[0] = ~a; + f_upL_evol[1] = ~a; + f_upL_evol[2] = ~a; // F(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha * (U_{i, L+} - U_{i - 1, R+}). + for (int j = 0; j < 3; j++) { + fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * alpha * (uiL_evol[j] - umR_evol[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha * (U_{i + 1, L+} - U_{i, R+}). + for (int j = 0; j < 3; j++) { + fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * alpha * (upL_evol[j] - uiR_evol[j]); + } + + // Update the conserved variable vector. + for (int j = 0; j < 3; j++) { + un[(i * 3) + j] = u[(i * 3) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j < 3; j++) { + u[(i * 3) + j] = un[(i * 3) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 3; j++) { + u[(0 * 3) + j] = u[(2 * 3) + j]; + u[(1 * 3) + j] = u[(2 * 3) + j]; + u[((nx + 2) * 3) + j] = u[((nx + 1) * 3) + j]; + u[((nx + 3) * 3) + j] = u[((nx + 1) * 3) + j]; + } + + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + + for (int j = 0; j < 3; j++) { + input_data[j][(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); + output_data[j][(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); + + input_data[j][(n * nx) + (i - 2)][0] = t; + input_data[j][(n * nx) + (i - 2)][1] = x; + output_data[j][(n * nx) + (i - 2)][0] = u[(i * 3) + j]; + } + } + } + + // Output solution to disk. + for (int j = 0; j < 3; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 3) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 3; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + free(u); + free(un); + free(slope); + + free(local_alpha); + + free(umL); + free(umR); + free(uiL); + free(uiR); + free(upL); + free(upR); + + free(f_umL); + free(f_umR); + free(f_uiL); + free(f_uiR); + free(f_upL); + free(f_upR); + + free(umR_evol); + free(uiL_evol); + free(uiR_evol); + free(upL_evol); + + free(f_umR_evol); + free(f_uiL_evol); + free(f_uiR_evol); + free(f_upL_evol); + + free(fluxL); + free(fluxR); + + for (int i = 0; i < 2; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 2; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + (list-ref max-speed-locals 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left negative flux vector F(U_{i - 1, L}). + (list-ref flux-umLs 0) + (list-ref flux-umLs 1) + (list-ref flux-umLs 2) + ;; Right negative flux vector F(U_{i - 1, R}). + (list-ref flux-umRs 0) + (list-ref flux-umRs 1) + (list-ref flux-umRs 2) + ;; Left central flux vector F(U_{i, L}). + (list-ref flux-uiLs 0) + (list-ref flux-uiLs 1) + (list-ref flux-uiLs 2) + ;; Right central flux vector F(U_{i, R}). + (list-ref flux-uiRs 0) + (list-ref flux-uiRs 1) + (list-ref flux-uiRs 2) + ;; Left positive flux vector F(U_{i + 1, L}). + (list-ref flux-upLs 0) + (list-ref flux-upLs 1) + (list-ref flux-upLs 2) + ;; Right positive flux vector F(U_{i + 1, R}). + (list-ref flux-upRs 0) + (list-ref flux-upRs 1) + (list-ref flux-upRs 2) + ;; Evolved right negative flux vector F(U_{i - 1, R+}). + (list-ref flux-umR-evols 0) + (list-ref flux-umR-evols 1) + (list-ref flux-umR-evols 2) + ;; Evolved left central flux vector F(U_{i, L+}). + (list-ref flux-uiL-evols 0) + (list-ref flux-uiL-evols 1) + (list-ref flux-uiL-evols 2) + ;; Evolved right central flux vector F(U_{i, R+}). + (list-ref flux-uiR-evols 0) + (list-ref flux-uiR-evols 1) + (list-ref flux-uiR-evols 2) + ;; Evolved left positive flux vector F(U_{i + 1, L+}). + (list-ref flux-upL-evols 0) + (list-ref flux-upL-evols 1) + (list-ref flux-upL-evols 2) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_matrix_training_2d.rkt b/provable-algorithms/neural_networks/code_generator_matrix_training_2d.rkt new file mode 100644 index 00000000..83b8d443 --- /dev/null +++ b/provable-algorithms/neural_networks/code_generator_matrix_training_2d.rkt @@ -0,0 +1,1827 @@ +#lang racket + +(require "code_generator_core_training.rkt") +(provide train-lax-friedrichs-vector4-2d + train-lax-friedrichs-vector4-2d-second-order) + +;; ---------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Coupled Vector System of 4 PDEs +;; ---------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-vector4-2d pde-system neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0 + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]))]) + "Generate C code that trains a surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") + (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]") + (list-ref cons-codes 3) "um_x[3]")) flux-codes-x)) + (define flux-uis-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") + (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]") + (list-ref cons-codes 3) "ui_x[3]")) flux-codes-x)) + (define flux-ups-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") + (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]") + (list-ref cons-codes 3) "up_x[3]")) flux-codes-x)) + + (define flux-ums-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") + (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]") + (list-ref cons-codes 3) "um_y[3]")) flux-codes-y)) + (define flux-uis-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") + (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]") + (list-ref cons-codes 3) "ui_y[3]")) flux-codes-y)) + (define flux-ups-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") + (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]") + (list-ref cons-codes 3) "up_y[3]")) flux-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 4) + 0]") + (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") + (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 4) + 0]") + (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") + (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 4 PDEs in 2D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + double **un = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * 4 * sizeof(double)); + un[i] = (double*) malloc((ny + 2) * 4 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(4 * sizeof(double)); + double *local_alpha_y = (double*) malloc(4 * sizeof(double)); + + double *um_x = (double*) malloc(4 * sizeof(double)); + double *ui_x = (double*) malloc(4 * sizeof(double)); + double *up_x = (double*) malloc(4 * sizeof(double)); + + double *f_um_x = (double*) malloc(4 * sizeof(double)); + double *f_ui_x = (double*) malloc(4 * sizeof(double)); + double *f_up_x = (double*) malloc(4 * sizeof(double)); + + double *fluxL_x = (double*) malloc(4 * sizeof(double)); + double *fluxR_x = (double*) malloc(4 * sizeof(double)); + + double *um_y = (double*) malloc(4 * sizeof(double)); + double *ui_y = (double*) malloc(4 * sizeof(double)); + double *up_y = (double*) malloc(4 * sizeof(double)); + + double *f_um_y = (double*) malloc(4 * sizeof(double)); + double *f_ui_y = (double*) malloc(4 * sizeof(double)); + double *f_up_y = (double*) malloc(4 * sizeof(double)); + + double *fluxL_y = (double*) malloc(4 * sizeof(double)); + double *fluxR_y = (double*) malloc(4 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(4 * sizeof(float**)); + float ***output_data = (float***) malloc(4 * sizeof(float**)); + + for (int i = 0; i < 4; i++) { + input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. + u[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. + + un[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. + un[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. + } + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(4 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(4 * sizeof(kann_t*)); + + for (int i = 0; i < 4; i++) { + t_net[i] = kann_layer_input(3); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + local_alpha_x[3] = ~a; // max-speed-exprs-x[3] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + local_alpha_y[3] = ~a; // max-speed-exprs-y[3] in C. + + for (int k = 0; k < 4; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 4; k++) { + um_y[k] = u[i][((j - 1) * 4) + k]; + ui_y[k] = u[i][(j * 4) + k]; + up_y[k] = u[i][((j + 1) * 4) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; + f_um_y[3] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; + f_ui_y[3] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; + f_up_y[3] = ~a; // F(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). + for (int k = 0; k < 4; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). + for (int k = 0; k < 4; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 4; k++) { + un[i][(j * 4) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 4; k++) { + u[i][(j * 4) + k] = un[i][(j * 4) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 4; k++) { + u[0][(j * 4) + k] = u[1][(j * 4) + k]; + u[nx + 1][(j * 4) + k] = u[nx][(j * 4) + k]; + + un[0][(j * 4) + k] = un[1][(j * 4) + k]; + un[nx + 1][(j * 4) + k] = un[nx][(j * 4) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 4; k++) { + u[i][(0 * 4) + k] = u[i][(1 * 4) + k]; + u[i][((ny + 1) * 4) + k] = u[i][(ny * 4) + k]; + + un[i][(0 * 4) + k] = un[i][(1 * 4) + k]; + un[i][((ny + 1) * 4) + k] = un[i][(ny * 4) + k]; + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 4; k++) { + um_x[k] = u[i - 1][(j * 4) + k]; + ui_x[k] = u[i][(j * 4) + k]; + up_x[k] = u[i + 1][(j * 4) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_x[0] = ~a; + f_um_x[1] = ~a; + f_um_x[2] = ~a; + f_um_x[3] = ~a;// F(U_{i - 1}). + + f_ui_x[0] = ~a; + f_ui_x[1] = ~a; + f_ui_x[2] = ~a; + f_ui_x[3] = ~a; // F(U_i). + + f_up_x[0] = ~a; + f_up_x[1] = ~a; + f_up_x[2] = ~a; + f_up_x[3] = ~a; // F(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha_x * (U_i - U_{i - 1}). + for (int k = 0; k < 4; k++) { + fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * alpha_x * (ui_x[k] - um_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha_x * (U_{i + 1} - U_i). + for (int k = 0; k < 4; k++) { + fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * alpha_x * (up_x[k] - ui_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 4; k++) { + un[i][(j * 4) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 4; k++) { + u[i][(j * 4) + k] = un[i][(j * 4) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 4; k++) { + u[0][(j * 4) + k] = u[1][(j * 4) + k]; + u[nx + 1][(j * 4) + k] = u[nx][(j * 4) + k]; + + un[0][(j * 4) + k] = un[1][(j * 4) + k]; + un[nx + 1][(j * 4) + k] = un[nx][(j * 4) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 4; k++) { + u[i][(0 * 4) + k] = u[i][(1 * 4) + k]; + u[i][((ny + 1) * 4) + k] = u[i][(ny * 4) + k]; + + un[i][(0 * 4) + k] = un[i][(1 * 4) + k]; + un[i][((ny + 1) * 4) + k] = un[i][(ny * 4) + k]; + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 4; k++) { + um_y[k] = u[i][((j - 1) * 4) + k]; + ui_y[k] = u[i][(j * 4) + k]; + up_y[k] = u[i][((j + 1) * 4) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; + f_um_y[3] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; + f_ui_y[3] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; + f_up_y[3] = ~a; // F(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). + for (int k = 0; k < 4; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). + for (int k = 0; k < 4; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 4; k++) { + un[i][(j * 4) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 4; k++) { + u[i][(j * 4) + k] = un[i][(j * 4) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 4; k++) { + u[0][(j * 4) + k] = u[1][(j * 4) + k]; + u[nx + 1][(j * 4) + k] = u[nx][(j * 4) + k]; + + un[0][(j * 4) + k] = un[1][(j * 4) + k]; + un[nx + 1][(j * 4) + k] = un[nx][(j * 4) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 4; k++) { + u[i][(0 * 4) + k] = u[i][(1 * 4) + k]; + u[i][((ny + 1) * 4) + k] = u[i][(ny * 4) + k]; + + un[i][(0 * 4) + k] = un[i][(1 * 4) + k]; + un[i][((ny + 1) * 4) + k] = un[i][(ny * 4) + k]; + } + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + for (int k = 0; k < 4; k++) { + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); + output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); + + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; + output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][(j * 4) + k]; + } + } + } + } + + // Output solution to disk. + for (int k = 0; k < 4; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 4) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 4; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 4; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + free(un[i]); + } + free(u); + free(un); + + free(local_alpha_x); + free(local_alpha_y); + + free(um_x); + free(ui_x); + free(up_x); + + free(f_um_x); + free(f_ui_x); + free(f_up_x); + + free(fluxL_x); + free(fluxR_x); + + free(um_y); + free(ui_y); + free(up_y); + + free(f_um_y); + free(f_ui_y); + free(f_up_y); + + free(fluxL_y); + free(fluxR_y); + + for (int i = 0; i < 4; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 4; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 3) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 3) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-x 3) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + (list-ref max-speed-locals-y 3) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-ums-y 3) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-uis-y 3) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + (list-ref flux-ups-y 3) + ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). + (list-ref flux-ums-x 0) + (list-ref flux-ums-x 1) + (list-ref flux-ums-x 2) + (list-ref flux-ums-x 3) + (list-ref flux-uis-x 0) + (list-ref flux-uis-x 1) + (list-ref flux-uis-x 2) + (list-ref flux-uis-x 3) + (list-ref flux-ups-x 0) + (list-ref flux-ups-x 1) + (list-ref flux-ups-x 2) + (list-ref flux-ups-x 3) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-ums-y 3) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-uis-y 3) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + (list-ref flux-ups-y 3) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Coupled Vector System of 4 PDEs with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-vector4-2d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0 + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]))]) + "Generate C code that trains a surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method + with a second-order flux extrapolation using the limiter `limiter`, with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") + (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]") + (list-ref cons-codes 3) "umL_x[3]")) flux-codes-x)) + (define flux-umRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") + (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]") + (list-ref cons-codes 3) "umR_x[3]")) flux-codes-x)) + (define flux-uiLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") + (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]") + (list-ref cons-codes 3) "uiL_x[3]")) flux-codes-x)) + (define flux-uiRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") + (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]") + (list-ref cons-codes 3) "uiR_x[3]")) flux-codes-x)) + (define flux-upLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") + (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]") + (list-ref cons-codes 3) "upL_x[3]")) flux-codes-x)) + (define flux-upRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") + (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]") + (list-ref cons-codes 3) "upR_x[3]")) flux-codes-x)) + + (define flux-umR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") + (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]") + (list-ref cons-codes 3) "umR_evol_x[3]")) flux-codes-x)) + (define flux-uiL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") + (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]") + (list-ref cons-codes 3) "uiL_evol_x[3]")) flux-codes-x)) + (define flux-uiR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") + (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]") + (list-ref cons-codes 3) "uiR_evol_x[3]")) flux-codes-x)) + (define flux-upL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") + (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]") + (list-ref cons-codes 3) "upL_evol_x[3]")) flux-codes-x)) + + (define flux-umLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") + (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]") + (list-ref cons-codes 3) "umL_y[3]")) flux-codes-y)) + (define flux-umRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") + (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umR_y[2]") + (list-ref cons-codes 3) "umR_y[3]")) flux-codes-y)) + (define flux-uiLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") + (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]") + (list-ref cons-codes 3) "uiL_y[3]")) flux-codes-y)) + (define flux-uiRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") + (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]") + (list-ref cons-codes 3) "uiR_y[3]")) flux-codes-y)) + (define flux-upLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") + (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]") + (list-ref cons-codes 3) "upL_y[3]")) flux-codes-y)) + (define flux-upRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") + (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]") + (list-ref cons-codes 3) "upR_y[3]")) flux-codes-y)) + + (define flux-umR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") + (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]") + (list-ref cons-codes 3) "umR_evol_y[3]")) flux-codes-y)) + (define flux-uiL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") + (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]") + (list-ref cons-codes 3) "uiL_evol_y[3]")) flux-codes-y)) + (define flux-uiR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") + (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]") + (list-ref cons-codes 3) "uiR_evol_y[3]")) flux-codes-y)) + (define flux-upL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") + (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]") + (list-ref cons-codes 3) "upL_evol_y[3]")) flux-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 4) + 0]") + (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") + (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 4) + 0]") + (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") + (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 4 PDEs in 2D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing slopes. + double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); + double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + slope_x[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); + slope_y[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); + } + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + double **un = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 4; i++) { + u[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); + un[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(4 * sizeof(double)); + double *local_alpha_y = (double*) malloc(4 * sizeof(double)); + + double *umL_x = (double*) malloc(4 * sizeof(double)); + double *umR_x = (double*) malloc(4 * sizeof(double)); + double *uiL_x = (double*) malloc(4 * sizeof(double)); + double *uiR_x = (double*) malloc(4 * sizeof(double)); + double *upL_x = (double*) malloc(4 * sizeof(double)); + double *upR_x = (double*) malloc(4 * sizeof(double)); + + double *f_umL_x = (double*) malloc(4 * sizeof(double)); + double *f_umR_x = (double*) malloc(4 * sizeof(double)); + double *f_uiL_x = (double*) malloc(4 * sizeof(double)); + double *f_uiR_x = (double*) malloc(4 * sizeof(double)); + double *f_upL_x = (double*) malloc(4 * sizeof(double)); + double *f_upR_x = (double*) malloc(4 * sizeof(double)); + + double *umR_evol_x = (double*) malloc(4 * sizeof(double)); + double *uiL_evol_x = (double*) malloc(4 * sizeof(double)); + double *uiR_evol_x = (double*) malloc(4 * sizeof(double)); + double *upL_evol_x = (double*) malloc(4 * sizeof(double)); + + double *f_umR_evol_x = (double*) malloc(4 * sizeof(double)); + double *f_uiL_evol_x = (double*) malloc(4 * sizeof(double)); + double *f_uiR_evol_x = (double*) malloc(4 * sizeof(double)); + double *f_upL_evol_x = (double*) malloc(4 * sizeof(double)); + + double *fluxL_x = (double*) malloc(4 * sizeof(double)); + double *fluxR_x = (double*) malloc(4 * sizeof(double)); + + double *umL_y = (double*) malloc(4 * sizeof(double)); + double *umR_y = (double*) malloc(4 * sizeof(double)); + double *uiL_y = (double*) malloc(4 * sizeof(double)); + double *uiR_y = (double*) malloc(4 * sizeof(double)); + double *upL_y = (double*) malloc(4 * sizeof(double)); + double *upR_y = (double*) malloc(4 * sizeof(double)); + + double *f_umL_y = (double*) malloc(4 * sizeof(double)); + double *f_umR_y = (double*) malloc(4 * sizeof(double)); + double *f_uiL_y = (double*) malloc(4 * sizeof(double)); + double *f_uiR_y = (double*) malloc(4 * sizeof(double)); + double *f_upL_y = (double*) malloc(4 * sizeof(double)); + double *f_upR_y = (double*) malloc(4 * sizeof(double)); + + double *umR_evol_y = (double*) malloc(4 * sizeof(double)); + double *uiL_evol_y = (double*) malloc(4 * sizeof(double)); + double *uiR_evol_y = (double*) malloc(4 * sizeof(double)); + double *upL_evol_y = (double*) malloc(4 * sizeof(double)); + + double *f_umR_evol_y = (double*) malloc(4 * sizeof(double)); + double *f_uiL_evol_y = (double*) malloc(4 * sizeof(double)); + double *f_uiR_evol_y = (double*) malloc(4 * sizeof(double)); + double *f_upL_evol_y = (double*) malloc(4 * sizeof(double)); + + double *fluxL_y = (double*) malloc(4 * sizeof(double)); + double *fluxR_y = (double*) malloc(4 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(4 * sizeof(float**)); + float ***output_data = (float***) malloc(4 * sizeof(float**)); + + for (int i = 0; i < 4; i++) { + input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. + u[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. + + un[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. + un[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. + } + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(4 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(4 * sizeof(kann_t*)); + + for (int i = 0; i < 4; i++) { + t_net[i] = kann_layer_input(3); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + local_alpha_x[3] = ~a; // max-speed-exprs-x[3] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + local_alpha_y[3] = ~a; // max-speed-exprs-y[3] in C. + + for (int k = 0; k < 4; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 4; k++) { + double r = (u[i][(j * 4) + k] - u[i][((j - 1) * 4) + k]) / (u[i][((j + 1) * 4) + k] - u[i][(j * 4) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 4) + k] = limiter * (0.5 * ((u[i][(j * 4) + k] - u[i][((j - 1) * 4) + k]) + (u[i][((j + 1) * 4) + k] - u[i][(j * 4) + k]))); + } + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 4; k++) { + umL_y[k] = u[i][((j - 1) * 4) + k] - (0.5 * slope_y[i][((j - 1) * 4) + k]); + umR_y[k] = u[i][((j - 1) * 4) + k] + (0.5 * slope_y[i][((j - 1) * 4) + k]); + + uiL_y[k] = u[i][(j * 4) + k] - (0.5 * slope_y[i][(j * 4) + k]); + uiR_y[k] = u[i][(j * 4) + k] + (0.5 * slope_y[i][(j * 4) + k]); + + upL_y[k] = u[i][((j + 1) * 4) + k] - (0.5 * slope_y[i][((j + 1) * 4) + k]); + upR_y[k] = u[i][((j + 1) * 4) + k] + (0.5 * slope_y[i][((j + 1) * 4) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umL_y[3] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + f_umR_y[3] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiL_y[3] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + f_uiR_y[3] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upL_y[3] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + f_upR_y[3] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 4; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; + f_umR_evol_y[3] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; + f_uiL_evol_y[3] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; + f_uiR_evol_y[3] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; + f_upL_evol_y[3] = ~a; // F(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 4; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). + for (int k = 0; k < 4; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 4; k++) { + un[i][(j * 4) + k] = u[i][(j * 4) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 4; k++) { + u[i][(j * 4) + k] = un[i][(j * 4) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 4; k++) { + u[0][(j * 4) + k] = u[2][(j * 4) + k]; + u[1][(j * 4) + k] = u[2][(j * 4) + k]; + u[nx + 2][(j * 4) + k] = u[nx + 1][(j * 4) + k]; + u[nx + 3][(j * 4) + k] = u[nx + 1][(j * 4) + k]; + + un[0][(j * 4) + k] = un[2][(j * 4) + k]; + un[1][(j * 4) + k] = un[2][(j * 4) + k]; + un[nx + 2][(j * 4) + k] = un[nx + 1][(j * 4) + k]; + un[nx + 3][(j * 4) + k] = un[nx + 1][(j * 4) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 4; k++) { + u[i][(0 * 4) + k] = u[i][(2 * 4) + k]; + u[i][(1 * 4) + k] = u[i][(2 * 4) + k]; + u[i][((ny + 2) * 4) + k] = u[i][((ny + 1) * 4) + k]; + u[i][((ny + 3) * 4) + k] = u[i][((ny + 1) * 4) + k]; + + un[i][(0 * 4) + k] = un[i][(2 * 4) + k]; + un[i][(1 * 4) + k] = un[i][(2 * 4) + k]; + un[i][((ny + 2) * 4) + k] = un[i][((ny + 1) * 4) + k]; + un[i][((ny + 3) * 4) + k] = un[i][((ny + 1) * 4) + k]; + } + } + + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 4; k++) { + double r = (u[i][(j * 4) + k] - u[i - 1][(j * 4) + k]) / (u[i + 1][(j * 4) + k] - u[i][(j * 4) + k]); + double limiter = ~a; // limiter-r in C. + + slope_x[i][(j * 4) + k] = limiter * (0.5 * ((u[i][(j * 4) + k] - u[i - 1][(j * 4) + k]) + (u[i + 1][(j * 4) + k] - u[i][(j * 4) + k]))); + } + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 4; k++) { + umL_x[k] = u[i - 1][(j * 4) + k] - (0.5 * slope_x[i - 1][(j * 4) + k]); + umR_x[k] = u[i - 1][(j * 4) + k] + (0.5 * slope_x[i - 1][(j * 4) + k]); + + uiL_x[k] = u[i][(j * 4) + k] - (0.5 * slope_x[i][(j * 4) + k]); + uiR_x[k] = u[i][(j * 4) + k] + (0.5 * slope_x[i][(j * 4) + k]); + + upL_x[k] = u[i + 1][(j * 4) + k] - (0.5 * slope_x[i + 1][(j * 4) + k]); + upR_x[k] = u[i + 1][(j * 4) + k] + (0.5 * slope_x[i + 1][(j * 4) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_x[0] = ~a; + f_umL_x[1] = ~a; + f_umL_x[2] = ~a; + f_umL_x[3] = ~a; + f_umR_x[0] = ~a; + f_umR_x[1] = ~a; + f_umR_x[2] = ~a; + f_umR_x[3] = ~a; + + f_uiL_x[0] = ~a; + f_uiL_x[1] = ~a; + f_uiL_x[2] = ~a; + f_uiL_x[3] = ~a; + f_uiR_x[0] = ~a; + f_uiR_x[1] = ~a; + f_uiR_x[2] = ~a; + f_uiR_x[3] = ~a; + + f_upL_x[0] = ~a; + f_upL_x[1] = ~a; + f_upL_x[2] = ~a; + f_upL_x[3] = ~a; + f_upR_x[0] = ~a; + f_upR_x[1] = ~a; + f_upR_x[2] = ~a; + f_upR_x[3] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 4; k++) { + umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); + + uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + + upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_x[0] = ~a; + f_umR_evol_x[1] = ~a; + f_umR_evol_x[2] = ~a; + f_umR_evol_x[3] = ~a;// F(U_{i - 1, R+}) + f_uiL_evol_x[0] = ~a; + f_uiL_evol_x[1] = ~a; + f_uiL_evol_x[2] = ~a; + f_uiL_evol_x[3] = ~a; // F(U_{i, L+}) + + f_uiR_evol_x[0] = ~a; + f_uiR_evol_x[1] = ~a; + f_uiR_evol_x[2] = ~a; + f_uiR_evol_x[3] = ~a; // F(U_{i, R+}) + f_upL_evol_x[0] = ~a; + f_upL_evol_x[1] = ~a; + f_upL_evol_x[2] = ~a; + f_upL_evol_x[3] = ~a; // F(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha_x * (U_{i, L+} - U_{i - 1, R+}). + for (int k = 0; k < 4; k++) { + fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * alpha_x * (uiL_evol_x[k] - umR_evol_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha_x * (U_{i + 1, L+} - U_{i, R+}). + for (int k = 0; k < 4; k++) { + fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * alpha_x * (upL_evol_x[k] - uiR_evol_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 4; k++) { + un[i][(j * 4) + k] = u[i][(j * 4) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 4; k++) { + u[i][(j * 4) + k] = un[i][(j * 4) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 4; k++) { + u[0][(j * 4) + k] = u[2][(j * 4) + k]; + u[1][(j * 4) + k] = u[2][(j * 4) + k]; + u[nx + 2][(j * 4) + k] = u[nx + 1][(j * 4) + k]; + u[nx + 3][(j * 4) + k] = u[nx + 1][(j * 4) + k]; + + un[0][(j * 4) + k] = un[2][(j * 4) + k]; + un[1][(j * 4) + k] = un[2][(j * 4) + k]; + un[nx + 2][(j * 4) + k] = un[nx + 1][(j * 4) + k]; + un[nx + 3][(j * 4) + k] = un[nx + 1][(j * 4) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 4; k++) { + u[i][(0 * 4) + k] = u[i][(2 * 4) + k]; + u[i][(1 * 4) + k] = u[i][(2 * 4) + k]; + u[i][((ny + 2) * 4) + k] = u[i][((ny + 1) * 4) + k]; + u[i][((ny + 3) * 4) + k] = u[i][((ny + 1) * 4) + k]; + + un[i][(0 * 4) + k] = un[i][(2 * 4) + k]; + un[i][(1 * 4) + k] = un[i][(2 * 4) + k]; + un[i][((ny + 2) * 4) + k] = un[i][((ny + 1) * 4) + k]; + un[i][((ny + 3) * 4) + k] = un[i][((ny + 1) * 4) + k]; + } + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 4; k++) { + double r = (u[i][(j * 4) + k] - u[i][((j - 1) * 4) + k]) / (u[i][((j + 1) * 4) + k] - u[i][(j * 4) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 4) + k] = limiter * (0.5 * ((u[i][(j * 4) + k] - u[i][((j - 1) * 4) + k]) + (u[i][((j + 1) * 4) + k] - u[i][(j * 4) + k]))); + } + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 4; k++) { + umL_y[k] = u[i][((j - 1) * 4) + k] - (0.5 * slope_y[i][((j - 1) * 4) + k]); + umR_y[k] = u[i][((j - 1) * 4) + k] + (0.5 * slope_y[i][((j - 1) * 4) + k]); + + uiL_y[k] = u[i][(j * 4) + k] - (0.5 * slope_y[i][(j * 4) + k]); + uiR_y[k] = u[i][(j * 4) + k] + (0.5 * slope_y[i][(j * 4) + k]); + + upL_y[k] = u[i][((j + 1) * 4) + k] - (0.5 * slope_y[i][((j + 1) * 4) + k]); + upR_y[k] = u[i][((j + 1) * 4) + k] + (0.5 * slope_y[i][((j + 1) * 4) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umL_y[3] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + f_umR_y[3] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiL_y[3] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + f_uiR_y[3] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upL_y[3] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + f_upR_y[3] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 4; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; + f_umR_evol_y[3] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; + f_uiL_evol_y[3] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; + f_uiR_evol_y[3] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; + f_upL_evol_y[3] = ~a; // F(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 4; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). + for (int k = 0; k < 4; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 4; k++) { + un[i][(j * 4) + k] = u[i][(j * 4) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 4; k++) { + u[i][(j * 4) + k] = un[i][(j * 4) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 4; k++) { + u[0][(j * 4) + k] = u[2][(j * 4) + k]; + u[1][(j * 4) + k] = u[2][(j * 4) + k]; + u[nx + 2][(j * 4) + k] = u[nx + 1][(j * 4) + k]; + u[nx + 3][(j * 4) + k] = u[nx + 1][(j * 4) + k]; + + un[0][(j * 4) + k] = un[2][(j * 4) + k]; + un[1][(j * 4) + k] = un[2][(j * 4) + k]; + un[nx + 2][(j * 4) + k] = un[nx + 1][(j * 4) + k]; + un[nx + 3][(j * 4) + k] = un[nx + 1][(j * 4) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 4; k++) { + u[i][(0 * 4) + k] = u[i][(2 * 4) + k]; + u[i][(1 * 4) + k] = u[i][(2 * 4) + k]; + u[i][((ny + 2) * 4) + k] = u[i][((ny + 1) * 4) + k]; + u[i][((ny + 3) * 4) + k] = u[i][((ny + 1) * 4) + k]; + + un[i][(0 * 4) + k] = un[i][(2 * 4) + k]; + un[i][(1 * 4) + k] = un[i][(2 * 4) + k]; + un[i][((ny + 2) * 4) + k] = un[i][((ny + 1) * 4) + k]; + un[i][((ny + 3) * 4) + k] = un[i][((ny + 1) * 4) + k]; + } + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + for (int k = 0; k < 4; k++) { + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); + output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); + + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; + output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][(j * 4) + k]; + } + } + } + } + + // Output solution to disk. + for (int k = 0; k < 4; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 4) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 4; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 4; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + free(un[i]); + free(slope_x[i]); + free(slope_y[i]); + } + free(u); + free(un); + free(slope_x); + free(slope_y); + + free(local_alpha_x); + free(local_alpha_y); + + free(umL_x); + free(umR_x); + free(uiL_x); + free(uiR_x); + free(upL_x); + free(upR_x); + + free(f_umL_x); + free(f_umR_x); + free(f_uiL_x); + free(f_uiR_x); + free(f_upL_x); + free(f_upR_x); + + free(umR_evol_x); + free(uiL_evol_x); + free(uiR_evol_x); + free(upL_evol_x); + + free(f_umR_evol_x); + free(f_uiL_evol_x); + free(f_uiR_evol_x); + free(f_upL_evol_x); + + free(fluxL_x); + free(fluxR_x); + + free(umL_y); + free(umR_y); + free(uiL_y); + free(uiR_y); + free(upL_y); + free(upR_y); + + free(f_umL_y); + free(f_umR_y); + free(f_uiL_y); + free(f_uiR_y); + free(f_upL_y); + free(f_upR_y); + + free(umR_evol_y); + free(uiL_evol_y); + free(uiR_evol_y); + free(upL_evol_y); + + free(f_umR_evol_y); + free(f_uiL_evol_y); + free(f_uiR_evol_y); + free(f_upL_evol_y); + + free(fluxL_y); + free(fluxR_y); + + for (int i = 0; i < 4; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 4; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 3) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 3) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-x 3) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + (list-ref max-speed-locals-y 3) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umLs-y 3) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + (list-ref flux-umRs-y 3) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiLs-y 3) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + (list-ref flux-uiRs-y 3) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upLs-y 3) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + (list-ref flux-upRs-y 3) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-umR-evols-y 3) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + (list-ref flux-uiL-evols-y 3) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-uiR-evols-y 3) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + (list-ref flux-upL-evols-y 3) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). + (list-ref flux-umLs-x 0) + (list-ref flux-umLs-x 1) + (list-ref flux-umLs-x 2) + (list-ref flux-umLs-x 3) + (list-ref flux-umRs-x 0) + (list-ref flux-umRs-x 1) + (list-ref flux-umRs-x 2) + (list-ref flux-umRs-x 3) + ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). + (list-ref flux-uiLs-x 0) + (list-ref flux-uiLs-x 1) + (list-ref flux-uiLs-x 2) + (list-ref flux-uiLs-x 3) + (list-ref flux-uiRs-x 0) + (list-ref flux-uiRs-x 1) + (list-ref flux-uiRs-x 2) + (list-ref flux-uiRs-x 3) + ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). + (list-ref flux-upLs-x 0) + (list-ref flux-upLs-x 1) + (list-ref flux-upLs-x 2) + (list-ref flux-upLs-x 3) + (list-ref flux-upRs-x 0) + (list-ref flux-upRs-x 1) + (list-ref flux-upRs-x 2) + (list-ref flux-upRs-x 3) + ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). + (list-ref flux-umR-evols-x 0) + (list-ref flux-umR-evols-x 1) + (list-ref flux-umR-evols-x 2) + (list-ref flux-umR-evols-x 3) + (list-ref flux-uiL-evols-x 0) + (list-ref flux-uiL-evols-x 1) + (list-ref flux-uiL-evols-x 2) + (list-ref flux-uiL-evols-x 3) + ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). + (list-ref flux-uiR-evols-x 0) + (list-ref flux-uiR-evols-x 1) + (list-ref flux-uiR-evols-x 2) + (list-ref flux-uiR-evols-x 3) + (list-ref flux-upL-evols-x 0) + (list-ref flux-upL-evols-x 1) + (list-ref flux-upL-evols-x 2) + (list-ref flux-upL-evols-x 3) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umLs-y 3) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + (list-ref flux-umRs-y 3) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiLs-y 3) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + (list-ref flux-uiRs-y 3) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upLs-y 3) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + (list-ref flux-upRs-y 3) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-umR-evols-y 3) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + (list-ref flux-uiL-evols-y 3) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-uiR-evols-y 3) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + (list-ref flux-upL-evols-y 3) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_matrix_validation.rkt b/provable-algorithms/neural_networks/code_generator_matrix_validation.rkt new file mode 100644 index 00000000..ba40a026 --- /dev/null +++ b/provable-algorithms/neural_networks/code_generator_matrix_validation.rkt @@ -0,0 +1,1074 @@ +#lang racket + +(require "code_generator_core_training.rkt") +(require "code_generator_core_validation.rkt") +(provide validate-vector3-1d + validate-vector3-1d-second-order + validate-vector4-2d + validate-vector4-2d-second-order) + +;; --------------------------------------------------------------------------------------------- +;; Validate an Arbitrary (First-Order) Surrogate Solver for a 1D Coupled Vector System of 3 PDEs +;; --------------------------------------------------------------------------------------------- +(define (validate-vector3-1d pde-system neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 0.0] + [else 0.0]) + `(cond + [(< x 0.5) 7.5] + [else 2.5]))]) + "Generate C code that validates a surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde` using any first-order method, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 3) + 0]") + (list-ref cons-codes 1) "u[(i * 3) + 1]") (list-ref cons-codes 2) "u[(i * 3) + 2]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a +// Validate any first-order surrogate solver for a coupled vector system of 3 PDEs in 1D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * 3 * sizeof(double)); + double *un = (double*) malloc((nx + 2) * 3 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(3 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[(i * 3) + 0] = ~a; // init-funcs[0] in C. + u[(i * 3) + 1] = ~a; // init-funcs[1] in C. + u[(i * 3) + 2] = ~a; // init-funcs[2] in C. + } + + // Load neural network architecture. + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann[i] = kann_load(file_nm); + + fclose(fptr); + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + local_alpha[2] = ~a; // max-speed-exprs[2] in C. + + for (int j = 0; j < 3; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 1; i <= nx; i++) { + for (int j = 0; j < 3; j++) { + double x = x0 + (i - 0.5) * dx; + + float *input_data = (float*) malloc(2 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + + output_data = kann_apply1(ann[j], input_data); + + u[(i * 3) + j] = output_data[0]; + + free(input_data); + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 3; j++) { + u[(0 * 3) + j] = u[(1 * 3) + j]; + u[((nx + 1) * 3) + j] = u[(nx * 3) + j]; + } + + // Output solution to disk. + for (int j = 0; j < 3; j++) { + const char *fmt = \"%s_validation_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr; + fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 3) + j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(local_alpha); + + for (int i = 0; i < 3; i++) { + kann_delete(ann[i]); + } + free(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + (list-ref max-speed-locals 2) + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------- +;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 1D Coupled Vector System of 3 PDEs +;; ---------------------------------------------------------------------------------------------- +(define (validate-vector3-1d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 0.0] + [else 0.0]) + `(cond + [(< x 0.5) 7.5] + [else 2.5]))]) + "Generate C code that validates a surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde` using any first-order method + with any second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 3) + 0]") + (list-ref cons-codes 1) "u[(i * 3) + 1]") (list-ref cons-codes 2) "u[(i * 3) + 2]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Validate any first-order surrogate solver for a coupled vector system of 3 PDEs in 1D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * 3 * sizeof(double)); + double *un = (double*) malloc((nx + 4) * 3 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(3 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[(i * 3) + 0] = ~a; // init-funcs[0] in C. + u[(i * 3) + 1] = ~a; // init-funcs[1] in C. + u[(i * 3) + 2] = ~a; // init-funcs[2] in C. + } + + // Load neural network architecture. + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann[i] = kann_load(file_nm); + + fclose(fptr); + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx + 2; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + local_alpha[2] = ~a; // max-speed-exprs[2] in C. + + for (int j = 0; j < 3; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 0; j < 3; j++) { + double x = x0 + (i - 1.5) * dx; + + float *input_data = (float*) malloc(2 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + + output_data = kann_apply1(ann[j], input_data); + + u[(i * 3) + j] = output_data[0]; + + free(input_data); + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 3; j++) { + u[(0 * 3) + j] = u[(2 * 3) + j]; + u[(1 * 3) + j] = u[(2 * 3) + j]; + u[((nx + 2) * 3) + j] = u[((nx + 1) * 3) + j]; + u[((nx + 3) * 3) + j] = u[((nx + 1) * 3) + j]; + } + + // Output solution to disk. + for (int j = 0; j < 3; j++) { + const char *fmt = \"%s_validation_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr; + fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 3) + j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(local_alpha); + + for (int i = 0; i < 3; i++) { + kann_delete(ann[i]); + } + free(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + (list-ref max-speed-locals 2) + ;; PDE name for file output. + name + name + )) + code) + +;; --------------------------------------------------------------------------------------------- +;; Validate an Arbitrary (First-Order) Surrogate Solver for a 2D Coupled Vector System of 4 PDEs +;; --------------------------------------------------------------------------------------------- +(define (validate-vector4-2d pde-system neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0 + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]))]) + "Generate C code that validates a surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde` using any first-order method, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 4) + 0]") + (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") + (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 4) + 0]") + (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") + (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a +// Validate any first-order surrogate solver for a coupled vector system of 4 PDEs in 2D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * 4 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(4 * sizeof(double)); + double *local_alpha_y = (double*) malloc(4 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. + u[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. + } + } + + // Load neural network architecture. + kann_t **ann = (kann_t**) malloc(4 * sizeof(kann_t*)); + + for (int i = 0; i < 4; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann[i] = kann_load(file_nm); + + fclose(fptr); + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + local_alpha_x[3] = ~a; // max-speed-exprs-x[3] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + local_alpha_y[3] = ~a; // max-speed-exprs-y[3] in C. + + for (int k = 0; k < 4; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 4; k++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - -.5) * dy; + + float *input_data = (float*) malloc(4 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + input_data[2] = y; + + output_data = kann_apply1(ann[k], input_data); + + u[i][(j * 4) + k] = output_data[0]; + + free(input_data); + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 4; k++) { + u[0][(j * 4) + k] = u[1][(j * 4) + k]; + u[nx + 1][(j * 4) + k] = u[nx][(j * 4) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 4; k++) { + u[i][(0 * 4) + k] = u[i][(1 * 4) + k]; + u[i][((ny + 1) * 4) + k] = u[i][(ny * 4) + k]; + } + } + + // Output solution to disk. + for (int k = 0; k < 4; k++) { + const char *fmt = \"%s_validation_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 4) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + } + free(u); + + free(local_alpha_x); + free(local_alpha_y); + + for (int i = 0; i < 4; i++) { + kann_delete(ann[i]); + } + free(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 3) + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-x 3) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + (list-ref max-speed-locals-y 3) + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------- +;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 2D Coupled Vector System of 4 PDEs +;; ---------------------------------------------------------------------------------------------- +(define (validate-vector4-2d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0 + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]))]) + "Generate C code that validates a surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde` using any first-order method + with any second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 4) + 0]") + (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") + (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 4) + 0]") + (list-ref cons-codes 1) "u[i][(j * 4) + 1]") (list-ref cons-codes 2) "u[i][(j * 4) + 2]") + (list-ref cons-codes 3) "u[i][(j * 4) + 3]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Validate any first-order surrogate solver for a coupled vector system of 4 PDEs in 2D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * 4 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(4 * sizeof(double)); + double *local_alpha_y = (double*) malloc(4 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][(j * 4) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 4) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 4) + 2] = ~a; // init-funcs[2] in C. + u[i][(j * 4) + 3] = ~a; // init-funcs[3] in C. + } + } + + // Load neural network architecture. + kann_t **ann = (kann_t**) malloc(4 * sizeof(kann_t*)); + + for (int i = 0; i < 4; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann[i] = kann_load(file_nm); + + fclose(fptr); + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + local_alpha_x[3] = ~a; // max-speed-exprs-x[3] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + local_alpha_y[3] = ~a; // max-speed-exprs-y[3] in C. + + for (int k = 0; k < 4; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + for (int k = 0; k < 4; k++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + float *input_data = (float*) malloc(4 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + input_data[2] = y; + + output_data = kann_apply1(ann[k], input_data); + + u[i][(j * 4) + k] = output_data[0]; + + free(input_data); + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 4; k++) { + u[0][(j * 4) + k] = u[2][(j * 4) + k]; + u[1][(j * 4) + k] = u[2][(j * 4) + k]; + u[nx + 2][(j * 4) + k] = u[nx + 1][(j * 4) + k]; + u[nx + 3][(j * 4) + k] = u[nx + 1][(j * 4) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 4; k++) { + u[i][(0 * 4) + k] = u[i][(2 * 4) + k]; + u[i][(1 * 4) + k] = u[i][(2 * 4) + k]; + u[i][((ny + 2) * 4) + k] = u[i][((ny + 1) * 4) + k]; + u[i][((ny + 3) * 4) + k] = u[i][((ny + 1) * 4) + k]; + } + } + + // Output solution to disk. + for (int k = 0; k < 4; k++) { + const char *fmt = \"%s_validation_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 4) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 4; i++) { + free(u[i]); + } + free(u); + + free(local_alpha_x); + free(local_alpha_y); + + for (int i = 0; i < 4; i++) { + kann_delete(ann[i]); + } + free(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 3) + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-x 3) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + (list-ref max-speed-locals-y 3) + ;; PDE name for file output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_vector_training.rkt b/provable-algorithms/neural_networks/code_generator_vector_training.rkt new file mode 100644 index 00000000..f7996c3d --- /dev/null +++ b/provable-algorithms/neural_networks/code_generator_vector_training.rkt @@ -0,0 +1,1888 @@ +#lang racket + +(require "prover_vector.rkt") +(require "code_generator_core_training.rkt") +(provide train-lax-friedrichs-vector2-1d + train-lax-friedrichs-vector2-1d-second-order + train-roe-vector2-1d + train-roe-vector2-1d-second-order) + +;; ---------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs +;; ---------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-vector2-1d pde-system neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that trains a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") + (list-ref cons-codes 1) "um[1]")) flux-codes)) + (define flux-uis (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") + (list-ref cons-codes 1) "ui[1]")) flux-codes)) + (define flux-ups (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") + (list-ref cons-codes 1) "up[1]")) flux-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 2 PDEs in 1D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); + double *un = (double*) malloc((nx + 2) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + double *um = (double*) malloc(2 * sizeof(double)); + double *ui = (double*) malloc(2 * sizeof(double)); + double *up = (double*) malloc(2 * sizeof(double)); + + double *f_um = (double*) malloc(2 * sizeof(double)); + double *f_ui = (double*) malloc(2 * sizeof(double)); + double *f_up = (double*) malloc(2 * sizeof(double)); + + double *fluxL = (double*) malloc(2 * sizeof(double)); + double *fluxR = (double*) malloc(2 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(2 * sizeof(float**)); + float ***output_data = (float***) malloc(2 * sizeof(float**)); + + for (int i = 0; i < 2; i++) { + input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + un[(i * 2) + 0] = ~a; // init-funcs[0] in C. + un[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(2 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); + + for (int i = 0; i < 2; i++) { + t_net[i] = kann_layer_input(2); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. + for (int i = 1; i <= nx; i++) { + for (int j = 0; j < 2; j++) { + um[j] = u[((i - 1) * 2) + j]; + ui[j] = u[(i * 2) + j]; + up[j] = u[((i + 1) * 2) + j]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um[0] = ~a; + f_um[1] = ~a; // F(U_{i - 1}). + + f_ui[0] = ~a; + f_ui[1] = ~a; // F(U_i). + + f_up[0] = ~a; + f_up[1] = ~a; // F(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha * (U_i - U_{i - 1}). + for (int j = 0; j < 2; j++) { + fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * alpha * (ui[j] - um[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha * (U_{i + 1} - U_i). + for (int j = 0; j < 2; j++) { + fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * alpha * (up[j] - ui[j]); + } + + // Update the conserved variable vector. + for (int j = 0; j < 2; j++) { + un[(i * 2) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j < 2; j++) { + u[(i * 2) + j] = un[(i * 2) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(1 * 2) + j]; + u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + + for (int j = 0; j < 2; j++) { + input_data[j][(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); + output_data[j][(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); + + input_data[j][(n * nx) + (i - 1)][0] = t; + input_data[j][(n * nx) + (i - 1)][1] = x; + output_data[j][(n * nx) + (i - 1)][0] = u[(i * 2) + j]; + } + } + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 2; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 2; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + free(u); + free(un); + + free(local_alpha); + + free(um); + free(ui); + free(up); + + free(f_um); + free(f_ui); + free(f_up); + + free(fluxL); + free(fluxR); + + for (int i = 0; i < 2; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 2; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; Left flux vector F(u_{i - 1}). + (list-ref flux-ums 0) + (list-ref flux-ums 1) + ;; Middle flux vector F(u_i). + (list-ref flux-uis 0) + (list-ref flux-uis 1) + ;; Right flux vector F(u_{i + 1}). + (list-ref flux-ups 0) + (list-ref flux-ups 1) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-vector2-1d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that trains a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method + with a second-order flux extrapolation using the limiter `limiter`, with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") + (list-ref cons-codes 1) "umL[1]")) flux-codes)) + (define flux-umRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") + (list-ref cons-codes 1) "umR[1]")) flux-codes)) + (define flux-uiLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") + (list-ref cons-codes 1) "uiL[1]")) flux-codes)) + (define flux-uiRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") + (list-ref cons-codes 1) "uiR[1]")) flux-codes)) + (define flux-upLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") + (list-ref cons-codes 1) "upL[1]")) flux-codes)) + (define flux-upRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") + (list-ref cons-codes 1) "upR[1]")) flux-codes)) + + (define flux-umR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") + (list-ref cons-codes 1) "umR_evol[1]")) flux-codes)) + (define flux-uiL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") + (list-ref cons-codes 1) "uiL_evol[1]")) flux-codes)) + (define flux-uiR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") + (list-ref cons-codes 1) "uiR_evol[1]")) flux-codes)) + (define flux-upL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") + (list-ref cons-codes 1) "upL_evol[1]")) flux-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Array for storing slopes. + double *slope = (double*) malloc((nx + 4) * 2 * sizeof(double)); + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); + double *un = (double*) malloc((nx + 4) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + double *umL = (double*) malloc(2 * sizeof(double)); + double *umR = (double*) malloc(2 * sizeof(double)); + double *uiL = (double*) malloc(2 * sizeof(double)); + double *uiR = (double*) malloc(2 * sizeof(double)); + double *upL = (double*) malloc(2 * sizeof(double)); + double *upR = (double*) malloc(2 * sizeof(double)); + + double *f_umL = (double*) malloc(2 * sizeof(double)); + double *f_umR = (double*) malloc(2 * sizeof(double)); + double *f_uiL = (double*) malloc(2 * sizeof(double)); + double *f_uiR = (double*) malloc(2 * sizeof(double)); + double *f_upL = (double*) malloc(2 * sizeof(double)); + double *f_upR = (double*) malloc(2 * sizeof(double)); + + double *umR_evol = (double*) malloc(2 * sizeof(double)); + double *uiL_evol = (double*) malloc(2 * sizeof(double)); + double *uiR_evol = (double*) malloc(2 * sizeof(double)); + double *upL_evol = (double*) malloc(2 * sizeof(double)); + + double *f_umR_evol = (double*) malloc(2 * sizeof(double)); + double *f_uiL_evol = (double*) malloc(2 * sizeof(double)); + double *f_uiR_evol = (double*) malloc(2 * sizeof(double)); + double *f_upL_evol = (double*) malloc(2 * sizeof(double)); + + double *fluxL = (double*) malloc(2 * sizeof(double)); + double *fluxR = (double*) malloc(2 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(2 * sizeof(float**)); + float ***output_data = (float***) malloc(2 * sizeof(float**)); + + for (int i = 0; i < 2; i++) { + input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + un[(i * 2) + 0] = ~a; // init-funcs[0] in C. + un[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(2 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); + + for (int i = 0; i < 2; i++) { + t_net[i] = kann_layer_input(2); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 0; j < 2; j++) { + double r = (u[(i * 2) + j] - u[((i - 1) * 2) + j]) / (u[((i + 1) * 2) + j] - u[(i * 2) + j]); + double limiter = ~a; // limiter-r in C. + + slope[(i * 2) + j] = limiter * (0.5 * ((u[(i * 2) + j] - u[((i - 1) * 2) + j]) + (u[((i + 1) * 2) + j] - u[(i * 2) + j]))); + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. + for (int i = 2; i <= nx + 1; i++) { + // Extrapolate boundary states. + for (int j = 0; j < 2; j++) { + umL[j] = u[((i - 1) * 2) + j] - (0.5 * slope[((i - 1) * 2) + j]); + umR[j] = u[((i - 1) * 2) + j] + (0.5 * slope[((i - 1) * 2) + j]); + + uiL[j] = u[(i * 2) + j] - (0.5 * slope[(i * 2) + j]); + uiR[j] = u[(i * 2) + j] + (0.5 * slope[(i * 2) + j]); + + upL[j] = u[((i + 1) * 2) + j] - (0.5 * slope[((i + 1) * 2) + j]); + upR[j] = u[((i + 1) * 2) + j] + (0.5 * slope[((i + 1) * 2) + j]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL[0] = ~a; + f_umL[1] = ~a; + f_umR[0] = ~a; + f_umR[1] = ~a; + + f_uiL[0] = ~a; + f_uiL[1] = ~a; + f_uiR[0] = ~a; + f_uiR[1] = ~a; + + f_upL[0] = ~a; + f_upL[1] = ~a; + f_upR[0] = ~a; + f_upR[1] = ~a; + + // Evolve each extrapolated boundary state. + for (int j = 0; j < 2; j++) { + umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); + + uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + + upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol[0] = ~a; + f_umR_evol[1] = ~a; // F(U_{i - 1, R+}) + f_uiL_evol[0] = ~a; + f_uiL_evol[1] = ~a; // F(U_{i, L+}) + + f_uiR_evol[0] = ~a; + f_uiR_evol[1] = ~a; // F(U_{i, R+}) + f_upL_evol[0] = ~a; + f_upL_evol[1] = ~a; // F(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha * (U_{i, L+} - U_{i - 1, R+}). + for (int j = 0; j < 2; j++) { + fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * alpha * (uiL_evol[j] - umR_evol[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha * (U_{i + 1, L+} - U_{i, R+}). + for (int j = 0; j < 2; j++) { + fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * alpha * (upL_evol[j] - uiR_evol[j]); + } + + // Update the conserved variable vector. + for (int j = 0; j < 2; j++) { + un[(i * 2) + j] = u[(i * 2) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j < 2; j++) { + u[(i * 2) + j] = un[(i * 2) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(2 * 2) + j]; + u[(1 * 2) + j] = u[(2 * 2) + j]; + u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; + u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + + for (int j = 0; j < 2; j++) { + input_data[j][(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); + output_data[j][(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); + + input_data[j][(n * nx) + (i - 2)][0] = t; + input_data[j][(n * nx) + (i - 2)][1] = x; + output_data[j][(n * nx) + (i - 2)][0] = u[(i * 2) + j]; + } + } + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 2; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 2; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + free(u); + free(un); + free(slope); + + free(local_alpha); + + free(umL); + free(umR); + free(uiL); + free(uiR); + free(upL); + free(upR); + + free(f_umL); + free(f_umR); + free(f_uiL); + free(f_uiR); + free(f_upL); + free(f_upR); + + free(umR_evol); + free(uiL_evol); + free(uiR_evol); + free(upL_evol); + + free(f_umR_evol); + free(f_uiL_evol); + free(f_uiR_evol); + free(f_upL_evol); + + free(fluxL); + free(fluxR); + + for (int i = 0; i < 2; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 2; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; Expression for flux limiter function. + limiter-r + ;; Left negative flux vector F(U_{i - 1, L}). + (list-ref flux-umLs 0) + (list-ref flux-umLs 1) + ;; Right negative flux vector F(U_{i - 1, R}). + (list-ref flux-umRs 0) + (list-ref flux-umRs 1) + ;; Left central flux vector F(U_{i, L}). + (list-ref flux-uiLs 0) + (list-ref flux-uiLs 1) + ;; Right central flux vector F(U_{i, R}). + (list-ref flux-uiRs 0) + (list-ref flux-uiRs 1) + ;; Left positive flux vector F(U_{i + 1, L}). + (list-ref flux-upLs 0) + (list-ref flux-upLs 1) + ;; Right positive flux vector F(U_{i + 1, R}). + (list-ref flux-upRs 0) + (list-ref flux-upRs 1) + ;; Evolved right negative flux vector F(U_{i - 1, R+}). + (list-ref flux-umR-evols 0) + (list-ref flux-umR-evols 1) + ;; Evolved left central flux vector F(U_{i, L+}). + (list-ref flux-uiL-evols 0) + (list-ref flux-uiL-evols 1) + ;; Evolved right central flux vector F(U_{i, R+}). + (list-ref flux-uiR-evols 0) + (list-ref flux-uiR-evols 1) + ;; Evolved left positive flux vector F(U_{i + 1, L+}). + (list-ref flux-upL-evols 0) + (list-ref flux-upL-evols 1) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------- +;; Train a Roe (Finite-Volume) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs +;; ------------------------------------------------------------------------------------- +(define (train-roe-vector2-1d pde-system neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that trains a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define flux-deriv-codes (map (lambda (flux-deriv-expr) + (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") + (list-ref cons-codes 1) "um[1]")) flux-codes)) + (define flux-uis (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") + (list-ref cons-codes 1) "ui[1]")) flux-codes)) + (define flux-ups (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") + (list-ref cons-codes 1) "up[1]")) flux-codes)) + + (define flux-deriv-ums (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "um[0]") + (list-ref cons-codes 1) "um[1]")) flux-deriv-codes)) + (define flux-deriv-uis (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "ui[0]") + (list-ref cons-codes 1) "ui[1]")) flux-deriv-codes)) + (define flux-deriv-ups (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "up[0]") + (list-ref cons-codes 1) "up[1]")) flux-deriv-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// Train a Roe higher-order finite-volume surrogate solver for a coupled vector system of 2 PDEs in 1D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); + double *un = (double*) malloc((nx + 2) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + double *um = (double*) malloc(2 * sizeof(double)); + double *ui = (double*) malloc(2 * sizeof(double)); + double *up = (double*) malloc(2 * sizeof(double)); + + double *f_um = (double*) malloc(2 * sizeof(double)); + double *f_ui = (double*) malloc(2 * sizeof(double)); + double *f_up = (double*) malloc(2 * sizeof(double)); + + double *f_deriv_um = (double*) malloc(2 * sizeof(double)); + double *f_deriv_ui = (double*) malloc(2 * sizeof(double)); + double *f_deriv_up = (double*) malloc(2 * sizeof(double)); + + double *aL_roe = (double*) malloc(2 * sizeof(double)); + double *aR_roe = (double*) malloc(2 * sizeof(double)); + + double *fluxL = (double*) malloc(2 * sizeof(double)); + double *fluxR = (double*) malloc(2 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(2 * sizeof(float**)); + float ***output_data = (float***) malloc(2 * sizeof(float**)); + + for (int i = 0; i < 2; i++) { + input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + un[(i * 2) + 0] = ~a; // init-funcs[0] in C. + un[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(2 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); + + for (int i = 0; i < 2; i++) { + t_net[i] = kann_layer_input(2); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Roe approximation and update the conserved variable vector. + for (int i = 1; i <= nx; i++) { + for (int j = 0; j < 2; j++) { + um[j] = u[((i - 1) * 2) + j]; + ui[j] = u[(i * 2) + j]; + up[j] = u[((i + 1) * 2) + j]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um[0] = ~a; + f_um[1] = ~a; // F(U_{i - 1}). + + f_ui[0] = ~a; + f_ui[1] = ~a; // F(U_i). + + f_up[0] = ~a; + f_up[1] = ~a; // F(U_{i + 1}). + + // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. + f_deriv_um[0] = ~a; + f_deriv_um[1] = ~a; // Eigenvalues of F'(U_{i - 1}). + + f_deriv_ui[0] = ~a; + f_deriv_ui[1] = ~a; // Eigenvalues of F'(U_i). + + f_deriv_up[0] = ~a; + f_deriv_up[1] = ~a; // Eigenvalues of F'(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * |aL_roe| * (U_i - U_{i - 1}). + for (int j = 0; j < 2; j++) { + aL_roe[j] = 0.5 * (f_deriv_um[j] + f_deriv_ui[j]); + } + for (int j = 0; j < 2; j++) { + fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * fabs(aL_roe[j]) * (ui[j] - um[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * |aR_roe| * (U_{i + 1} - u_i). + for (int j = 0; j < 2; j++) { + aR_roe[j] = 0.5 * (f_deriv_ui[j] + f_deriv_up[j]); + } + for (int j = 0; j < 2; j++) { + fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * fabs(aR_roe[j]) * (up[j] - ui[j]); + } + + // Update the conserved variable. + for (int j = 0; j < 2; j++) { + un[(i * 2) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j < 2; j++) { + u[(i * 2) + j] = un[(i * 2) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(1 * 2) + j]; + u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + + for (int j = 0; j < 2; j++) { + input_data[j][(n * nx) + (i - 1)] = (float*) malloc(2 * sizeof(float)); + output_data[j][(n * nx) + (i - 1)] = (float*) malloc(sizeof(float)); + + input_data[j][(n * nx) + (i - 1)][0] = t; + input_data[j][(n * nx) + (i - 1)][1] = x; + output_data[j][(n * nx) + (i - 1)][0] = u[(i * 2) + j]; + } + } + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 2; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 2; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + free(u); + free(un); + + free(local_alpha); + + free(um); + free(ui); + free(up); + + free(f_um); + free(f_ui); + free(f_up); + + free(f_deriv_um); + free(f_deriv_ui); + free(f_deriv_up); + + free(aL_roe); + free(aR_roe); + + free(fluxL); + free(fluxR); + + for (int i = 0; i < 2; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 2; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; Left flux vector F(u_{i - 1}). + (list-ref flux-ums 0) + (list-ref flux-ums 1) + ;; Middle flux vector F(u_i). + (list-ref flux-uis 0) + (list-ref flux-uis 1) + ;; Right flux vector F(u_{i + 1}). + (list-ref flux-ups 0) + (list-ref flux-ups 1) + ;; Eigenvalues of left flux Jacobian F'(u_{i - 1}). + (list-ref flux-deriv-ums 0) + (list-ref flux-deriv-ums 1) + ;; Eigenvalues of middle flux Jacobian F'(u_i). + (list-ref flux-deriv-uis 0) + (list-ref flux-deriv-uis 1) + ;; Eigenvalues of right flux Jacobian F'(u_{i + 1}). + (list-ref flux-deriv-ups 0) + (list-ref flux-deriv-ups 1) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------------------------------------- +;; Train a Roe (Finite-Volume) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs with a Second-Order Flux Extrapolation +;; ---------------------------------------------------------------------------------------------------------------------------- +(define (train-roe-vector2-1d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that trains a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method + with a second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) + (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes (map (lambda (flux-expr) + (convert-expr flux-expr)) flux-exprs)) + (define flux-deriv-codes (map (lambda (flux-deriv-expr) + (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") + (list-ref cons-codes 1) "umL[1]")) flux-codes)) + (define flux-umRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") + (list-ref cons-codes 1) "umR[1]")) flux-codes)) + (define flux-uiLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") + (list-ref cons-codes 1) "uiL[1]")) flux-codes)) + (define flux-uiRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") + (list-ref cons-codes 1) "uiR[1]")) flux-codes)) + (define flux-upLs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") + (list-ref cons-codes 1) "upL[1]")) flux-codes)) + (define flux-upRs (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") + (list-ref cons-codes 1) "upR[1]")) flux-codes)) + + (define flux-umR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") + (list-ref cons-codes 1) "umR_evol[1]")) flux-codes)) + (define flux-uiL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") + (list-ref cons-codes 1) "uiL_evol[1]")) flux-codes)) + (define flux-uiR-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") + (list-ref cons-codes 1) "uiR_evol[1]")) flux-codes)) + (define flux-upL-evols (map (lambda (flux-code) + (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") + (list-ref cons-codes 1) "upL_evol[1]")) flux-codes)) + + (define flux-deriv-umR-evols (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "umR_evol[0]") + (list-ref cons-codes 1) "umR_evol[1]")) flux-deriv-codes)) + (define flux-deriv-uiL-evols (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "uiL_evol[0]") + (list-ref cons-codes 1) "uiL_evol[1]")) flux-deriv-codes)) + (define flux-deriv-uiR-evols (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "uiR_evol[0]") + (list-ref cons-codes 1) "uiR_evol[1]")) flux-deriv-codes)) + (define flux-deriv-upL-evols (map (lambda (flux-deriv-code) + (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "upL_evol[0]") + (list-ref cons-codes 1) "upL_evol[1]")) flux-deriv-codes)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Train a Roe higher-order finite-volume surrogate solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Array for storing slopes. + double *slope = (double*) malloc((nx + 4) * 2 * sizeof(double)); + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); + double *un = (double*) malloc((nx + 4) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + double *umL = (double*) malloc(2 * sizeof(double)); + double *umR = (double*) malloc(2 * sizeof(double)); + double *uiL = (double*) malloc(2 * sizeof(double)); + double *uiR = (double*) malloc(2 * sizeof(double)); + double *upL = (double*) malloc(2 * sizeof(double)); + double *upR = (double*) malloc(2 * sizeof(double)); + + double *f_umL = (double*) malloc(2 * sizeof(double)); + double *f_umR = (double*) malloc(2 * sizeof(double)); + double *f_uiL = (double*) malloc(2 * sizeof(double)); + double *f_uiR = (double*) malloc(2 * sizeof(double)); + double *f_upL = (double*) malloc(2 * sizeof(double)); + double *f_upR = (double*) malloc(2 * sizeof(double)); + + double *umR_evol = (double*) malloc(2 * sizeof(double)); + double *uiL_evol = (double*) malloc(2 * sizeof(double)); + double *uiR_evol = (double*) malloc(2 * sizeof(double)); + double *upL_evol = (double*) malloc(2 * sizeof(double)); + + double *f_umR_evol = (double*) malloc(2 * sizeof(double)); + double *f_uiL_evol = (double*) malloc(2 * sizeof(double)); + double *f_uiR_evol = (double*) malloc(2 * sizeof(double)); + double *f_upL_evol = (double*) malloc(2 * sizeof(double)); + + double *f_deriv_umR_evol = (double*) malloc(2 * sizeof(double)); + double *f_deriv_uiL_evol = (double*) malloc(2 * sizeof(double)); + double *f_deriv_uiR_evol = (double*) malloc(2 * sizeof(double)); + double *f_deriv_upL_evol = (double*) malloc(2 * sizeof(double)); + + double *aL_roe = (double*) malloc(2 * sizeof(double)); + double *aR_roe = (double*) malloc(2 * sizeof(double)); + + double *fluxL = (double*) malloc(2 * sizeof(double)); + double *fluxR = (double*) malloc(2 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(2 * sizeof(float**)); + float ***output_data = (float***) malloc(2 * sizeof(float**)); + + for (int i = 0; i < 2; i++) { + input_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + un[(i * 2) + 0] = ~a; // init-funcs[0] in C. + un[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(2 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); + + for (int i = 0; i < 2; i++) { + t_net[i] = kann_layer_input(2); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 2; i <= nx + 1; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 0; j < 2; j++) { + double r = (u[(i * 2) + j] - u[((i - 1) * 2) + j]) / (u[((i + 1) * 2) + j] - u[(i * 2) + j]); + double limiter = ~a; // limiter-r in C. + + slope[(i * 2) + j] = limiter * (0.5 * ((u[(i * 2) + j] - u[((i - 1) * 2) + j]) + (u[((i + 1) * 2) + j] - u[(i * 2) + j]))); + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector. + for (int i = 2; i <= nx + 1; i++) { + // Extrapolate boundary states. + for (int j = 0; j < 2; j++) { + umL[j] = u[((i - 1) * 2) + j] - (0.5 * slope[((i - 1) * 2) + j]); + umR[j] = u[((i - 1) * 2) + j] + (0.5 * slope[((i - 1) * 2) + j]); + + uiL[j] = u[(i * 2) + j] - (0.5 * slope[(i * 2) + j]); + uiR[j] = u[(i * 2) + j] + (0.5 * slope[(i * 2) + j]); + + upL[j] = u[((i + 1) * 2) + j] - (0.5 * slope[((i + 1) * 2) + j]); + upR[j] = u[((i + 1) * 2) + j] + (0.5 * slope[((i + 1) * 2) + j]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL[0] = ~a; + f_umL[1] = ~a; + f_umR[0] = ~a; + f_umR[1] = ~a; + + f_uiL[0] = ~a; + f_uiL[1] = ~a; + f_uiR[0] = ~a; + f_uiR[1] = ~a; + + f_upL[0] = ~a; + f_upL[1] = ~a; + f_upR[0] = ~a; + f_upR[1] = ~a; + + // Evolve each extrapolated boundary state. + for (int j = 0; j < 2; j++) { + umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); + + uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); + + upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol[0] = ~a; + f_umR_evol[1] = ~a; // F(U_{i - 1, R+}) + f_uiL_evol[0] = ~a; + f_uiL_evol[1] = ~a; // F(U_{i, L+}) + + f_uiR_evol[0] = ~a; + f_uiR_evol[1] = ~a; // F(U_{i, R+}) + f_upL_evol[0] = ~a; + f_upL_evol[1] = ~a; // F(U_{i + 1, L+}) + + // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. + f_deriv_umR_evol[0] = ~a; + f_deriv_umR_evol[1] = ~a; // F'(U_{i - 1, R+}) + f_deriv_uiL_evol[0] = ~a; + f_deriv_uiL_evol[1] = ~a; // F'(U_{i, L+}) + + f_deriv_uiR_evol[0] = ~a; + f_deriv_uiR_evol[1] = ~a; // F'(U_{i, R+}) + f_deriv_upL_evol[0] = ~a; + f_deriv_upL_evol[1] = ~a; // F'(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * |aL_roe| * (U_{i, L+} - U_{i - 1, R+}). + for (int j = 0; j < 2; j++) { + aL_roe[j] = 0.5 * (f_deriv_umR_evol[j] + f_deriv_uiL_evol[j]); + } + for (int j = 0; j < 2; j++) { + fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * fabs(aL_roe[j]) * (uiL_evol[j] - umR_evol[j]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * |aR_roe| * (U_{i + 1, L+} - u_{i, R+}). + for (int j = 0; j < 2; j++) { + aR_roe[j] = 0.5 * (f_deriv_uiR_evol[j] + f_deriv_upL_evol[j]); + } + for (int j = 0; j < 2; j++) { + fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * fabs(aR_roe[j]) * (upL_evol[j] - uiR_evol[j]); + } + + // Update the conserved variable. + for (int j = 0; j < 2; j++) { + un[(i * 2) + j] = u[(i * 2) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j < 2; j++) { + u[(i * 2) + j] = un[(i * 2) + j]; + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(2 * 2) + j]; + u[(1 * 2) + j] = u[(2 * 2) + j]; + u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; + u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + + for (int j = 0; j < 2; j++) { + input_data[j][(n * nx) + (i - 2)] = (float*) malloc(2 * sizeof(float)); + output_data[j][(n * nx) + (i - 2)] = (float*) malloc(sizeof(float)); + + input_data[j][(n * nx) + (i - 2)][0] = t; + input_data[j][(n * nx) + (i - 2)][1] = x; + output_data[j][(n * nx) + (i - 2)][0] = u[(i * 2) + j]; + } + } + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 2; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 2; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + free(u); + free(un); + free(slope); + + free(local_alpha); + + free(umL); + free(umR); + free(uiL); + free(uiR); + free(upL); + free(upR); + + free(f_umL); + free(f_umR); + free(f_uiL); + free(f_uiR); + free(f_upL); + free(f_upR); + + free(umR_evol); + free(uiL_evol); + free(uiR_evol); + free(upL_evol); + + free(f_umR_evol); + free(f_uiL_evol); + free(f_uiR_evol); + free(f_upL_evol); + + free(f_deriv_umR_evol); + free(f_deriv_uiL_evol); + free(f_deriv_uiR_evol); + free(f_deriv_upL_evol); + + free(fluxL); + free(fluxR); + + for (int i = 0; i < 2; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 2; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; Expression for flux limiter function. + limiter-r + ;; Left negative flux vector F(U_{i - 1, L}). + (list-ref flux-umLs 0) + (list-ref flux-umLs 1) + ;; Right negative flux vector F(U_{i - 1, R}). + (list-ref flux-umRs 0) + (list-ref flux-umRs 1) + ;; Left central flux vector F(U_{i, L}). + (list-ref flux-uiLs 0) + (list-ref flux-uiLs 1) + ;; Right central flux vector F(U_{i, R}). + (list-ref flux-uiRs 0) + (list-ref flux-uiRs 1) + ;; Left positive flux vector F(U_{i + 1, L}). + (list-ref flux-upLs 0) + (list-ref flux-upLs 1) + ;; Right positive flux vector F(U_{i + 1, R}). + (list-ref flux-upRs 0) + (list-ref flux-upRs 1) + ;; Evolved right negative flux vector F(U_{i - 1, R+}). + (list-ref flux-umR-evols 0) + (list-ref flux-umR-evols 1) + ;; Evolved left central flux vector F(U_{i, L+}). + (list-ref flux-uiL-evols 0) + (list-ref flux-uiL-evols 1) + ;; Evolved right central flux vector F(U_{i, R+}). + (list-ref flux-uiR-evols 0) + (list-ref flux-uiR-evols 1) + ;; Evolved left positive flux vector F(U_{i + 1, L+}). + (list-ref flux-upL-evols 0) + (list-ref flux-upL-evols 1) + ;; Eigenvalues of evolved right negative flux Jacobian F'(U_{i - 1, R+}). + (list-ref flux-deriv-umR-evols 0) + (list-ref flux-deriv-umR-evols 1) + ;; Eigenvalues of evolved left central flux Jacobian F'(U_{i, L+}). + (list-ref flux-deriv-uiL-evols 0) + (list-ref flux-deriv-uiL-evols 1) + ;; Eigenvalues of evolved right central flux Jacobian F'(U_{i, R+}). + (list-ref flux-deriv-uiR-evols 0) + (list-ref flux-deriv-uiR-evols 1) + ;; Eigenvalues of evolved left positive flux Jacobian F'(U_{i + 1, L+}). + (list-ref flux-deriv-upL-evols 0) + (list-ref flux-deriv-upL-evols 1) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_vector_training_2d.rkt b/provable-algorithms/neural_networks/code_generator_vector_training_2d.rkt new file mode 100644 index 00000000..fb5bf07f --- /dev/null +++ b/provable-algorithms/neural_networks/code_generator_vector_training_2d.rkt @@ -0,0 +1,3717 @@ +#lang racket + +(require "prover_vector.rkt") +(require "code_generator_core_training.rkt") +(provide train-lax-friedrichs-vector3-2d + train-lax-friedrichs-vector3-2d-second-order + train-roe-vector3-2d + train-roe-vector3-2d-second-order) + +;; ---------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs +;; ---------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-vector3-2d pde-system neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that trains a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") + (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-codes-x)) + (define flux-uis-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") + (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-codes-x)) + (define flux-ups-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") + (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-codes-x)) + + (define flux-ums-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") + (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-codes-y)) + (define flux-uis-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") + (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-codes-y)) + (define flux-ups-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") + (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 3 PDEs in 2D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + double **un = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); + un[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + double *um_x = (double*) malloc(3 * sizeof(double)); + double *ui_x = (double*) malloc(3 * sizeof(double)); + double *up_x = (double*) malloc(3 * sizeof(double)); + + double *f_um_x = (double*) malloc(3 * sizeof(double)); + double *f_ui_x = (double*) malloc(3 * sizeof(double)); + double *f_up_x = (double*) malloc(3 * sizeof(double)); + + double *fluxL_x = (double*) malloc(3 * sizeof(double)); + double *fluxR_x = (double*) malloc(3 * sizeof(double)); + + double *um_y = (double*) malloc(3 * sizeof(double)); + double *ui_y = (double*) malloc(3 * sizeof(double)); + double *up_y = (double*) malloc(3 * sizeof(double)); + + double *f_um_y = (double*) malloc(3 * sizeof(double)); + double *f_ui_y = (double*) malloc(3 * sizeof(double)); + double *f_up_y = (double*) malloc(3 * sizeof(double)); + + double *fluxL_y = (double*) malloc(3 * sizeof(double)); + double *fluxR_y = (double*) malloc(3 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(3 * sizeof(float**)); + float ***output_data = (float***) malloc(3 * sizeof(float**)); + + for (int i = 0; i < 3; i++) { + input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + + un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + t_net[i] = kann_layer_input(3); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_y[k] = u[i][((j - 1) * 3) + k]; + ui_y[k] = u[i][(j * 3) + k]; + up_y[k] = u[i][((j + 1) * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; // F(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_x[k] = u[i - 1][(j * 3) + k]; + ui_x[k] = u[i][(j * 3) + k]; + up_x[k] = u[i + 1][(j * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_x[0] = ~a; + f_um_x[1] = ~a; + f_um_x[2] = ~a; // F(U_{i - 1}). + + f_ui_x[0] = ~a; + f_ui_x[1] = ~a; + f_ui_x[2] = ~a; // F(U_i). + + f_up_x[0] = ~a; + f_up_x[1] = ~a; + f_up_x[2] = ~a; // F(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha_x * (U_i - U_{i - 1}). + for (int k = 0; k < 3; k++) { + fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * alpha_x * (ui_x[k] - um_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha_x * (U_{i + 1} - U_i). + for (int k = 0; k < 3; k++) { + fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * alpha_x * (up_x[k] - ui_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_y[k] = u[i][((j - 1) * 3) + k]; + ui_y[k] = u[i][(j * 3) + k]; + up_y[k] = u[i][((j + 1) * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; // F(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * alpha_y * (U_j - U_{j - 1}). + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * alpha_y * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * alpha_y * (U_{j + 1} - U_j). + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * alpha_y * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + for (int k = 0; k < 3; k++) { + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); + output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); + + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; + output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][(j * 3) + k]; + } + } + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 3; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + free(un[i]); + } + free(u); + free(un); + + free(local_alpha_x); + free(local_alpha_y); + + free(um_x); + free(ui_x); + free(up_x); + + free(f_um_x); + free(f_ui_x); + free(f_up_x); + + free(fluxL_x); + free(fluxR_x); + + free(um_y); + free(ui_y); + free(up_y); + + free(f_um_y); + free(f_ui_y); + free(f_up_y); + + free(fluxL_y); + free(fluxR_y); + + for (int i = 0; i < 3; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 3; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). + (list-ref flux-ums-x 0) + (list-ref flux-ums-x 1) + (list-ref flux-ums-x 2) + (list-ref flux-uis-x 0) + (list-ref flux-uis-x 1) + (list-ref flux-uis-x 2) + (list-ref flux-ups-x 0) + (list-ref flux-ups-x 1) + (list-ref flux-ups-x 2) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------------------------------------------------------------- +;; Train a Lax–Friedrichs (Finite-Difference) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation +;; ------------------------------------------------------------------------------------------------------------------------------------------- +(define (train-lax-friedrichs-vector3-2d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that trains a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method + with a second-order flux extrapolation using the limiter `limiter`, with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") + (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]")) flux-codes-x)) + (define flux-umRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_x[0]") + (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]")) flux-codes-x)) + (define flux-uiLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") + (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]")) flux-codes-x)) + (define flux-uiRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") + (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]")) flux-codes-x)) + (define flux-upLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") + (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]")) flux-codes-x)) + (define flux-upRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") + (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]")) flux-codes-x)) + + (define flux-umR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") + (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-codes-x)) + (define flux-uiL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") + (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-codes-x)) + (define flux-uiR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") + (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-codes-x)) + (define flux-upL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") + (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-codes-x)) + + (define flux-umLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") + (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]")) flux-codes-y)) + (define flux-umRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") + (list-ref cons-codes 1) "umR_y[1]") (list-ref cons-codes 2) "umR_y[2]")) flux-codes-y)) + (define flux-uiLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") + (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]")) flux-codes-y)) + (define flux-uiRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") + (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]")) flux-codes-y)) + (define flux-upLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") + (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]")) flux-codes-y)) + (define flux-upRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") + (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]")) flux-codes-y)) + + (define flux-umR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") + (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-codes-y)) + (define flux-uiL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") + (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-codes-y)) + (define flux-uiR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") + (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-codes-y)) + (define flux-upL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") + (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Train a Lax–Friedrichs first-order finite-difference surrogate solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing slopes. + double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); + double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + slope_x[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + slope_y[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + } + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + double **un = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + un[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + double *umL_x = (double*) malloc(3 * sizeof(double)); + double *umR_x = (double*) malloc(3 * sizeof(double)); + double *uiL_x = (double*) malloc(3 * sizeof(double)); + double *uiR_x = (double*) malloc(3 * sizeof(double)); + double *upL_x = (double*) malloc(3 * sizeof(double)); + double *upR_x = (double*) malloc(3 * sizeof(double)); + + double *f_umL_x = (double*) malloc(3 * sizeof(double)); + double *f_umR_x = (double*) malloc(3 * sizeof(double)); + double *f_uiL_x = (double*) malloc(3 * sizeof(double)); + double *f_uiR_x = (double*) malloc(3 * sizeof(double)); + double *f_upL_x = (double*) malloc(3 * sizeof(double)); + double *f_upR_x = (double*) malloc(3 * sizeof(double)); + + double *umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *f_umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *fluxL_x = (double*) malloc(3 * sizeof(double)); + double *fluxR_x = (double*) malloc(3 * sizeof(double)); + + double *umL_y = (double*) malloc(3 * sizeof(double)); + double *umR_y = (double*) malloc(3 * sizeof(double)); + double *uiL_y = (double*) malloc(3 * sizeof(double)); + double *uiR_y = (double*) malloc(3 * sizeof(double)); + double *upL_y = (double*) malloc(3 * sizeof(double)); + double *upR_y = (double*) malloc(3 * sizeof(double)); + + double *f_umL_y = (double*) malloc(3 * sizeof(double)); + double *f_umR_y = (double*) malloc(3 * sizeof(double)); + double *f_uiL_y = (double*) malloc(3 * sizeof(double)); + double *f_uiR_y = (double*) malloc(3 * sizeof(double)); + double *f_upL_y = (double*) malloc(3 * sizeof(double)); + double *f_upR_y = (double*) malloc(3 * sizeof(double)); + + double *umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *f_umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *fluxL_y = (double*) malloc(3 * sizeof(double)); + double *fluxR_y = (double*) malloc(3 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(3 * sizeof(float**)); + float ***output_data = (float***) malloc(3 * sizeof(float**)); + + for (int i = 0; i < 3; i++) { + input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + + un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + t_net[i] = kann_layer_input(3); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); + umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); + + uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); + uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); + + upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); + upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) / (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_x[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) + (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the x-direction. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_x[k] = u[i - 1][(j * 3) + k] - (0.5 * slope_x[i - 1][(j * 3) + k]); + umR_x[k] = u[i - 1][(j * 3) + k] + (0.5 * slope_x[i - 1][(j * 3) + k]); + + uiL_x[k] = u[i][(j * 3) + k] - (0.5 * slope_x[i][(j * 3) + k]); + uiR_x[k] = u[i][(j * 3) + k] + (0.5 * slope_x[i][(j * 3) + k]); + + upL_x[k] = u[i + 1][(j * 3) + k] - (0.5 * slope_x[i + 1][(j * 3) + k]); + upR_x[k] = u[i + 1][(j * 3) + k] + (0.5 * slope_x[i + 1][(j * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_x[0] = ~a; + f_umL_x[1] = ~a; + f_umL_x[2] = ~a; + f_umR_x[0] = ~a; + f_umR_x[1] = ~a; + f_umR_x[2] = ~a; + + f_uiL_x[0] = ~a; + f_uiL_x[1] = ~a; + f_uiL_x[2] = ~a; + f_uiR_x[0] = ~a; + f_uiR_x[1] = ~a; + f_uiR_x[2] = ~a; + + f_upL_x[0] = ~a; + f_upL_x[1] = ~a; + f_upL_x[2] = ~a; + f_upR_x[0] = ~a; + f_upR_x[1] = ~a; + f_upR_x[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); + + uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + + upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_x[0] = ~a; + f_umR_evol_x[1] = ~a; + f_umR_evol_x[2] = ~a; // F(U_{i - 1, R+}) + f_uiL_evol_x[0] = ~a; + f_uiL_evol_x[1] = ~a; + f_uiL_evol_x[2] = ~a; // F(U_{i, L+}) + + f_uiR_evol_x[0] = ~a; + f_uiR_evol_x[1] = ~a; + f_uiR_evol_x[2] = ~a; // F(U_{i, R+}) + f_upL_evol_x[0] = ~a; + f_upL_evol_x[1] = ~a; + f_upL_evol_x[2] = ~a; // F(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha_x * (U_{i, L+} - U_{i - 1, R+}). + for (int k = 0; k < 3; k++) { + fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * alpha_x * (uiL_evol_x[k] - umR_evol_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha_x * (U_{i + 1, L+} - U_{i, R+}). + for (int k = 0; k < 3; k++) { + fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * alpha_x * (upL_evol_x[k] - uiR_evol_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); + umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); + + uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); + uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); + + upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); + upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * alpha_y * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * alpha_y * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * alpha_y * (U_{j + 1, L+} - U_{j, R+}). + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * alpha_y * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + for (int k = 0; k < 3; k++) { + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); + output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); + + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; + output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][(j * 3) + k]; + } + } + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 3; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + free(un[i]); + free(slope_x[i]); + free(slope_y[i]); + } + free(u); + free(un); + free(slope_x); + free(slope_y); + + free(local_alpha_x); + free(local_alpha_y); + + free(umL_x); + free(umR_x); + free(uiL_x); + free(uiR_x); + free(upL_x); + free(upR_x); + + free(f_umL_x); + free(f_umR_x); + free(f_uiL_x); + free(f_uiR_x); + free(f_upL_x); + free(f_upR_x); + + free(umR_evol_x); + free(uiL_evol_x); + free(uiR_evol_x); + free(upL_evol_x); + + free(f_umR_evol_x); + free(f_uiL_evol_x); + free(f_uiR_evol_x); + free(f_upL_evol_x); + + free(fluxL_x); + free(fluxR_x); + + free(umL_y); + free(umR_y); + free(uiL_y); + free(uiR_y); + free(upL_y); + free(upR_y); + + free(f_umL_y); + free(f_umR_y); + free(f_uiL_y); + free(f_uiR_y); + free(f_upL_y); + free(f_upR_y); + + free(umR_evol_y); + free(uiL_evol_y); + free(uiR_evol_y); + free(upL_evol_y); + + free(f_umR_evol_y); + free(f_uiL_evol_y); + free(f_uiR_evol_y); + free(f_upL_evol_y); + + free(fluxL_y); + free(fluxR_y); + + for (int i = 0; i < 3; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 3; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). + (list-ref flux-umLs-x 0) + (list-ref flux-umLs-x 1) + (list-ref flux-umLs-x 2) + (list-ref flux-umRs-x 0) + (list-ref flux-umRs-x 1) + (list-ref flux-umRs-x 2) + ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). + (list-ref flux-uiLs-x 0) + (list-ref flux-uiLs-x 1) + (list-ref flux-uiLs-x 2) + (list-ref flux-uiRs-x 0) + (list-ref flux-uiRs-x 1) + (list-ref flux-uiRs-x 2) + ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). + (list-ref flux-upLs-x 0) + (list-ref flux-upLs-x 1) + (list-ref flux-upLs-x 2) + (list-ref flux-upRs-x 0) + (list-ref flux-upRs-x 1) + (list-ref flux-upRs-x 2) + ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). + (list-ref flux-umR-evols-x 0) + (list-ref flux-umR-evols-x 1) + (list-ref flux-umR-evols-x 2) + (list-ref flux-uiL-evols-x 0) + (list-ref flux-uiL-evols-x 1) + (list-ref flux-uiL-evols-x 2) + ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). + (list-ref flux-uiR-evols-x 0) + (list-ref flux-uiR-evols-x 1) + (list-ref flux-uiR-evols-x 2) + (list-ref flux-upL-evols-x 0) + (list-ref flux-upL-evols-x 1) + (list-ref flux-upL-evols-x 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ------------------------------------------------------------------------------------- +;; Train a Roe (Finite-Volume) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs +;; ------------------------------------------------------------------------------------- +(define (train-roe-vector3-2d pde-system neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that trains a surrogate solver for the the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Roe finite-volume method, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define flux-jacobian-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) + (define flux-jacobian-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) + (define flux-jacobian-eigvals-simp-x (list (symbolic-simp (list-ref flux-jacobian-eigvals-x 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals-x 1)) + (symbolic-simp (list-ref flux-jacobian-eigvals-x 2)))) + (define flux-jacobian-eigvals-simp-y (list (symbolic-simp (list-ref flux-jacobian-eigvals-y 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals-y 1)) + (symbolic-simp (list-ref flux-jacobian-eigvals-y 2)))) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define flux-deriv-codes-x (map (lambda (flux-deriv-expr-x) + (convert-expr flux-deriv-expr-x)) flux-jacobian-eigvals-simp-x)) + (define flux-deriv-codes-y (map (lambda (flux-deriv-expr-y) + (convert-expr flux-deriv-expr-y)) flux-jacobian-eigvals-simp-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define flux-ums-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "um_x[0]") + (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-codes-x)) + (define flux-uis-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "ui_x[0]") + (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-codes-x)) + (define flux-ups-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "up_x[0]") + (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-codes-x)) + + (define flux-deriv-ums-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "um_x[0]") + (list-ref cons-codes 1) "um_x[1]") (list-ref cons-codes 2) "um_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-uis-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "ui_x[0]") + (list-ref cons-codes 1) "ui_x[1]") (list-ref cons-codes 2) "ui_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-ups-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "up_x[0]") + (list-ref cons-codes 1) "up_x[1]") (list-ref cons-codes 2) "up_x[2]")) flux-deriv-codes-x)) + + (define flux-ums-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "um_y[0]") + (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-codes-y)) + (define flux-uis-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "ui_y[0]") + (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-codes-y)) + (define flux-ups-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "up_y[0]") + (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-codes-y)) + + (define flux-deriv-ums-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "um_y[0]") + (list-ref cons-codes 1) "um_y[1]") (list-ref cons-codes 2) "um_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-uis-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "ui_y[0]") + (list-ref cons-codes 1) "ui_y[1]") (list-ref cons-codes 2) "ui_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-ups-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "up_y[0]") + (list-ref cons-codes 1) "up_y[1]") (list-ref cons-codes 2) "up_y[2]")) flux-deriv-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// Train a Roe higher-order finite-volume surrogate solver for a coupled vector system of 3 PDEs in 2D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + double **un = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); + un[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + double *um_x = (double*) malloc(3 * sizeof(double)); + double *ui_x = (double*) malloc(3 * sizeof(double)); + double *up_x = (double*) malloc(3 * sizeof(double)); + + double *f_um_x = (double*) malloc(3 * sizeof(double)); + double *f_ui_x = (double*) malloc(3 * sizeof(double)); + double *f_up_x = (double*) malloc(3 * sizeof(double)); + + double *f_deriv_um_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_ui_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_up_x = (double*) malloc(3 * sizeof(double)); + + double *aL_roe_x = (double*) malloc(3 * sizeof(double)); + double *aR_roe_x = (double*) malloc(3 * sizeof(double)); + + double *fluxL_x = (double*) malloc(3 * sizeof(double)); + double *fluxR_x = (double*) malloc(3 * sizeof(double)); + + double *um_y = (double*) malloc(3 * sizeof(double)); + double *ui_y = (double*) malloc(3 * sizeof(double)); + double *up_y = (double*) malloc(3 * sizeof(double)); + + double *f_um_y = (double*) malloc(3 * sizeof(double)); + double *f_ui_y = (double*) malloc(3 * sizeof(double)); + double *f_up_y = (double*) malloc(3 * sizeof(double)); + + double *f_deriv_um_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_ui_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_up_y = (double*) malloc(3 * sizeof(double)); + + double *aL_roe_y = (double*) malloc(3 * sizeof(double)); + double *aR_roe_y = (double*) malloc(3 * sizeof(double)); + + double *fluxL_y = (double*) malloc(3 * sizeof(double)); + double *fluxR_y = (double*) malloc(3 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(3 * sizeof(float**)); + float ***output_data = (float***) malloc(3 * sizeof(float**)); + + for (int i = 0; i < 3; i++) { + input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + + un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + t_net[i] = kann_layer_input(3); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_y[k] = u[i][((j - 1) * 3) + k]; + ui_y[k] = u[i][(j * 3) + k]; + up_y[k] = u[i][((j + 1) * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; // F(U_{j + 1}). + + // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. + f_deriv_um_y[0] = ~a; + f_deriv_um_y[1] = ~a; + f_deriv_um_y[2] = ~a; // Eigenvalues of F'(U_{j - 1}). + + f_deriv_ui_y[0] = ~a; + f_deriv_ui_y[1] = ~a; + f_deriv_ui_y[2] = ~a; // Eigenvalues of F'(U_j). + + f_deriv_up_y[0] = ~a; + f_deriv_up_y[1] = ~a; + f_deriv_up_y[2] = ~a; // Eigenvalues of F'(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * |aL_roe_y| * (U_j - U_{j - 1}). + for (int k = 0; k < 3; k++) { + aL_roe_y[k] = 0.5 * (f_deriv_um_y[k] + f_deriv_ui_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * |aR_roe_y| * (U_{j + 1} - U_j). + for (int k = 0; k < 3; k++) { + aR_roe_y[k] = 0.5 * (f_deriv_ui_y[k] + f_deriv_up_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the x-direction. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_x[k] = u[i - 1][(j * 3) + k]; + ui_x[k] = u[i][(j * 3) + k]; + up_x[k] = u[i + 1][(j * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_x[0] = ~a; + f_um_x[1] = ~a; + f_um_x[2] = ~a; // F(U_{i - 1}). + + f_ui_x[0] = ~a; + f_ui_x[1] = ~a; + f_ui_x[2] = ~a; // F(U_i). + + f_up_x[0] = ~a; + f_up_x[1] = ~a; + f_up_x[2] = ~a; // F(U_{i + 1}). + + // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. + f_deriv_um_x[0] = ~a; + f_deriv_um_x[1] = ~a; + f_deriv_um_x[2] = ~a; // Eigenvalues of F'(U_{i - 1}). + + f_deriv_ui_x[0] = ~a; + f_deriv_ui_x[1] = ~a; + f_deriv_ui_x[2] = ~a; // Eigenvalues of F'(U_i). + + f_deriv_up_x[0] = ~a; + f_deriv_up_x[1] = ~a; + f_deriv_up_x[2] = ~a; // Eigenvalues of F'(U_{i + 1}). + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * |aL_roe_x| * (U_i - U_{i - 1}). + for (int k = 0; k < 3; k++) { + aL_roe_x[k] = 0.5 * (f_deriv_um_x[k] + f_deriv_ui_x[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_x[k] = 0.5 * (f_um_x[k] + f_ui_x[k]) - 0.5 * fabs(aL_roe_x[k]) * (ui_x[k] - um_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * |aR_roe_x| * (U_{i + 1} - U_i). + for (int k = 0; k < 3; k++) { + aR_roe_x[k] = 0.5 * (f_deriv_ui_x[k] + f_deriv_up_x[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_x[k] = 0.5 * (f_ui_x[k] + f_up_x[k]) - 0.5 * fabs(aR_roe_x[k]) * (up_x[k] - ui_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_x[k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + um_y[k] = u[i][((j - 1) * 3) + k]; + ui_y[k] = u[i][(j * 3) + k]; + up_y[k] = u[i][((j + 1) * 3) + k]; + } + + // Evaluate flux vector for each value of the conserved variable vector. + f_um_y[0] = ~a; + f_um_y[1] = ~a; + f_um_y[2] = ~a; // F(U_{j - 1}). + + f_ui_y[0] = ~a; + f_ui_y[1] = ~a; + f_ui_y[2] = ~a; // F(U_j). + + f_up_y[0] = ~a; + f_up_y[1] = ~a; + f_up_y[2] = ~a; // F(U_{j + 1}). + + // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. + f_deriv_um_y[0] = ~a; + f_deriv_um_y[1] = ~a; + f_deriv_um_y[2] = ~a; // Eigenvalues of F'(U_{j - 1}). + + f_deriv_ui_y[0] = ~a; + f_deriv_ui_y[1] = ~a; + f_deriv_ui_y[2] = ~a; // Eigenvalues of F'(U_j). + + f_deriv_up_y[0] = ~a; + f_deriv_up_y[1] = ~a; + f_deriv_up_y[2] = ~a; // Eigenvalues of F'(U_{j + 1}). + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1}) + F(U_j)) - 0.5 * |aL_roe_y| * (U_j - U_{j - 1}). + for (int k = 0; k < 3; k++) { + aL_roe_y[k] = 0.5 * (f_deriv_um_y[k] + f_deriv_ui_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_um_y[k] + f_ui_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (ui_y[k] - um_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1}) + F(U_j)) - 0.5 * |aR_roe_y| * (U_{j + 1} - U_j). + for (int k = 0; k < 3; k++) { + aR_roe_y[k] = 0.5 * (f_deriv_ui_y[k] + f_deriv_up_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_ui_y[k] + f_up_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (up_y[k] - ui_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = ui_y[k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + + un[0][(j * 3) + k] = un[1][(j * 3) + k]; + un[nx + 1][(j * 3) + k] = un[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(1 * 3) + k]; + un[i][((ny + 1) * 3) + k] = un[i][(ny * 3) + k]; + } + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + for (int k = 0; k < 3; k++) { + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(3 * sizeof(float)); + output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)] = (float*) malloc(sizeof(float)); + + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = t; + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][1] = x; + input_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][2] = y; + output_data[k][(n * nx * ny) + ((i - 1) * ny) + (j - 1)][0] = u[i][(j * 3) + k]; + } + } + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 3; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + free(un[i]); + } + free(u); + free(un); + + free(local_alpha_x); + free(local_alpha_y); + + free(um_x); + free(ui_x); + free(up_x); + + free(f_um_x); + free(f_ui_x); + free(f_up_x); + + free(f_deriv_um_x); + free(f_deriv_ui_x); + free(f_deriv_up_x); + + free(aL_roe_x); + free(aR_roe_x); + + free(fluxL_x); + free(fluxR_x); + + free(um_y); + free(ui_y); + free(up_y); + + free(f_um_y); + free(f_ui_y); + free(f_up_y); + + free(f_deriv_um_y); + free(f_deriv_ui_y); + free(f_deriv_up_y); + + free(aL_roe_y); + free(aR_roe_y); + + free(fluxL_y); + free(fluxR_y); + + for (int i = 0; i < 3; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 3; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + ;; Eigenvalues of left, middle, right flux Jacobians in y-direction F'(u_{j - 1}), F'(u_j), F'(u_{j + 1}). + (list-ref flux-deriv-ums-y 0) + (list-ref flux-deriv-ums-y 1) + (list-ref flux-deriv-ums-y 2) + (list-ref flux-deriv-uis-y 0) + (list-ref flux-deriv-uis-y 1) + (list-ref flux-deriv-uis-y 2) + (list-ref flux-deriv-ups-y 0) + (list-ref flux-deriv-ups-y 1) + (list-ref flux-deriv-ups-y 2) + ;; Left, middle, right flux vectors in x-direction F(u_{i - 1}), F(u_i), F(u_{i + 1}). + (list-ref flux-ums-x 0) + (list-ref flux-ums-x 1) + (list-ref flux-ums-x 2) + (list-ref flux-uis-x 0) + (list-ref flux-uis-x 1) + (list-ref flux-uis-x 2) + (list-ref flux-ups-x 0) + (list-ref flux-ups-x 1) + (list-ref flux-ups-x 2) + ;; Eigenvalues of left, middle, right flux Jacobians in x-direction F'(u_{i - 1}), F'(u_i), F'(u_{i + 1}). + (list-ref flux-deriv-ums-x 0) + (list-ref flux-deriv-ums-x 1) + (list-ref flux-deriv-ums-x 2) + (list-ref flux-deriv-uis-x 0) + (list-ref flux-deriv-uis-x 1) + (list-ref flux-deriv-uis-x 2) + (list-ref flux-deriv-ups-x 0) + (list-ref flux-deriv-ups-x 1) + (list-ref flux-deriv-ups-x 2) + ;; Left, middle, right flux vectors in y-direction F(u_{j - 1}), F(u_j), F(u_{j + 1}). + (list-ref flux-ums-y 0) + (list-ref flux-ums-y 1) + (list-ref flux-ums-y 2) + (list-ref flux-uis-y 0) + (list-ref flux-uis-y 1) + (list-ref flux-uis-y 2) + (list-ref flux-ups-y 0) + (list-ref flux-ups-y 1) + (list-ref flux-ups-y 2) + ;; Eigenvalues of left, middle, right flux Jacobians in y-direction F'(u_{j - 1}), F'(u_j), F'(u_{j + 1}). + (list-ref flux-deriv-ums-y 0) + (list-ref flux-deriv-ums-y 1) + (list-ref flux-deriv-ums-y 2) + (list-ref flux-deriv-uis-y 0) + (list-ref flux-deriv-uis-y 1) + (list-ref flux-deriv-uis-y 2) + (list-ref flux-deriv-ups-y 0) + (list-ref flux-deriv-ups-y 1) + (list-ref flux-deriv-ups-y 2) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------------------------------------- +;; Train a Roe (Finite-Volume) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs with a Second-Order Flux Extrapolation +;; ---------------------------------------------------------------------------------------------------------------------------- +(define (train-roe-vector3-2d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that trains a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system` using the Roe finite-volume method + with a second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + (define limiter-expr (hash-ref limiter 'limiter-expr)) + (define limiter-ratio (hash-ref limiter 'limiter-ratio)) + + (define limiter-code (convert-expr limiter-expr)) + (define limiter-ratio-code (convert-expr limiter-ratio)) + + (define max-trains (hash-ref neural-net 'max-trains)) + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (define num-threads (hash-ref neural-net 'num-threads)) + (define mini-size (hash-ref neural-net 'mini-size)) + + (define flux-jacobian-eigvals-x (symbolic-eigvals3 (symbolic-jacobian flux-exprs-x cons-exprs))) + (define flux-jacobian-eigvals-y (symbolic-eigvals3 (symbolic-jacobian flux-exprs-y cons-exprs))) + (define flux-jacobian-eigvals-simp-x (list (symbolic-simp (list-ref flux-jacobian-eigvals-x 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals-x 1)) + (symbolic-simp (list-ref flux-jacobian-eigvals-x 2)))) + (define flux-jacobian-eigvals-simp-y (list (symbolic-simp (list-ref flux-jacobian-eigvals-y 0)) + (symbolic-simp (list-ref flux-jacobian-eigvals-y 1)) + (symbolic-simp (list-ref flux-jacobian-eigvals-y 2)))) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define flux-codes-x (map (lambda (flux-expr-x) + (convert-expr flux-expr-x)) flux-exprs-x)) + (define flux-codes-y (map (lambda (flux-expr-y) + (convert-expr flux-expr-y)) flux-exprs-y)) + (define flux-deriv-codes-x (map (lambda (flux-deriv-expr-x) + (convert-expr flux-deriv-expr-x)) flux-jacobian-eigvals-simp-x)) + (define flux-deriv-codes-y (map (lambda (flux-deriv-expr-y) + (convert-expr flux-deriv-expr-y)) flux-jacobian-eigvals-simp-y)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) + + (define flux-umLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umL_x[0]") + (list-ref cons-codes 1) "umL_x[1]") (list-ref cons-codes 2) "umL_x[2]")) flux-codes-x)) + (define flux-umRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_x[0]") + (list-ref cons-codes 1) "umR_x[1]") (list-ref cons-codes 2) "umR_x[2]")) flux-codes-x)) + (define flux-uiLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_x[0]") + (list-ref cons-codes 1) "uiL_x[1]") (list-ref cons-codes 2) "uiL_x[2]")) flux-codes-x)) + (define flux-uiRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_x[0]") + (list-ref cons-codes 1) "uiR_x[1]") (list-ref cons-codes 2) "uiR_x[2]")) flux-codes-x)) + (define flux-upLs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_x[0]") + (list-ref cons-codes 1) "upL_x[1]") (list-ref cons-codes 2) "upL_x[2]")) flux-codes-x)) + (define flux-upRs-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upR_x[0]") + (list-ref cons-codes 1) "upR_x[1]") (list-ref cons-codes 2) "upR_x[2]")) flux-codes-x)) + + (define flux-umR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "umR_evol_x[0]") + (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-codes-x)) + (define flux-uiL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") + (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-codes-x)) + (define flux-uiR-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") + (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-codes-x)) + (define flux-upL-evols-x (map (lambda (flux-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-code-x (list-ref cons-codes 0) "upL_evol_x[0]") + (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-codes-x)) + + (define flux-deriv-umR-evols-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "umR_evol_x[0]") + (list-ref cons-codes 1) "umR_evol_x[1]") (list-ref cons-codes 2) "umR_evol_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-uiL-evols-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "uiL_evol_x[0]") + (list-ref cons-codes 1) "uiL_evol_x[1]") (list-ref cons-codes 2) "uiL_evol_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-uiR-evols-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "uiR_evol_x[0]") + (list-ref cons-codes 1) "uiR_evol_x[1]") (list-ref cons-codes 2) "uiR_evol_x[2]")) flux-deriv-codes-x)) + (define flux-deriv-upL-evols-x (map (lambda (flux-deriv-code-x) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-x (list-ref cons-codes 0) "upL_evol_x[0]") + (list-ref cons-codes 1) "upL_evol_x[1]") (list-ref cons-codes 2) "upL_evol_x[2]")) flux-deriv-codes-x)) + + (define flux-umLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umL_y[0]") + (list-ref cons-codes 1) "umL_y[1]") (list-ref cons-codes 2) "umL_y[2]")) flux-codes-y)) + (define flux-umRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_y[0]") + (list-ref cons-codes 1) "umR_y[1]") (list-ref cons-codes 2) "umR_y[2]")) flux-codes-y)) + (define flux-uiLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_y[0]") + (list-ref cons-codes 1) "uiL_y[1]") (list-ref cons-codes 2) "uiL_y[2]")) flux-codes-y)) + (define flux-uiRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_y[0]") + (list-ref cons-codes 1) "uiR_y[1]") (list-ref cons-codes 2) "uiR_y[2]")) flux-codes-y)) + (define flux-upLs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_y[0]") + (list-ref cons-codes 1) "upL_y[1]") (list-ref cons-codes 2) "upL_y[2]")) flux-codes-y)) + (define flux-upRs-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upR_y[0]") + (list-ref cons-codes 1) "upR_y[1]") (list-ref cons-codes 2) "upR_y[2]")) flux-codes-y)) + + (define flux-umR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "umR_evol_y[0]") + (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-codes-y)) + (define flux-uiL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") + (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-codes-y)) + (define flux-uiR-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") + (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-codes-y)) + (define flux-upL-evols-y (map (lambda (flux-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-code-y (list-ref cons-codes 0) "upL_evol_y[0]") + (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-codes-y)) + + (define flux-deriv-umR-evols-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "umR_evol_y[0]") + (list-ref cons-codes 1) "umR_evol_y[1]") (list-ref cons-codes 2) "umR_evol_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-uiL-evols-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "uiL_evol_y[0]") + (list-ref cons-codes 1) "uiL_evol_y[1]") (list-ref cons-codes 2) "uiL_evol_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-uiR-evols-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "uiR_evol_y[0]") + (list-ref cons-codes 1) "uiR_evol_y[1]") (list-ref cons-codes 2) "uiR_evol_y[2]")) flux-deriv-codes-y)) + (define flux-deriv-upL-evols-y (map (lambda (flux-deriv-code-y) + (flux-substitute (flux-substitute (flux-substitute flux-deriv-code-y (list-ref cons-codes 0) "upL_evol_y[0]") + (list-ref cons-codes 1) "upL_evol_y[1]") (list-ref cons-codes 2) "upL_evol_y[2]")) flux-deriv-codes-y)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR TRAINING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Train a Roe higher-order finite-volume surrogate solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Neural network hyperparameters. + const double num_trains = ~a; + const int nn_width = ~a; + const int nn_depth = ~a; + + const int num_threads = ~a; + const int mini_size = ~a; + + // Arrays for storing slopes. + double **slope_x = (double**) malloc((nx + 4) * sizeof(double*)); + double **slope_y = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + slope_x[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + slope_y[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + } + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + double **un = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + un[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + double *umL_x = (double*) malloc(3 * sizeof(double)); + double *umR_x = (double*) malloc(3 * sizeof(double)); + double *uiL_x = (double*) malloc(3 * sizeof(double)); + double *uiR_x = (double*) malloc(3 * sizeof(double)); + double *upL_x = (double*) malloc(3 * sizeof(double)); + double *upR_x = (double*) malloc(3 * sizeof(double)); + + double *f_umL_x = (double*) malloc(3 * sizeof(double)); + double *f_umR_x = (double*) malloc(3 * sizeof(double)); + double *f_uiL_x = (double*) malloc(3 * sizeof(double)); + double *f_uiR_x = (double*) malloc(3 * sizeof(double)); + double *f_upL_x = (double*) malloc(3 * sizeof(double)); + double *f_upR_x = (double*) malloc(3 * sizeof(double)); + + double *umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *f_umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *f_deriv_umR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_uiL_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_uiR_evol_x = (double*) malloc(3 * sizeof(double)); + double *f_deriv_upL_evol_x = (double*) malloc(3 * sizeof(double)); + + double *aL_roe_x = (double*) malloc(3 * sizeof(double)); + double *aR_roe_x = (double*) malloc(3 * sizeof(double)); + + double *fluxL_x = (double*) malloc(3 * sizeof(double)); + double *fluxR_x = (double*) malloc(3 * sizeof(double)); + + double *umL_y = (double*) malloc(3 * sizeof(double)); + double *umR_y = (double*) malloc(3 * sizeof(double)); + double *uiL_y = (double*) malloc(3 * sizeof(double)); + double *uiR_y = (double*) malloc(3 * sizeof(double)); + double *upL_y = (double*) malloc(3 * sizeof(double)); + double *upR_y = (double*) malloc(3 * sizeof(double)); + + double *f_umL_y = (double*) malloc(3 * sizeof(double)); + double *f_umR_y = (double*) malloc(3 * sizeof(double)); + double *f_uiL_y = (double*) malloc(3 * sizeof(double)); + double *f_uiR_y = (double*) malloc(3 * sizeof(double)); + double *f_upL_y = (double*) malloc(3 * sizeof(double)); + double *f_upR_y = (double*) malloc(3 * sizeof(double)); + + double *umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *f_umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *f_deriv_umR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_uiL_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_uiR_evol_y = (double*) malloc(3 * sizeof(double)); + double *f_deriv_upL_evol_y = (double*) malloc(3 * sizeof(double)); + + double *aL_roe_y = (double*) malloc(3 * sizeof(double)); + double *aR_roe_y = (double*) malloc(3 * sizeof(double)); + + double *fluxL_y = (double*) malloc(3 * sizeof(double)); + double *fluxR_y = (double*) malloc(3 * sizeof(double)); + + // Arrays for storing training data. + float ***input_data = (float***) malloc(3 * sizeof(float**)); + float ***output_data = (float***) malloc(3 * sizeof(float**)); + + for (int i = 0; i < 3; i++) { + input_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + output_data[i] = (float**) malloc(nx * ny * num_trains * sizeof(float*)); + } + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + + un[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + un[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + un[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + // Initialize neural network architecture. + kad_node_t **t_net = (kad_node_t**) malloc(3 * sizeof(kad_node_t*)); + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + t_net[i] = kann_layer_input(3); + + for (int j = 0; j < nn_depth; j++) { + t_net[i] = kann_layer_dense(t_net[i], nn_width); + t_net[i] = kad_tanh(t_net[i]); + } + + t_net[i] = kann_layer_cost(t_net[i], 1, KANN_C_MSE); + ann[i] = kann_new(t_net[i], 0); + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); + umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); + + uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); + uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); + + upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); + upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) + + // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. + f_deriv_umR_evol_y[0] = ~a; + f_deriv_umR_evol_y[1] = ~a; + f_deriv_umR_evol_y[2] = ~a; // F'(U_{j - 1, R+}) + f_deriv_uiL_evol_y[0] = ~a; + f_deriv_uiL_evol_y[1] = ~a; + f_deriv_uiL_evol_y[2] = ~a; // F'(U_{j, L+}) + + f_deriv_uiR_evol_y[0] = ~a; + f_deriv_uiR_evol_y[1] = ~a; + f_deriv_uiR_evol_y[2] = ~a; // F'(U_{j, R+}) + f_deriv_upL_evol_y[0] = ~a; + f_deriv_upL_evol_y[1] = ~a; + f_deriv_upL_evol_y[2] = ~a; // F'(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * |aL_roe_y| * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 3; k++) { + aL_roe_y[k] = 0.5 * (f_deriv_umR_evol_y[k] + f_deriv_uiL_evol_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * |aR_roe_y| * (U_{j + 1, L+} - u_{j, R+}). + for (int k = 0; k < 3; k++) { + aR_roe_y[k] = 0.5 * (f_deriv_uiR_evol_y[k] + f_deriv_upL_evol_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) / (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_x[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i - 1][(j * 3) + k]) + (u[i + 1][(j * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the x-direction. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_x[k] = u[i - 1][(j * 3) + k] - (0.5 * slope_x[i - 1][(j * 3) + k]); + umR_x[k] = u[i - 1][(j * 3) + k] + (0.5 * slope_x[i - 1][(j * 3) + k]); + + uiL_x[k] = u[i][(j * 3) + k] - (0.5 * slope_x[i][(j * 3) + k]); + uiR_x[k] = u[i][(j * 3) + k] + (0.5 * slope_x[i][(j * 3) + k]); + + upL_x[k] = u[i + 1][(j * 3) + k] - (0.5 * slope_x[i + 1][(j * 3) + k]); + upR_x[k] = u[i + 1][(j * 3) + k] + (0.5 * slope_x[i + 1][(j * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_x[0] = ~a; + f_umL_x[1] = ~a; + f_umL_x[2] = ~a; + f_umR_x[0] = ~a; + f_umR_x[1] = ~a; + f_umR_x[2] = ~a; + + f_uiL_x[0] = ~a; + f_uiL_x[1] = ~a; + f_uiL_x[2] = ~a; + f_uiR_x[0] = ~a; + f_uiR_x[1] = ~a; + f_uiR_x[2] = ~a; + + f_upL_x[0] = ~a; + f_upL_x[1] = ~a; + f_upL_x[2] = ~a; + f_upR_x[0] = ~a; + f_upR_x[1] = ~a; + f_upR_x[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_x[k] = umR_x[k] + ((dt / (2.0 * dx)) * (f_umL_x[k] - f_umR_x[k])); + + uiL_evol_x[k] = uiL_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + uiR_evol_x[k] = uiR_x[k] + ((dt / (2.0 * dx)) * (f_uiL_x[k] - f_uiR_x[k])); + + upL_evol_x[k] = upL_x[k] + ((dt / (2.0 * dx)) * (f_upL_x[k] - f_upR_x[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_x[0] = ~a; + f_umR_evol_x[1] = ~a; + f_umR_evol_x[2] = ~a; // F(U_{i - 1, R+}) + f_uiL_evol_x[0] = ~a; + f_uiL_evol_x[1] = ~a; + f_uiL_evol_x[2] = ~a; // F(U_{i, L+}) + + f_uiR_evol_x[0] = ~a; + f_uiR_evol_x[1] = ~a; + f_uiR_evol_x[2] = ~a; // F(U_{i, R+}) + f_upL_evol_x[0] = ~a; + f_upL_evol_x[1] = ~a; + f_upL_evol_x[2] = ~a; // F(U_{i + 1, L+}) + + // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. + f_deriv_umR_evol_x[0] = ~a; + f_deriv_umR_evol_x[1] = ~a; + f_deriv_umR_evol_x[2] = ~a; // F'(U_{i - 1, R+}) + f_deriv_uiL_evol_x[0] = ~a; + f_deriv_uiL_evol_x[1] = ~a; + f_deriv_uiL_evol_x[2] = ~a; // F'(U_{i, L+}) + + f_deriv_uiR_evol_x[0] = ~a; + f_deriv_uiR_evol_x[1] = ~a; + f_deriv_uiR_evol_x[2] = ~a; // F'(U_{i, R+}) + f_deriv_upL_evol_x[0] = ~a; + f_deriv_upL_evol_x[1] = ~a; + f_deriv_upL_evol_x[2] = ~a; // F'(U_{i + 1, L+}) + + // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * |aL_roe_x| * (U_{i, L+} - U_{i - 1, R+}). + for (int k = 0; k < 3; k++) { + aL_roe_x[k] = 0.5 * (f_deriv_umR_evol_x[k] + f_deriv_uiL_evol_x[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_x[k] = 0.5 * (f_umR_evol_x[k] + f_uiL_evol_x[k]) - 0.5 * fabs(aL_roe_x[k]) * (uiL_evol_x[k] - umR_evol_x[k]); + } + + // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * |aR_roe_x| * (U_{i + 1, L+} - u_{i, R+}). + for (int k = 0; k < 3; k++) { + aR_roe_x[k] = 0.5 * (f_deriv_uiR_evol_x[k] + f_deriv_upL_evol_x[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_x[k] = 0.5 * (f_uiR_evol_x[k] + f_upL_evol_x[k]) - 0.5 * fabs(aR_roe_x[k]) * (upL_evol_x[k] - uiR_evol_x[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / dx) * (fluxR_x[k] - fluxL_x[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Compute appropriately flux-limited slopes within each cell. + for (int i = 1; i <= nx + 2; i++) { + for (int j = 1; j <= ny + 2; j++) { + for (int k = 0; k < 3; k++) { + double r = (u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) / (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]); + double limiter = ~a; // limiter-r in C. + + slope_y[i][(j * 3) + k] = limiter * (0.5 * ((u[i][(j * 3) + k] - u[i][((j - 1) * 3) + k]) + (u[i][((j + 1) * 3) + k] - u[i][(j * 3) + k]))); + } + } + } + + // Compute fluxes with Roe approximation and update the conserved variable vector in the y-direction by half a time-step. + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + // Extrapolate boundary states. + for (int k = 0; k < 3; k++) { + umL_y[k] = u[i][((j - 1) * 3) + k] - (0.5 * slope_y[i][((j - 1) * 3) + k]); + umR_y[k] = u[i][((j - 1) * 3) + k] + (0.5 * slope_y[i][((j - 1) * 3) + k]); + + uiL_y[k] = u[i][(j * 3) + k] - (0.5 * slope_y[i][(j * 3) + k]); + uiR_y[k] = u[i][(j * 3) + k] + (0.5 * slope_y[i][(j * 3) + k]); + + upL_y[k] = u[i][((j + 1) * 3) + k] - (0.5 * slope_y[i][((j + 1) * 3) + k]); + upR_y[k] = u[i][((j + 1) * 3) + k] + (0.5 * slope_y[i][((j + 1) * 3) + k]); + } + + // Evaluate flux vector for each extrapolated boundary state. + f_umL_y[0] = ~a; + f_umL_y[1] = ~a; + f_umL_y[2] = ~a; + f_umR_y[0] = ~a; + f_umR_y[1] = ~a; + f_umR_y[2] = ~a; + + f_uiL_y[0] = ~a; + f_uiL_y[1] = ~a; + f_uiL_y[2] = ~a; + f_uiR_y[0] = ~a; + f_uiR_y[1] = ~a; + f_uiR_y[2] = ~a; + + f_upL_y[0] = ~a; + f_upL_y[1] = ~a; + f_upL_y[2] = ~a; + f_upR_y[0] = ~a; + f_upR_y[1] = ~a; + f_upR_y[2] = ~a; + + // Evolve each extrapolated boundary state. + for (int k = 0; k < 3; k++) { + umR_evol_y[k] = umR_y[k] + ((dt / (4.0 * dy)) * (f_umL_y[k] - f_umR_y[k])); + + uiL_evol_y[k] = uiL_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + uiR_evol_y[k] = uiR_y[k] + ((dt / (4.0 * dy)) * (f_uiL_y[k] - f_uiR_y[k])); + + upL_evol_y[k] = upL_y[k] + ((dt / (4.0 * dy)) * (f_upL_y[k] - f_upR_y[k])); + } + + // Evaluate flux vector for each value of the (evolved) conserved variable vector. + f_umR_evol_y[0] = ~a; + f_umR_evol_y[1] = ~a; + f_umR_evol_y[2] = ~a; // F(U_{j - 1, R+}) + f_uiL_evol_y[0] = ~a; + f_uiL_evol_y[1] = ~a; + f_uiL_evol_y[2] = ~a; // F(U_{j, L+}) + + f_uiR_evol_y[0] = ~a; + f_uiR_evol_y[1] = ~a; + f_uiR_evol_y[2] = ~a; // F(U_{j, R+}) + f_upL_evol_y[0] = ~a; + f_upL_evol_y[1] = ~a; + f_upL_evol_y[2] = ~a; // F(U_{j + 1, L+}) + + // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. + f_deriv_umR_evol_y[0] = ~a; + f_deriv_umR_evol_y[1] = ~a; + f_deriv_umR_evol_y[2] = ~a; // F'(U_{j - 1, R+}) + f_deriv_uiL_evol_y[0] = ~a; + f_deriv_uiL_evol_y[1] = ~a; + f_deriv_uiL_evol_y[2] = ~a; // F'(U_{j, L+}) + + f_deriv_uiR_evol_y[0] = ~a; + f_deriv_uiR_evol_y[1] = ~a; + f_deriv_uiR_evol_y[2] = ~a; // F'(U_{j, R+}) + f_deriv_upL_evol_y[0] = ~a; + f_deriv_upL_evol_y[1] = ~a; + f_deriv_upL_evol_y[2] = ~a; // F'(U_{j + 1, L+}) + + // Left interface flux: F_{j - 1/2} = 0.5 * (F(U_{j - 1, R+}) + F(U_{j, L+})) - 0.5 * |aL_roe_y| * (U_{j, L+} - U_{j - 1, R+}). + for (int k = 0; k < 3; k++) { + aL_roe_y[k] = 0.5 * (f_deriv_umR_evol_y[k] + f_deriv_uiL_evol_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxL_y[k] = 0.5 * (f_umR_evol_y[k] + f_uiL_evol_y[k]) - 0.5 * fabs(aL_roe_y[k]) * (uiL_evol_y[k] - umR_evol_y[k]); + } + + // Right interface flux: F_{j + 1/2} = 0.5 * (F(U_{j + 1, L+}) + F(U_{j, R+})) - 0.5 * |aR_roe_y| * (U_{j + 1, L+} - u_{j, R+}). + for (int k = 0; k < 3; k++) { + aR_roe_y[k] = 0.5 * (f_deriv_uiR_evol_y[k] + f_deriv_upL_evol_y[k]); + } + for (int k = 0; k < 3; k++) { + fluxR_y[k] = 0.5 * (f_uiR_evol_y[k] + f_upL_evol_y[k]) - 0.5 * fabs(aR_roe_y[k]) * (upL_evol_y[k] - uiR_evol_y[k]); + } + + // Update the conserved variable vector. + for (int k = 0; k < 3; k++) { + un[i][(j * 3) + k] = u[i][(j * 3) + k] - (dt / (2.0 * dy)) * (fluxR_y[k] - fluxL_y[k]); + } + } + } + + // Copy un -> u (updated conserved variable vector to new conserved variable vector). + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[i][(j * 3) + k] = un[i][(j * 3) + k]; + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + + un[0][(j * 3) + k] = un[2][(j * 3) + k]; + un[1][(j * 3) + k] = un[2][(j * 3) + k]; + un[nx + 2][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + un[nx + 3][(j * 3) + k] = un[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + + un[i][(0 * 3) + k] = un[i][(2 * 3) + k]; + un[i][(1 * 3) + k] = un[i][(2 * 3) + k]; + un[i][((ny + 2) * 3) + k] = un[i][((ny + 1) * 3) + k]; + un[i][((ny + 3) * 3) + k] = un[i][((ny + 1) * 3) + k]; + } + } + + // Accumulate to training data. + if (n < num_trains) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + for (int k = 0; k < 3; k++) { + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(3 * sizeof(float)); + output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)] = (float*) malloc(sizeof(float)); + + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = t; + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][1] = x; + input_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][2] = y; + output_data[k][(n * nx * ny) + ((i - 2) * ny) + (j - 2)][0] = u[i][(j * 3) + k]; + } + } + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_output_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + // Train neural network. + for (int i = 0; i < 3; i++) { + kann_mt(ann[i], num_threads, mini_size); + kann_train_fnn1(ann[i], 0.0001f, 64, 50, 10, 0.1f, n * nx * ny, input_data[i], output_data[i]); + } + + // Output neural network to disk. + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + kann_save(file_nm, ann[i]); + } + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + free(un[i]); + free(slope_x[i]); + free(slope_y[i]); + } + free(u); + free(un); + free(slope_x); + free(slope_y); + + free(local_alpha_x); + free(local_alpha_y); + + free(umL_x); + free(umR_x); + free(uiL_x); + free(uiR_x); + free(upL_x); + free(upR_x); + + free(f_umL_x); + free(f_umR_x); + free(f_uiL_x); + free(f_uiR_x); + free(f_upL_x); + free(f_upR_x); + + free(umR_evol_x); + free(uiL_evol_x); + free(uiR_evol_x); + free(upL_evol_x); + + free(f_umR_evol_x); + free(f_uiL_evol_x); + free(f_uiR_evol_x); + free(f_upL_evol_x); + + free(f_deriv_umR_evol_x); + free(f_deriv_uiL_evol_x); + free(f_deriv_uiR_evol_x); + free(f_deriv_upL_evol_x); + + free(aL_roe_x); + free(aR_roe_x); + + free(fluxL_x); + free(fluxR_x); + + free(umL_y); + free(umR_y); + free(uiL_y); + free(uiR_y); + free(upL_y); + free(upR_y); + + free(f_umL_y); + free(f_umR_y); + free(f_uiL_y); + free(f_uiR_y); + free(f_upL_y); + free(f_upR_y); + + free(umR_evol_y); + free(uiL_evol_y); + free(uiR_evol_y); + free(upL_evol_y); + + free(f_umR_evol_y); + free(f_uiL_evol_y); + free(f_uiR_evol_y); + free(f_upL_evol_y); + + free(f_deriv_umR_evol_y); + free(f_deriv_uiL_evol_y); + free(f_deriv_uiR_evol_y); + free(f_deriv_upL_evol_y); + + free(aL_roe_y); + free(aR_roe_y); + + free(fluxL_y); + free(fluxR_y); + + for (int i = 0; i < 3; i++) { + kann_delete(ann[i]); + } + free(ann); + free(t_net); + + for (int i = 0; i < 3; i++) { + for (int j = 0; j < nx * num_trains; j++) { + free(input_data[i][j]); + free(output_data[i][j]); + } + + free(input_data[i]); + free(output_data[i]); + } + + free(input_data); + free(output_data); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Maximum number of time-steps to train on. + max-trains + ;; Neural network width. + width + ;; Neural network depth. + depth + ;; Number of threads to use during training. + num-threads + ;; Mini-batch training size. + mini-size + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + ;; Evolved right negative/left central flux Jacobian eigenvalues in y-direction F'(U_{j - 1, R+}), F'(U_{j, L+}). + (list-ref flux-deriv-umR-evols-y 0) + (list-ref flux-deriv-umR-evols-y 1) + (list-ref flux-deriv-umR-evols-y 2) + (list-ref flux-deriv-uiL-evols-y 0) + (list-ref flux-deriv-uiL-evols-y 1) + (list-ref flux-deriv-uiL-evols-y 2) + ;; Evolved right central/left positive flux Jacobian eigenvalues in y-direction F'(U_{j, R+}), F'(U_{j + 1, L+}). + (list-ref flux-deriv-uiR-evols-y 0) + (list-ref flux-deriv-uiR-evols-y 1) + (list-ref flux-deriv-uiR-evols-y 2) + (list-ref flux-deriv-upL-evols-y 0) + (list-ref flux-deriv-upL-evols-y 1) + (list-ref flux-deriv-upL-evols-y 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in x-direction F(U_{i - 1, L}), F(U_{i - 1, R}). + (list-ref flux-umLs-x 0) + (list-ref flux-umLs-x 1) + (list-ref flux-umLs-x 2) + (list-ref flux-umRs-x 0) + (list-ref flux-umRs-x 1) + (list-ref flux-umRs-x 2) + ;; Left/right central flux vectors in x-direction F(U_{i, L}), F(U_{i, R}). + (list-ref flux-uiLs-x 0) + (list-ref flux-uiLs-x 1) + (list-ref flux-uiLs-x 2) + (list-ref flux-uiRs-x 0) + (list-ref flux-uiRs-x 1) + (list-ref flux-uiRs-x 2) + ;; Left/right positive flux vectors in x-direction F(U_{i + 1, L}), F(U_{i + 1, R}). + (list-ref flux-upLs-x 0) + (list-ref flux-upLs-x 1) + (list-ref flux-upLs-x 2) + (list-ref flux-upRs-x 0) + (list-ref flux-upRs-x 1) + (list-ref flux-upRs-x 2) + ;; Evolved right negative/left central flux vectors in x-direction F(U_{i - 1, R+}), F(U_{i, L+}). + (list-ref flux-umR-evols-x 0) + (list-ref flux-umR-evols-x 1) + (list-ref flux-umR-evols-x 2) + (list-ref flux-uiL-evols-x 0) + (list-ref flux-uiL-evols-x 1) + (list-ref flux-uiL-evols-x 2) + ;; Evolved right central/left positive flux vectors in x-direction F(U_{i, R+}), F(U_{i + 1, L+}). + (list-ref flux-uiR-evols-x 0) + (list-ref flux-uiR-evols-x 1) + (list-ref flux-uiR-evols-x 2) + (list-ref flux-upL-evols-x 0) + (list-ref flux-upL-evols-x 1) + (list-ref flux-upL-evols-x 2) + ;; Evolved right negative/left central flux Jacobian eigenvalues in x-direction F'(U_{i - 1, R+}), F'(U_{i, L+}). + (list-ref flux-deriv-umR-evols-x 0) + (list-ref flux-deriv-umR-evols-x 1) + (list-ref flux-deriv-umR-evols-x 2) + (list-ref flux-deriv-uiL-evols-x 0) + (list-ref flux-deriv-uiL-evols-x 1) + (list-ref flux-deriv-uiL-evols-x 2) + ;; Evolved right central/left positive flux Jacobian eigenvalues in x-direction F'(U_{i, R+}), F'(U_{i + 1, L+}). + (list-ref flux-deriv-uiR-evols-x 0) + (list-ref flux-deriv-uiR-evols-x 1) + (list-ref flux-deriv-uiR-evols-x 2) + (list-ref flux-deriv-upL-evols-x 0) + (list-ref flux-deriv-upL-evols-x 1) + (list-ref flux-deriv-upL-evols-x 2) + ;; Expression for flux limiter function. + limiter-r + ;; Left/right negative flux vectors in y-direction F(U_{j - 1, L}), F(U_{j - 1, R}). + (list-ref flux-umLs-y 0) + (list-ref flux-umLs-y 1) + (list-ref flux-umLs-y 2) + (list-ref flux-umRs-y 0) + (list-ref flux-umRs-y 1) + (list-ref flux-umRs-y 2) + ;; Left/right central flux vectors in y-direction F(U_{j, L}), F(U_{j, R}). + (list-ref flux-uiLs-y 0) + (list-ref flux-uiLs-y 1) + (list-ref flux-uiLs-y 2) + (list-ref flux-uiRs-y 0) + (list-ref flux-uiRs-y 1) + (list-ref flux-uiRs-y 2) + ;; Left/right positive flux vectors in y-direction F(U_{j + 1, L}), F(U_{j + 1, R}). + (list-ref flux-upLs-y 0) + (list-ref flux-upLs-y 1) + (list-ref flux-upLs-y 2) + (list-ref flux-upRs-y 0) + (list-ref flux-upRs-y 1) + (list-ref flux-upRs-y 2) + ;; Evolved right negative/left central flux vectors in y-direction F(U_{j - 1, R+}), F(U_{j, L+}). + (list-ref flux-umR-evols-y 0) + (list-ref flux-umR-evols-y 1) + (list-ref flux-umR-evols-y 2) + (list-ref flux-uiL-evols-y 0) + (list-ref flux-uiL-evols-y 1) + (list-ref flux-uiL-evols-y 2) + ;; Evolved right central/left positive flux vectors in y-direction F(U_{j, R+}), F(U_{j + 1, L+}). + (list-ref flux-uiR-evols-y 0) + (list-ref flux-uiR-evols-y 1) + (list-ref flux-uiR-evols-y 2) + (list-ref flux-upL-evols-y 0) + (list-ref flux-upL-evols-y 1) + (list-ref flux-upL-evols-y 2) + ;; Evolved right negative/left central flux Jacobian eigenvalues in y-direction F'(U_{j - 1, R+}), F'(U_{j, L+}). + (list-ref flux-deriv-umR-evols-y 0) + (list-ref flux-deriv-umR-evols-y 1) + (list-ref flux-deriv-umR-evols-y 2) + (list-ref flux-deriv-uiL-evols-y 0) + (list-ref flux-deriv-uiL-evols-y 1) + (list-ref flux-deriv-uiL-evols-y 2) + ;; Evolved right central/left positive flux Jacobian eigenvalues in y-direction F'(U_{j, R+}), F'(U_{j + 1, L+}). + (list-ref flux-deriv-uiR-evols-y 0) + (list-ref flux-deriv-uiR-evols-y 1) + (list-ref flux-deriv-uiR-evols-y 2) + (list-ref flux-deriv-upL-evols-y 0) + (list-ref flux-deriv-upL-evols-y 1) + (list-ref flux-deriv-upL-evols-y 2) + ;; PDE name for file output. + name + name + ;; PDE name for neural network output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/code_generator_vector_validation.rkt b/provable-algorithms/neural_networks/code_generator_vector_validation.rkt new file mode 100644 index 00000000..8f45b382 --- /dev/null +++ b/provable-algorithms/neural_networks/code_generator_vector_validation.rkt @@ -0,0 +1,1036 @@ +#lang racket + +(require "code_generator_core_training.rkt") +(require "code_generator_core_validation.rkt") +(provide validate-vector2-1d + validate-vector2-1d-second-order + validate-vector3-2d + validate-vector3-2d-second-order) + +;; --------------------------------------------------------------------------------------------- +;; Validate an Arbitrary (First-Order) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs +;; --------------------------------------------------------------------------------------------- +(define (validate-vector2-1d pde-system neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that validates a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde` using any first-order method, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a +// Validate any first-order surrogate solver for a coupled vector system of 2 PDEs in 1D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + double x = x0 + (i - 0.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + // Load neural network architecture. + kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); + + for (int i = 0; i < 2; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann[i] = kann_load(file_nm); + + fclose(fptr); + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 1; i <= nx; i++) { + for (int j = 0; j < 2; j++) { + double x = x0 + (i - 0.5) * dx; + + float *input_data = (float*) malloc(2 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + + output_data = kann_apply1(ann[j], input_data); + + u[(i * 2) + j] = output_data[0]; + + free(input_data); + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(1 * 2) + j]; + u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_validation_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr; + fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + double x = x0 + (i - 0.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(local_alpha); + + for (int i = 0; i < 2; i++) { + kann_delete(ann[i]); + } + free(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------- +;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 1D Coupled Vector System of 2 PDEs +;; ---------------------------------------------------------------------------------------------- +(define (validate-vector2-1d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Generate C code that validates a surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde` using any first-order method + with any second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define max-speed-codes (map (lambda (max-speed-expr) + (convert-expr max-speed-expr)) max-speed-exprs)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define max-speed-locals (map (lambda (max-speed-code) + (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") + (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Validate any first-order surrogate solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double L = (x1 - x0); + const double dx = L / nx; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); + + // Arrays for storing other intermediate values. + double *local_alpha = (double*) malloc(2 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + double x = x0 + (i - 1.5) * dx; + + u[(i * 2) + 0] = ~a; // init-funcs[0] in C. + u[(i * 2) + 1] = ~a; // init-funcs[1] in C. + } + + // Load neural network architecture. + kann_t **ann = (kann_t**) malloc(2 * sizeof(kann_t*)); + + for (int i = 0; i < 2; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann[i] = kann_load(file_nm); + + fclose(fptr); + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha = 0.0; + + for (int i = 1; i <= nx + 2; i++) { + local_alpha[0] = ~a; // max-speed-exprs[0] in C. + local_alpha[1] = ~a; // max-speed-exprs[1] in C. + + for (int j = 0; j < 2; j++) { + if (local_alpha[j] > alpha) { + alpha = local_alpha[j]; + } + } + } + + // Avoid division by zero. + if (alpha < 1e-14) { + alpha = 1e-14; + } + + // Compute stable time step from alpha. + double dt = cfl * dx / alpha; + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 0; j < 2; j++) { + double x = x0 + (i - 1.5) * dx; + + float *input_data = (float*) malloc(2 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + + output_data = kann_apply1(ann[j], input_data); + + u[(i * 2) + j] = output_data[0]; + + free(input_data); + } + } + + // Apply simple boundary conditions (transmissive). + for (int j = 0; j < 2; j++) { + u[(0 * 2) + j] = u[(2 * 2) + j]; + u[(1 * 2) + j] = u[(2 * 2) + j]; + u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; + u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; + } + + // Output solution to disk. + for (int j = 0; j < 2; j++) { + const char *fmt = \"%s_validation_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", j, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", j, n); + + FILE *fptr; + fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + double x = x0 + (i - 1.5) * dx; + fprintf(fptr, \"%f, %f\\n\", x, u[(i * 2) + j]); + } + } + + fclose(fptr); + } + + // Increment time. + t += dt; + n += 1; + } + + free(u); + free(local_alpha); + + for (int i = 0; i < 2; i++) { + kann_delete(ann[i]); + } + free(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells. + nx + ;; Left boundary. + x0 + ;; Right boundary. + x1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals 0) + (list-ref max-speed-locals 1) + ;; PDE name for file output. + name + name + )) + code) + +;; --------------------------------------------------------------------------------------------- +;; Validate an Arbitrary (First-Order) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs +;; --------------------------------------------------------------------------------------------- +(define (validate-vector3-2d pde-system neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that validates a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde` using any first-order method, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a +// Validate any first-order surrogate solver for a coupled vector system of 3 PDEs in 2D. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 2) * sizeof(double*)); + for (int i = 0; i <= nx + 1; i++) { + u[i] = (double*) malloc((ny + 2) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 1; i++) { + for (int j = 0; j <= ny + 1; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + // Load neural network architecture. + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann[i] = kann_load(file_nm); + + fclose(fptr); + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + for (int k = 0; k < 3; k++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - -.5) * dy; + + float *input_data = (float*) malloc(3 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + input_data[2] = y; + + output_data = kann_apply1(ann[k], input_data); + + u[i][(j * 3) + k] = output_data[0]; + + free(input_data); + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[1][(j * 3) + k]; + u[nx + 1][(j * 3) + k] = u[nx][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 1; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(1 * 3) + k]; + u[i][((ny + 1) * 3) + k] = u[i][(ny * 3) + k]; + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_validation_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + double x = x0 + (i - 0.5) * dx; + double y = y0 + (j - 0.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 1; i++) { + free(u[i]); + } + free(u); + + free(local_alpha_x); + free(local_alpha_y); + + for (int i = 0; i < 3; i++) { + kann_delete(ann[i]); + } + free(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; PDE name for file output. + name + name + )) + code) + +;; ---------------------------------------------------------------------------------------------- +;; Validate an Arbitrary (Second-Order) Surrogate Solver for a 2D Coupled Vector System of 3 PDEs +;; ---------------------------------------------------------------------------------------------- +(define (validate-vector3-2d-second-order pde-system limiter neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Generate C code that validates a surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde` using any first-order method + with any second-order flux extrapolation using flux limiter `limiter`, with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define name (hash-ref pde-system 'name)) + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define max-speed-exprs-x (hash-ref pde-system 'max-speed-exprs-x)) + (define max-speed-exprs-y (hash-ref pde-system 'max-speed-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define limiter-name (hash-ref limiter 'name)) + + (define cons-codes (map (lambda (cons-expr) + (convert-expr cons-expr)) cons-exprs)) + (define max-speed-codes-x (map (lambda (max-speed-expr-x) + (convert-expr max-speed-expr-x)) max-speed-exprs-x)) + (define max-speed-codes-y (map (lambda (max-speed-expr-y) + (convert-expr max-speed-expr-y)) max-speed-exprs-y)) + (define init-func-codes (map (lambda (init-func-expr) + (convert-expr init-func-expr)) init-funcs)) + + (define max-speed-locals-x (map (lambda (max-speed-code-x) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-x (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-x)) + (define max-speed-locals-y (map (lambda (max-speed-code-y) + (flux-substitute (flux-substitute (flux-substitute max-speed-code-y (list-ref cons-codes 0) "u[i][(j * 3) + 0]") + (list-ref cons-codes 1) "u[i][(j * 3) + 1]") (list-ref cons-codes 2) "u[i][(j * 3) + 2]")) max-speed-codes-y)) + + (define parameter-code (cond + [(not (empty? parameters)) (string-join (map (lambda (parameter) + (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] + [else ""])) + + (define code + (format " +// AUTO-GENERATED CODE FOR VALIDATING ON COUPLED VECTOR PDE SYSTEM: ~a +// FLUX LIMITER: ~a +// Validate any first-order surrogate solver for a coupled vector system of 3 PDEs in 2D, with a second-order flux extrapolation. + +#include +#include +#include +#include \"kann.h\" + +// Additional PDE parameters (if any). +~a + +int main() { + // Spatial domain setup. + const int nx = ~a; + const int ny = ~a; + const double x0 = ~a; + const double x1 = ~a; + const double y0 = ~a; + const double y1 = ~a; + const double Lx = (x1 - x0); + const double Ly = (y1 - y0); + const double dx = Lx / nx; + const double dy = Ly / ny; + + // Time-stepper setup. + const double cfl = ~a; + const double t_final = ~a; + + // Arrays for storing solution. + double **u = (double**) malloc((nx + 4) * sizeof(double*)); + for (int i = 0; i <= nx + 3; i++) { + u[i] = (double*) malloc((ny + 4) * 3 * sizeof(double)); + } + + // Arrays for storing other intermediate values. + double *local_alpha_x = (double*) malloc(3 * sizeof(double)); + double *local_alpha_y = (double*) malloc(3 * sizeof(double)); + + // Initialize grid and set initial conditions. + for (int i = 0; i <= nx + 3; i++) { + for (int j = 0; j <= ny + 3; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + u[i][(j * 3) + 0] = ~a; // init-funcs[0] in C. + u[i][(j * 3) + 1] = ~a; // init-funcs[1] in C. + u[i][(j * 3) + 2] = ~a; // init-funcs[2] in C. + } + } + + // Load neural network architecture. + kann_t **ann = (kann_t**) malloc(3 * sizeof(kann_t*)); + + for (int i = 0; i < 3; i++) { + const char *fmt = \"%s_%d_neural_net.dat\"; + int sz = snprintf(0, 0, fmt, \"~a\", i); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", i); + + FILE *fptr; + fptr = fopen(file_nm, \"r\"); + if (fptr != NULL) { + ann[i] = kann_load(file_nm); + + fclose(fptr); + } + } + + double t = 0.0; + int n = 0; + while (t < t_final) { + // Determine global maximum wave-speed alpha (for stable dt). + // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. + double alpha_x = 0.0; + double alpha_y = 0.0; + + for (int i = 1; i <= nx; i++) { + for (int j = 1; j <= ny; j++) { + local_alpha_x[0] = ~a; // max-speed-exprs-x[0] in C. + local_alpha_x[1] = ~a; // max-speed-exprs-x[1] in C. + local_alpha_x[2] = ~a; // max-speed-exprs-x[2] in C. + + local_alpha_y[0] = ~a; // max-speed-exprs-y[0] in C. + local_alpha_y[1] = ~a; // max-speed-exprs-y[1] in C. + local_alpha_y[2] = ~a; // max-speed-exprs-y[2] in C. + + for (int k = 0; k < 3; k++) { + if (local_alpha_x[k] > alpha_x) { + alpha_x = local_alpha_x[k]; + } + if (local_alpha_y[k] > alpha_y) { + alpha_y = local_alpha_y[k]; + } + } + } + } + + // Avoid division by zero. + if (alpha_x < 1e-14) { + alpha_x = 1e-14; + } + if (alpha_y < 1e-14) { + alpha_y = 1e-14; + } + + // Compute stable time step from alpha. + double dt = fmin(cfl * dx / alpha_x, cfl * dy / alpha_y); + + // If stepping beyond t_final, adjust dt accordingly. + if (t + dt > t_final) { + dt = t_final - t; + } + + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + for (int k = 0; k < 3; k++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + + float *input_data = (float*) malloc(3 * sizeof(float)); + const float *output_data; + + input_data[0] = t; + input_data[1] = x; + input_data[2] = y; + + output_data = kann_apply1(ann[k], input_data); + + u[i][(j * 3) + k] = output_data[0]; + + free(input_data); + } + } + } + + // Apply simple boundary conditions in the x-direction (transmissive). + for (int j = 0; j <= ny + 3; j++) { + for (int k = 0; k < 3; k++) { + u[0][(j * 3) + k] = u[2][(j * 3) + k]; + u[1][(j * 3) + k] = u[2][(j * 3) + k]; + u[nx + 2][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + u[nx + 3][(j * 3) + k] = u[nx + 1][(j * 3) + k]; + } + } + + // Apply simple boundary conditions in the y-direction (transmissive). + for (int i = 0; i <= nx + 3; i++) { + for (int k = 0; k < 3; k++) { + u[i][(0 * 3) + k] = u[i][(2 * 3) + k]; + u[i][(1 * 3) + k] = u[i][(2 * 3) + k]; + u[i][((ny + 2) * 3) + k] = u[i][((ny + 1) * 3) + k]; + u[i][((ny + 3) * 3) + k] = u[i][((ny + 1) * 3) + k]; + } + } + + // Output solution to disk. + for (int k = 0; k < 3; k++) { + const char *fmt = \"%s_validation_%d_%d.csv\"; + int sz = snprintf(0, 0, fmt, \"~a\", k, n); + char file_nm[sz + 1]; + snprintf(file_nm, sizeof file_nm, fmt, \"~a\", k, n); + + FILE *fptr = fopen(file_nm, \"w\"); + if (fptr != NULL) { + for (int i = 2; i <= nx + 1; i++) { + for (int j = 2; j <= ny + 1; j++) { + double x = x0 + (i - 1.5) * dx; + double y = y0 + (j - 1.5) * dy; + fprintf(fptr, \"%f, %f, %f\\n\", x, y, u[i][(j * 3) + k]); + } + } + + fclose(fptr); + } + } + + // Increment time. + t += dt; + n += 1; + } + + for (int i = 0; i <= nx + 3; i++) { + free(u[i]); + } + free(u); + + free(local_alpha_x); + free(local_alpha_y); + + for (int i = 0; i < 3; i++) { + kann_delete(ann[i]); + } + free(ann); + + return 0; +} +" + ;; PDE name for code comments. + name + ;; Flux limiter name for code comments. + limiter-name + ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). + parameter-code + ;; Number of cells in each coordinate direction. + nx + ny + ;; Left/right boundaries. + x0 + x1 + ;; Up/down boundaries + y0 + y1 + ;; CFL coefficient. + cfl + ;; Final time. + t-final + ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). + (list-ref init-func-codes 0) + (list-ref init-func-codes 1) + (list-ref init-func-codes 2) + ;; PDE name for neural network input. + name + name + ;; Expressions for local wave-speed estimates. + (list-ref max-speed-locals-x 0) + (list-ref max-speed-locals-x 1) + (list-ref max-speed-locals-x 2) + (list-ref max-speed-locals-y 0) + (list-ref max-speed-locals-y 1) + (list-ref max-speed-locals-y 2) + ;; PDE name for file output. + name + name + )) + code) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/prover_core.rkt b/provable-algorithms/neural_networks/prover_core.rkt new file mode 100644 index 00000000..b0770283 --- /dev/null +++ b/provable-algorithms/neural_networks/prover_core.rkt @@ -0,0 +1,624 @@ +#lang racket + +(require racket/trace) +(current-prefix-in " ") +(current-prefix-out " ") + +(provide symbolic-diff + symbolic-simp-rule + symbolic-simp + is-real + symbolic-diff-order + prove-scalar-1d-smooth + prove-scalar-1d-non-smooth + prove-scalar-2d-smooth + prove-scalar-2d-non-smooth) + +;; Lightweight symbolic differentiator (differentiates expr with respect to var). +(define (symbolic-diff expr var) + (match expr + ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. + [(? symbol? symb) (cond + [(eq? symb var) 1.0] + [else 0.0])] + + ;; If expr is a numerical constant, then it differentiates to 0. + [(? number?) 0.0] + + ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] + ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] + + ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. + [`(* . ,terms) + (define n (length terms)) + (define (mult xs) (cons '* xs)) ; Multiplication helper function. + + ((lambda (sums) (cond + [(null? (cdr sums)) (car sums)] + [else (cons '+ sums)])) + (let loop ([i 0]) + (cond + [(= i n) `()] + [else + ;; Evaluate the derivative of the i-th term in the product. + (let ([di (symbolic-diff (list-ref terms i) var)]) + (cons + (mult (for/list ([j (in-range n)]) + (cond + [(= j i) di] + [else (list-ref terms j)]))) + (loop (add1 i))))])))] + + ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. + [`(/ ,x ,y) + `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] + + ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). + [`(abs ,arg) + `(* (sgn ,arg) ,(symbolic-diff arg var))] + + ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. + [`(sgn ,arg) 0.0] + + ;; Otherwise, return false. + [else #f])) + +;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). +(define (symbolic-simp-rule expr) + (match expr + ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. + [`(+ 0 ,x) `,x] + [`(+ 0.0 ,x) `,x] + [`(+ -0.0 ,x) `,x] + + ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. + [`(* 1 ,x) `,x] + [`(* 1.0 ,x) `,x] + + ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. + [`(* 0 ,x) 0] + [`(* 0.0 ,x) 0.0] + [`(* -0.0 ,x) 0.0] + + ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. + [`(- ,x 0) `,x] + [`(- ,x 0.0) `,x] + [`(- ,x -0.0) `,x] + + ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). + [`(- 0 ,x) `(* -1 ,x)] + [`(- 0.0 ,x) `(* -1.0 ,x)] + [`(- -0.0 ,x) `(* -1.0 ,x)] + + ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. + [`(/ ,x 1) `,x] + [`(/ ,x 1.0) `,x] + + ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). + [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] + [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] + + ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). + [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] + [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] + + ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. + [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] + [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] + + ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients + [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] + [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] + + ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. + [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] + + ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). + [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] + + ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). + [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] + + ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). + [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] + + ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). + [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] + + ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). + [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] + + ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). + [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] + ;; Likewise for differences. + [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] + + ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. + [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] + + ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). + [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] + + ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). + [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] + + ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. + [`(sqrt (* ,x ,x)) `,x] + [`(* (sqrt ,x) (sqrt ,x)) `,x] + + ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). + [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] + ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). + [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] + + ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). + [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] + + ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. + [`(sqrt ,(and x (? number?))) (sqrt x)] + + ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. + [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] + [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] + + ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., + [`(abs ,(and x (? number?))) (abs x)] + + ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). + [`(abs (* -1 ,x)) `(abs ,x)] + [`(abs (* -1.0 ,x)) `(abs ,x)] + + ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). + [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] + [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + + ;; If expr is of the form (x + x), thens implify to (2.0 * x). + [`(+ ,x ,x) `(* 2.0 ,x)] + + ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). + [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] + + ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). + [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] + + ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). + [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] + + ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). + [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] + + ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). + [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] + [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] + + ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). + [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] + + ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). + [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] + + ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). + [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] + [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + + ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). + [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] + + ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). + [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] + + ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. + [`(/ 0 ,x) 0] + [`(/ 0.0 ,x) 0.0] + [`(/ -0.0 ,x) 0.0] + + ;; If expr is of the form (x / x), then simplify to 1.0 + [`(/ ,x ,x) 1.0] + + ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). + [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] + ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). + [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] + + ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). + [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] + + ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). + [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] + [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] + + ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). + [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] + [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] + + ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for differences. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. + [`(* . ,terms) + `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for quotients. + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. + [`(sqrt ,arg) + `(sqrt ,(symbolic-simp-rule arg))] + + ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. + [`(abs ,arg) + `(abs ,(symbolic-simp-rule arg))] + + ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). + [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] + [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] + + ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). + [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). + [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] + + ;; If expr is of the form expt(x, y) for numeric x and y, then just evaluate the exponential. + [`(expt ,(and x (? number?)) ,(and y (? number?))) (expt x y)] + ;; If expr is of the form expt(expr1, expr2), then apply symbolic simplification to the interior expr1 and expr2. + [`(expt ,x ,y) `(expt ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] + + ;; If expr is of the form (x < y) for numeric x and y, then just evaluate the comparison operator. + [`( < ,(and x (? number?)) ,(and y (? number?))) (< x y)] + ;; If expr is of the form (expr1 < expr2), then apply symbolic simplification to the interior expr1 and expr2. + [`(< ,x ,y) `(< ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] + + ;; Otherwise, return the expression. + [else expr])) + +;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). +(define (symbolic-simp expr) + (define simp-expr (symbolic-simp-rule expr)) + + (cond + [(equal? simp-expr expr) expr] + [else (symbolic-simp simp-expr)])) + +;; Recursively determine whether an expression corresponds to a real number. +(define (is-real expr cons-vars parameters) + (match expr + ;; Real numbers are trivially real. + [(? real?) #t] + + ;; Conserved variables are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (not (equal? (member arg cons-vars) #f)))) #t] + + ;; Simulation parameters are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (equal? arg (list-ref parameter 1))) parameters)))) #t] + + ;; The outcome of a conditional operation is real if both branches yield real numbers. + [`(cond + [,cond1 ,expr1] + [else ,expr2]) + (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] + + ;; The sum, difference, product, or quotient of two real numbers is always real. + [`(+ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(- . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(* . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(/ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + + ;; Otherwise, assume false. + [else #f])) + +;; Recursively differentiate expr with respect to var until the result is 0, and return the necessary order of differentiation. +(define (symbolic-diff-order expr var order) + (define diff-expr (symbolic-simp (symbolic-diff expr var))) + + (cond + [(or (equal? diff-expr 0.0) (equal? diff-expr 0)) (+ order 1)] + [(> order 1) +inf.0] + [else (symbolic-diff-order diff-expr var (+ order 1))])) + +;; -------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Scalar PDE +;; -------------------------------------------------------------------------------------------- +(define (prove-scalar-1d-smooth pde neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 1D scalar PDE specified by `pde`, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + + (define flux-deriv-order (symbolic-diff-order flux-expr cons-expr 0)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the neural network depth is at least equal to 2 + the order of the derivative of the flux function (otherwise, return infinity). + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,flux-deriv-order))) #f)) +inf.0] + + ;; Otherwise, return the bound. + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,flux-deriv-order)))))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + + out) +(trace prove-scalar-1d-smooth) + +;; ------------------------------------------------------------------------------------------------ +;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Scalar PDE +;; ------------------------------------------------------------------------------------------------ +(define (prove-scalar-1d-non-smooth pde neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])]) + "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 1D scalar PDE specified by `pde`, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr (hash-ref pde 'flux-expr)) + (define parameters (hash-ref pde 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + + (define flux-deriv-order (symbolic-diff-order flux-expr cons-expr 0)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the neural network depth is at least equal to 2 * the order of the derivative of the flux function (otherwise, return infinity). + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,flux-deriv-order))) #f)) +inf.0] + + ;; Otherwise, return the bound. + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,flux-deriv-order)))))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + + out) +(trace prove-scalar-1d-non-smooth) + +;; -------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Scalar PDE +;; -------------------------------------------------------------------------------------------- +(define (prove-scalar-2d-smooth pde neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 2D scalar PDE specified by `pde`, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + + (define flux-deriv-order-x (symbolic-diff-order flux-expr-x cons-expr 0)) + (define flux-deriv-order-y (symbolic-diff-order flux-expr-y cons-expr 0)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the neural network depth is at least equal to 3 + the order of the derivative of the flux function (otherwise, return infinity). + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,flux-deriv-order-x))) #f)) +inf.0] + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,flux-deriv-order-y))) #f)) +inf.0] + + ;; Otherwise, return the bound. + [else (max (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,flux-deriv-order-x))))) + (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,flux-deriv-order-y))))))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + + out) +(trace prove-scalar-2d-smooth) + +;; ------------------------------------------------------------------------------------------------ +;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Scalar PDE +;; ------------------------------------------------------------------------------------------------ +(define (prove-scalar-2d-non-smooth pde neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-func [init-func `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.5) 1.0] + [else 0.0])]) + "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 2D scalar PDE specified by `pde`, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." + + (define cons-expr (hash-ref pde 'cons-expr)) + (define flux-expr-x (hash-ref pde 'flux-expr-x)) + (define flux-expr-y (hash-ref pde 'flux-expr-y)) + (define parameters (hash-ref pde 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + + (define flux-deriv-order-x (symbolic-diff-order flux-expr-x cons-expr 0)) + (define flux-deriv-order-y (symbolic-diff-order flux-expr-y cons-expr 0)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(not (is-real init-func (list cons-expr) parameters)) #f] + + ;; Check whether the neural network depth is at least equal to 3 * the order of the derivative of the flux function (otherwise, return infinity). + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,flux-deriv-order-x))) #f)) +inf.0] + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,flux-deriv-order-y))) #f)) +inf.0] + + ;; Otherwise, return the bound. + [else (max (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,flux-deriv-order-x))))) + (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,flux-deriv-order-y))))))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + + out) +(trace prove-scalar-2d-non-smooth) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/prover_matrix.rkt b/provable-algorithms/neural_networks/prover_matrix.rkt new file mode 100644 index 00000000..4f152502 --- /dev/null +++ b/provable-algorithms/neural_networks/prover_matrix.rkt @@ -0,0 +1,901 @@ +#lang racket + +(require racket/trace) +(current-prefix-in " ") +(current-prefix-out " ") + +(provide symbolic-diff + symbolic-simp-rule + symbolic-simp + is-real + symbolic-diff-order + symbolic-jacobian-order + prove-vector3-1d-smooth + prove-vector3-1d-non-smooth + prove-vector4-2d-smooth + prove-vector4-2d-non-smooth) + +;; Lightweight symbolic differentiator (differentiates expr with respect to var). +(define (symbolic-diff expr var) + (match expr + ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. + [(? symbol? symb) (cond + [(eq? symb var) 1.0] + [else 0.0])] + + ;; If expr is a numerical constant, then it differentiates to 0. + [(? number?) 0.0] + + ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] + ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] + + ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. + [`(* . ,terms) + (define n (length terms)) + (define (mult xs) (cons '* xs)) ; Multiplication helper function. + + ((lambda (sums) (cond + [(null? (cdr sums)) (car sums)] + [else (cons '+ sums)])) + (let loop ([i 0]) + (cond + [(= i n) `()] + [else + ;; Evaluate the derivative of the i-th term in the product. + (let ([di (symbolic-diff (list-ref terms i) var)]) + (cons + (mult (for/list ([j (in-range n)]) + (cond + [(= j i) di] + [else (list-ref terms j)]))) + (loop (add1 i))))])))] + + ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. + [`(/ ,x ,y) + `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] + + ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). + [`(abs ,arg) + `(* (sgn ,arg) ,(symbolic-diff arg var))] + + ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. + [`(sgn ,arg) 0.0] + + ;; Otherwise, return false. + [else #f])) + +;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). +(define (symbolic-simp-rule expr) + (match expr + ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. + [`(+ 0 ,x) `,x] + [`(+ 0.0 ,x) `,x] + [`(+ -0.0 ,x) `,x] + + ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. + [`(* 1 ,x) `,x] + [`(* 1.0 ,x) `,x] + + ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. + [`(* 0 ,x) 0] + [`(* 0.0 ,x) 0.0] + [`(* -0.0 ,x) 0.0] + + ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. + [`(- ,x 0) `,x] + [`(- ,x 0.0) `,x] + [`(- ,x -0.0) `,x] + + ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). + [`(- 0 ,x) `(* -1 ,x)] + [`(- 0.0 ,x) `(* -1.0 ,x)] + [`(- -0.0 ,x) `(* -1.0 ,x)] + + ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. + [`(/ ,x 1) `,x] + [`(/ ,x 1.0) `,x] + + ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). + [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] + [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] + + ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). + [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] + [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] + + ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. + [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] + [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] + + ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients + [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] + [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] + + ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. + [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] + + ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). + [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] + + ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). + [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] + + ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). + [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] + + ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). + [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] + + ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). + [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] + + ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). + [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] + ;; Likewise for differences. + [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] + + ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. + [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] + + ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). + [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] + + ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). + [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] + + ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. + [`(sqrt (* ,x ,x)) `,x] + [`(* (sqrt ,x) (sqrt ,x)) `,x] + + ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). + [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] + ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). + [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] + + ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). + [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] + + ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. + [`(sqrt ,(and x (? number?))) (sqrt x)] + + ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. + [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] + [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] + + ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., + [`(abs ,(and x (? number?))) (abs x)] + + ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). + [`(abs (* -1 ,x)) `(abs ,x)] + [`(abs (* -1.0 ,x)) `(abs ,x)] + + ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). + [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] + [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + + ;; If expr is of the form (x + x), thens implify to (2.0 * x). + [`(+ ,x ,x) `(* 2.0 ,x)] + + ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). + [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] + + ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). + [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] + + ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). + [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] + + ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). + [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] + + ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). + [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] + [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] + + ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). + [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] + + ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). + [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] + + ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). + [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] + [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + + ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). + [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] + + ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). + [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] + + ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. + [`(/ 0 ,x) 0] + [`(/ 0.0 ,x) 0.0] + [`(/ -0.0 ,x) 0.0] + + ;; If expr is of the form (x / x), then simplify to 1.0 + [`(/ ,x ,x) 1.0] + + ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). + [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] + ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). + [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] + + ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). + [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] + + ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). + [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] + [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] + + ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). + [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] + [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] + + ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for differences. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. + [`(* . ,terms) + `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for quotients. + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. + [`(sqrt ,arg) + `(sqrt ,(symbolic-simp-rule arg))] + + ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. + [`(abs ,arg) + `(abs ,(symbolic-simp-rule arg))] + + ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). + [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] + [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] + + ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). + [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). + [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] + + ;; If expr is of the form expt(x, y) for numeric x and y, then just evaluate the exponential. + [`(expt ,(and x (? number?)) ,(and y (? number?))) (expt x y)] + ;; If expr is of the form expt(expr1, expr2), then apply symbolic simplification to the interior expr1 and expr2. + [`(expt ,x ,y) `(expt ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] + + ;; If expr is of the form (x < y) for numeric x and y, then just evaluate the comparison operator. + [`( < ,(and x (? number?)) ,(and y (? number?))) (< x y)] + ;; If expr is of the form (expr1 < expr2), then apply symbolic simplification to the interior expr1 and expr2. + [`(< ,x ,y) `(< ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] + + ;; Otherwise, return the expression. + [else expr])) + +;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). +(define (symbolic-simp expr) + (define simp-expr (symbolic-simp-rule expr)) + + (cond + [(equal? simp-expr expr) expr] + [else (symbolic-simp simp-expr)])) + +;; Recursively determine whether an expression corresponds to a real number. +(define (is-real expr cons-vars parameters) + (match expr + ;; Real numbers are trivially real. + [(? real?) #t] + + ;; Conserved variables are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (not (equal? (member arg cons-vars) #f)))) #t] + + ;; Simulation parameters are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (equal? arg (list-ref parameter 1))) parameters)))) #t] + + ;; The outcome of a conditional operation is real if both branches yield real numbers. + [`(cond + [,cond1 ,expr1] + [else ,expr2]) + (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] + + ;; The sum, difference, product, or quotient of two real numbers is always real. + [`(+ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(- . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(* . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(/ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + + ;; Otherwise, assume false. + [else #f])) + +;; Recursively differentiate expr with respect to var until the result is 0, and return the necessary order of differentiation. +(define (symbolic-diff-order expr var order) + (define diff-expr (symbolic-simp (symbolic-diff expr var))) + + (cond + [(or (equal? diff-expr 0.0) (equal? diff-expr 0)) (+ order 1)] + [(> order 1) #f] + [else (symbolic-diff-order diff-expr var (+ order 1))])) + +;; Recursively differentiate each component of exprs with respect to each component of vars until the results are 0, and return the necessary orders of differentiation. +(define (symbolic-jacobian-order exprs vars) + (map (lambda (expr) + (map (lambda (var) + (symbolic-diff-order expr var 0)) + vars)) + exprs)) + +;; ----------------------------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Coupled Vector System of 3 PDEs +;; ----------------------------------------------------------------------------------------------------------------- +(define (prove-vector3-1d-smooth pde-system neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 0.0] + [else 0.0]) + `(cond + [(< x 0.5) 7.5] + [else 2.5]))]) + "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde-system`, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + (trace symbolic-jacobian-order) + + (define flux-jacobian-order (symbolic-jacobian-order flux-exprs cons-exprs)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the neural network depth is at least equal to 2 + the order of each component of the Jacobian of the flux function: if so, return the bounds; + ;; otherwise, return false. + [else (list (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 2) 2))))))]))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + (untrace symbolic-jacobian-order) + + out) +(trace prove-vector3-1d-smooth) + +;; --------------------------------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Coupled Vector System of 3 PDEs +;; --------------------------------------------------------------------------------------------------------------------- +(define (prove-vector3-1d-non-smooth pde-system neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 0.0] + [else 0.0]) + `(cond + [(< x 0.5) 7.5] + [else 2.5]))]) + "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 1D coupled vector system of 3 PDEs specified by `pde-system`, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + (trace symbolic-jacobian-order) + + (define flux-jacobian-order (symbolic-jacobian-order flux-exprs cons-exprs)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the neural network depth is at least equal to 2 * the order of each component of the Jacobian of the flux function: if so, return the bounds; + ;; otherwise, return false. + [else (list (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 2) 2))))))]))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + (untrace symbolic-jacobian-order) + + out) +(trace prove-vector3-1d-non-smooth) + +;; ----------------------------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Coupled Vector System of 4 PDEs +;; ----------------------------------------------------------------------------------------------------------------- +(define (prove-vector4-2d-smooth pde-system neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde-system`, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + (trace symbolic-jacobian-order) + + (define flux-jacobian-order-x (symbolic-jacobian-order flux-exprs-x cons-exprs)) + (define flux-jacobian-order-y (symbolic-jacobian-order flux-exprs-y cons-exprs)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 3) cons-exprs parameters))) #f] + + ;; Check whether the neural network depth is at least equal to 3 + the order of each component of the Jacobian of the flux function: if so, return the bounds; + ;; otherwise, return false. + [else (list (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 3))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 3))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 3))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 3))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 3))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 3))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 3))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 3))))))])))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + (untrace symbolic-jacobian-order) + + out) +(trace prove-vector4-2d-smooth) + +;; ----------------------------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Coupled Vector System of 4 PDEs +;; ----------------------------------------------------------------------------------------------------------------- +(define (prove-vector4-2d-non-smooth pde-system neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 2D coupled vector system of 4 PDEs specified by `pde-system`, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + (trace symbolic-jacobian-order) + + (define flux-jacobian-order-x (symbolic-jacobian-order flux-exprs-x cons-exprs)) + (define flux-jacobian-order-y (symbolic-jacobian-order flux-exprs-y cons-exprs)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 3) cons-exprs parameters))) #f] + + ;; Check whether the neural network depth is at least equal to 3 * the order of each component of the Jacobian of the flux function: if so, return the bounds; + ;; otherwise, return false. + [else (list (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 3))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 3))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 3))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 3))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 3))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 3))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 3) 3))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 3)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 3) 3))))))])))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + (untrace symbolic-jacobian-order) + + out) +(trace prove-vector4-2d-non-smooth) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/prover_vector.rkt b/provable-algorithms/neural_networks/prover_vector.rkt new file mode 100644 index 00000000..87661b59 --- /dev/null +++ b/provable-algorithms/neural_networks/prover_vector.rkt @@ -0,0 +1,826 @@ +#lang racket + +(require racket/trace) +(current-prefix-in " ") +(current-prefix-out " ") + +(provide symbolic-diff + symbolic-simp-rule + symbolic-simp + is-real + symbolic-diff-order + symbolic-jacobian-order + symbolic-jacobian + symbolic-eigvals2 + symbolic-eigvals3 + prove-vector2-1d-smooth + prove-vector2-1d-non-smooth + prove-vector3-2d-smooth + prove-vector3-2d-non-smooth) + +;; Lightweight symbolic differentiator (differentiates expr with respect to var). +(define (symbolic-diff expr var) + (match expr + ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. + [(? symbol? symb) (cond + [(eq? symb var) 1.0] + [else 0.0])] + + ;; If expr is a numerical constant, then it differentiates to 0. + [(? number?) 0.0] + + ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] + ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] + + ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. + [`(* . ,terms) + (define n (length terms)) + (define (mult xs) (cons '* xs)) ; Multiplication helper function. + + ((lambda (sums) (cond + [(null? (cdr sums)) (car sums)] + [else (cons '+ sums)])) + (let loop ([i 0]) + (cond + [(= i n) `()] + [else + ;; Evaluate the derivative of the i-th term in the product. + (let ([di (symbolic-diff (list-ref terms i) var)]) + (cons + (mult (for/list ([j (in-range n)]) + (cond + [(= j i) di] + [else (list-ref terms j)]))) + (loop (add1 i))))])))] + + ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. + [`(/ ,x ,y) + `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] + + ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). + [`(abs ,arg) + `(* (sgn ,arg) ,(symbolic-diff arg var))] + + ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. + [`(sgn ,arg) 0.0] + + ;; Otherwise, return false. + [else #f])) + +;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). +(define (symbolic-simp-rule expr) + (match expr + ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. + [`(+ 0 ,x) `,x] + [`(+ 0.0 ,x) `,x] + [`(+ -0.0 ,x) `,x] + + ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. + [`(* 1 ,x) `,x] + [`(* 1.0 ,x) `,x] + + ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. + [`(* 0 ,x) 0] + [`(* 0.0 ,x) 0.0] + [`(* -0.0 ,x) 0.0] + + ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. + [`(- ,x 0) `,x] + [`(- ,x 0.0) `,x] + [`(- ,x -0.0) `,x] + + ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). + [`(- 0 ,x) `(* -1 ,x)] + [`(- 0.0 ,x) `(* -1.0 ,x)] + [`(- -0.0 ,x) `(* -1.0 ,x)] + + ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. + [`(/ ,x 1) `,x] + [`(/ ,x 1.0) `,x] + + ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). + [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] + [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] + + ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). + [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] + [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] + + ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. + [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] + [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] + + ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients + [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] + [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] + + ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. + [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] + + ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). + [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] + + ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). + [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] + + ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). + [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] + + ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). + [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] + + ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). + [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] + + ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). + [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] + ;; Likewise for differences. + [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] + + ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. + [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] + + ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). + [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] + + ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). + [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] + + ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. + [`(sqrt (* ,x ,x)) `,x] + [`(* (sqrt ,x) (sqrt ,x)) `,x] + + ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). + [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] + ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). + [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] + + ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). + [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] + + ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. + [`(sqrt ,(and x (? number?))) (sqrt x)] + + ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. + [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] + [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] + + ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., + [`(abs ,(and x (? number?))) (abs x)] + + ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). + [`(abs (* -1 ,x)) `(abs ,x)] + [`(abs (* -1.0 ,x)) `(abs ,x)] + + ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). + [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] + [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] + + ;; If expr is of the form (x + x), thens implify to (2.0 * x). + [`(+ ,x ,x) `(* 2.0 ,x)] + + ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). + [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] + + ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). + [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] + + ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). + [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] + + ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). + [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] + + ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). + [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] + [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] + + ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). + [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] + + ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). + [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] + + ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). + [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] + [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] + + ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). + [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] + + ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). + [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] + + ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. + [`(/ 0 ,x) 0] + [`(/ 0.0 ,x) 0.0] + [`(/ -0.0 ,x) 0.0] + + ;; If expr is of the form (x / x), then simplify to 1.0 + [`(/ ,x ,x) 1.0] + + ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). + [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] + ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). + [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] + + ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). + [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] + + ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). + [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] + [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] + + ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). + [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] + [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] + + ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. + [`(+ . ,terms) + `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for differences. + [`(- . ,terms) + `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. + [`(* . ,terms) + `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + ;; Likewise for quotients. + [`(/ . ,terms) + `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] + + ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. + [`(sqrt ,arg) + `(sqrt ,(symbolic-simp-rule arg))] + + ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. + [`(abs ,arg) + `(abs ,(symbolic-simp-rule arg))] + + ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). + [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] + [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] + + ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). + [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). + [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] + + ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] + [(? (lambda (arg) + (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] + + ;; If expr is of the form expt(x, y) for numeric x and y, then just evaluate the exponential. + [`(expt ,(and x (? number?)) ,(and y (? number?))) (expt x y)] + ;; If expr is of the form expt(expr1, expr2), then apply symbolic simplification to the interior expr1 and expr2. + [`(expt ,x ,y) `(expt ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] + + ;; If expr is of the form (x < y) for numeric x and y, then just evaluate the comparison operator. + [`( < ,(and x (? number?)) ,(and y (? number?))) (< x y)] + ;; If expr is of the form (expr1 < expr2), then apply symbolic simplification to the interior expr1 and expr2. + [`(< ,x ,y) `(< ,(symbolic-simp-rule x) ,(symbolic-simp-rule y))] + + ;; Otherwise, return the expression. + [else expr])) + +;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). +(define (symbolic-simp expr) + (define simp-expr (symbolic-simp-rule expr)) + + (cond + [(equal? simp-expr expr) expr] + [else (symbolic-simp simp-expr)])) + +;; Recursively determine whether an expression corresponds to a real number. +(define (is-real expr cons-vars parameters) + (match expr + ;; Real numbers are trivially real. + [(? real?) #t] + + ;; Conserved variables are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (not (equal? (member arg cons-vars) #f)))) #t] + + ;; Simulation parameters are assumed to be real (this is enforced elsewhere). + [(? (lambda (arg) + (and (not (empty? parameters)) (ormap (lambda (parameter) + (equal? arg (list-ref parameter 1))) parameters)))) #t] + + ;; The outcome of a conditional operation is real if both branches yield real numbers. + [`(cond + [,cond1 ,expr1] + [else ,expr2]) + (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] + + ;; The sum, difference, product, or quotient of two real numbers is always real. + [`(+ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(- . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(* . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + [`(/ . ,terms) + (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] + + ;; Otherwise, assume false. + [else #f])) + +;; Recursively differentiate expr with respect to var until the result is 0, and return the necessary order of differentiation. +(define (symbolic-diff-order expr var order) + (define diff-expr (symbolic-simp (symbolic-diff expr var))) + + (cond + [(or (equal? diff-expr 0.0) (equal? diff-expr 0)) (+ order 1)] + [(> order 1) +inf.0] + [else (symbolic-diff-order diff-expr var (+ order 1))])) + +;; Recursively differentiate each component of exprs with respect to each component of vars until the results are 0, and return the necessary orders of differentiation. +(define (symbolic-jacobian-order exprs vars) + (map (lambda (expr) + (map (lambda (var) + (symbolic-diff-order expr var 0)) + vars)) + exprs)) + +;; Compute symbolic Jacobian matrix by mapping symbolic differentiation over exprs with respect to vars. +(define (symbolic-jacobian exprs vars) + (map (lambda (expr) + (map (lambda (var) + (symbolic-simp (symbolic-diff expr var))) + vars)) + exprs)) + +;; Compute symbolic eigenvalues of a 2x2 symbolic matrix via explicit solution of the characteristic polynomial. +(define (symbolic-eigvals2 matrix) + (let ([a (list-ref (list-ref matrix 0) 0)] + [b (list-ref (list-ref matrix 0) 1)] + [c (list-ref (list-ref matrix 1) 0)] + [d (list-ref (list-ref matrix 1) 1)]) + (cond + ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a pair of zeroes. + [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0)) (list 0.0 0.0)] + + ;; Otherwise, calculate the eigenvalues explicitly. + [else (list `(* 0.5 (+ (- ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)) + `(* 0.5 (+ (+ ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)))]))) + +;; Compute symbolic eigenvalues of a 3x3 symbolic matrix (in restricted cases) via explicit solution of the characteristic polynomial. +(define (symbolic-eigvals3 matrix) + (let ([a (list-ref (list-ref matrix 0) 0)] + [b (list-ref (list-ref matrix 0) 1)] + [c (list-ref (list-ref matrix 0) 2)] + [d (list-ref (list-ref matrix 1) 0)] + [e (list-ref (list-ref matrix 1) 1)] + [f (list-ref (list-ref matrix 1) 2)] + [g (list-ref (list-ref matrix 2) 0)] + [h (list-ref (list-ref matrix 2) 1)] + [i (list-ref (list-ref matrix 2) 2)]) + (cond + ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a triple of zeroes. + [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0) (equal? e 0.0) (equal? f 0.0) (equal? g 0.0) (equal? h 0.0) (equal? i 0.0)) (list 0.0 0.0 0.0)] + + ;; If the matrix is in a restricted (tractable) form, calculate the eigenvalues explicitly. + [(and (equal? a 0.0) (equal? b 1.0) (equal? c 0.0) (equal? f 0.0)) + (list `(* 0.5 (- ,e (sqrt (+ (* 4.0 ,d) (* ,e ,e))))) `(* 0.5 (+ ,e (sqrt (+ (* 4.0 ,d) (* ,e ,e))))) i)] + [(and (equal? a 0.0) (equal? b 0.0) (equal? c 1.0) (equal? h 0.0)) + (list e `(* 0.5 (- ,i (sqrt (+ (* 4.0 ,g) (* ,i ,i))))) `(* 0.5 (+ ,i (sqrt (+ (* 4.0 ,g) (* ,i ,i))))))] + + ;; Otherwise, return false(s). + [else (list #f #f #f)]))) + +;; ----------------------------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Coupled Vector System of 2 PDEs +;; ----------------------------------------------------------------------------------------------------------------- +(define (prove-vector2-1d-smooth pde-system neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system`, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + (trace symbolic-jacobian-order) + + (define flux-jacobian-order (symbolic-jacobian-order flux-exprs cons-exprs)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the neural network depth is at least equal to 2 + the order of each component of the Jacobian of the flux function: if so, return the bounds; + ;; otherwise, return false. + [else (list (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 0) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 2 ,(list-ref (list-ref flux-jacobian-order 1) 1))))))]))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + (untrace symbolic-jacobian-order) + + out) +(trace prove-vector2-1d-smooth) + +;; --------------------------------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 1D Coupled Vector System of 2 PDEs +;; --------------------------------------------------------------------------------------------------------------------- +(define (prove-vector2-1d-non-smooth pde-system neural-net + #:nx [nx 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))]) + "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 1D coupled vector system of 2 PDEs specified by `pde-system`, + with neural network architecture `neural-net`. + - `nx` : Number of spatial cells. + - `x0`, `x1` : Domain boundaries. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs (hash-ref pde-system 'flux-exprs)) + (define parameters (hash-ref pde-system 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + (trace symbolic-jacobian-order) + + (define flux-jacobian-order (symbolic-jacobian-order flux-exprs cons-exprs)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] + + ;; Check whether the neural network depth is at least equal to 2 * the order of each component of the Jacobian of the flux function: if so, return the bounds; + ;; otherwise, return false. + [else (list (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 0) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 2 ,(list-ref (list-ref flux-jacobian-order 1) 1))))))]))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + (untrace symbolic-jacobian-order) + + out) +(trace prove-vector2-1d-non-smooth) + +;; ----------------------------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Coupled Vector System of 3 PDEs +;; ----------------------------------------------------------------------------------------------------------------- +(define (prove-vector3-2d-smooth pde-system neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Attempt to prove an analytic error bound on smooth solutions for an arbitrary surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system`, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + (trace symbolic-jacobian-order) + + (define flux-jacobian-order-x (symbolic-jacobian-order flux-exprs-x cons-exprs)) + (define flux-jacobian-order-y (symbolic-jacobian-order flux-exprs-y cons-exprs)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the neural network depth is at least equal to 3 + the order of each component of the Jacobian of the flux function: if so, return the bounds; + ;; otherwise, return false. + [else (list (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (+ 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2))))))])))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + (untrace symbolic-jacobian-order) + + out) +(trace prove-vector3-2d-smooth) + +;; --------------------------------------------------------------------------------------------------------------------- +;; Prove Error Bounds on Non-Smooth Solutions for an Arbitrary Surrogate Solver for a 2D Coupled Vector System of 3 PDEs +;; --------------------------------------------------------------------------------------------------------------------- +(define (prove-vector3-2d-non-smooth pde-system neural-net + #:nx [nx 200] + #:ny [ny 200] + #:x0 [x0 0.0] + #:x1 [x1 2.0] + #:y0 [y0 0.0] + #:y1 [y1 2.0] + #:t-final [t-final 1.0] + #:cfl [cfl 0.95] + #:init-funcs [init-funcs (list + `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 5.0] + [else 1.0]) + `0.0 + `0.0)]) + "Attempt to prove an analytic error bound on non-smooth solutions for an arbitrary surrogate solver for the 2D coupled vector system of 3 PDEs specified by `pde-system`, + with neural network architecture `neural-net`. + - `nx`, `ny` : Number of spatial cells in each coordinate direction. + - `x0`, `x1`, `y0`, `y1` : Domain boundaries in each coordinate direction. + - `t-final`: Final time. + - `cfl`: CFL coefficient. + - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." + + (define cons-exprs (hash-ref pde-system 'cons-exprs)) + (define flux-exprs-x (hash-ref pde-system 'flux-exprs-x)) + (define flux-exprs-y (hash-ref pde-system 'flux-exprs-y)) + (define parameters (hash-ref pde-system 'parameters)) + + (define width (hash-ref neural-net 'width)) + (define depth (hash-ref neural-net 'depth)) + + (trace is-real) + (trace symbolic-simp) + (trace symbolic-simp-rule) + (trace symbolic-diff) + (trace symbolic-diff-order) + (trace symbolic-jacobian-order) + + (define flux-jacobian-order-x (symbolic-jacobian-order flux-exprs-x cons-exprs)) + (define flux-jacobian-order-y (symbolic-jacobian-order flux-exprs-y cons-exprs)) + + (define out (cond + ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). + [(or (<= cfl 0) (> cfl 1)) #f] + + ;; Check whether the number of spatial cells is at least 1 and the right/bottom domain boundary is set to the right/below of the left/top boundary (otherwise, return false) + [(or (< nx 1) (>= x0 x1)) #f] + [(or (< ny 1) (>= y0 y1)) #f] + + ;; Check whether the final simulation time is non-negative (otherwise, return false). + [(< t-final 0) #f] + + ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). + [(not (or (empty? parameters) (andmap (lambda (parameter) + (is-real (list-ref parameter 2) (list cons-exprs) parameters)) parameters))) #f] + + ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). + [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 1) cons-exprs parameters)) + (not (is-real (list-ref init-funcs 2) cons-exprs parameters))) #f] + + ;; Check whether the neural network depth is at least equal to 3 * the order of each component of the Jacobian of the flux function: if so, return the bounds; + ;; otherwise, return false. + [else (list (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 0) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 0) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 1) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 1) 2))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 0))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 0))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 1))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 1))))))])) + (max (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-x 2) 2))))))]) + (cond + [(not (equal? (symbolic-simp `(< ,depth (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2)))) #f)) +inf.0] + [else (symbolic-simp `(/ 1.0 (expt (* ,width ,depth) (/ 1.0 (* 3 ,(list-ref (list-ref flux-jacobian-order-y 2) 2))))))])))])) + + (untrace is-real) + (untrace symbolic-simp) + (untrace symbolic-simp-rule) + (untrace symbolic-diff) + (untrace symbolic-diff-order) + (untrace symbolic-jacobian-order) + + out) +(trace prove-vector3-2d-non-smooth) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/test_euler_shallow.rkt b/provable-algorithms/neural_networks/test_euler_shallow.rkt new file mode 100644 index 00000000..04a8b96d --- /dev/null +++ b/provable-algorithms/neural_networks/test_euler_shallow.rkt @@ -0,0 +1,450 @@ +#lang racket + +(require "code_generator_core_training.rkt") +(require "code_generator_matrix_training.rkt") +(require "code_generator_matrix_training_2d.rkt") +(require "code_generator_matrix_validation.rkt") +(require "prover_matrix.rkt") +(provide (all-from-out "code_generator_core_training.rkt")) +(provide (all-from-out "code_generator_matrix_training.rkt")) +(provide (all-from-out "code_generator_matrix_training_2d.rkt")) +(provide (all-from-out "code_generator_matrix_validation.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D Euler equations (density, x-momentum, and total energy components). +(define pde-system-euler + (hash + 'name "euler" + 'cons-exprs (list + `rho + `mom_x + `energy) ; conserved variables: density, x-momentum, total energy + 'flux-exprs (list + `mom_x + `(+ (/ (* mom_x mom_x) rho) (* (- gamma 1.0) (- energy (* 0.5 (/ (* mom_x mom_x) rho))))) + `(* (+ energy (* (- gamma 1.0) (- energy (* 0.5 (/ (* mom_x mom_x) rho))))) (/ mom_x rho))) + ; flux vector + 'max-speed-exprs (list + `(abs (- (/ mom_x rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (/ (* mom_x mom_x) rho))))) rho)))) + `(abs (/ mom_x rho)) + `(abs (+ (/ mom_x rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (/ (* mom_x mom_x) rho))))) rho))))) + ; local wave-speeds + 'parameters (list + `(define gamma 1.4)) ; adiabatic index: gamma = 1.4 + )) + +;; Define simulation parameters. +(define nx 800) +(define x0 0.0) +(define x1 1.0) +(define t-final 0.1) +(define cfl 0.95) +(define init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 0.0] + [else 0.0]) + `(cond + [(< x 0.5) 7.5] + [else 2.5]))) + +;; Define (shallow) neural network hyperparameters. +(define neural-net-shallow + (hash + 'max-trains 10000 ; maximum number of training steps: 10000 + 'width 64 ; number of neurons in each layer: 64 + 'depth 6 ; total number of layers: 6 + 'num-threads 12 ; number of threads to use in training: 12 + 'mini-size 100 ; size of training mini-batch: 100 + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D Euler equations using a shallow neural network. +(define code-euler-lax-train + (train-lax-friedrichs-vector3-1d pde-system-euler neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/euler_lax_train.c" + #:exists 'replace + (lambda () + (display code-euler-lax-train))) + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-euler-lax-minmod-train + (train-lax-friedrichs-vector3-1d-second-order pde-system-euler limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/euler_lax_minmod_train.c" + #:exists 'replace + (lambda () + (display code-euler-lax-minmod-train))) + +(display "1D compressible Euler properties: \n\n") + +;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 1D Euler equations. +(define proof-euler-smooth + (call-with-output-file "proofs/proof_euler_smooth.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-vector3-1d-smooth pde-system-euler neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_euler_smooth.rkt") + +;; Show the error bounds (if applicable) on smooth solutions. +(display "Error bound on rho (smooth solutions): ") +(display (max (list-ref proof-euler-smooth 0) (list-ref proof-euler-smooth 1) (list-ref proof-euler-smooth 2))) +(display "\n") + +(display "Error bound on mom_x (smooth solutions): ") +(display (max (list-ref proof-euler-smooth 3) (list-ref proof-euler-smooth 4) (list-ref proof-euler-smooth 5))) +(display "\n") + +(display "Error bound on energy (smooth solutions): ") +(display (max (list-ref proof-euler-smooth 6) (list-ref proof-euler-smooth 7) (list-ref proof-euler-smooth 8))) +(display "\n") + +;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 1D Euler equations. +(define proof-euler-non-smooth + (call-with-output-file "proofs/proof_euler_non_smooth.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-vector3-1d-non-smooth pde-system-euler neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_euler_non_smooth.rkt") + +;; Show the error bounds (if applicable) on non-smooth solutions. +(display "Error bound on rho (non-smooth solutions): ") +(display (max (list-ref proof-euler-non-smooth 0) (list-ref proof-euler-non-smooth 1) (list-ref proof-euler-non-smooth 2))) +(display "\n") + +(display "Error bound on mom_x (non-smooth solutions): ") +(display (max (list-ref proof-euler-non-smooth 3) (list-ref proof-euler-non-smooth 4) (list-ref proof-euler-non-smooth 5))) +(display "\n") + +(display "Error bound on energy (non-smooth solutions): ") +(display (max (list-ref proof-euler-non-smooth 6) (list-ref proof-euler-non-smooth 7) (list-ref proof-euler-non-smooth 8))) +(display "\n\n\n") + +;; Synthesize the code to validate any first-order surrogate solver for the 1D Euler equations using a shallow neural network. +(define code-euler-validate + (validate-vector3-1d pde-system-euler neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/euler_validate.c" + #:exists 'replace + (lambda () + (display code-euler-validate))) + +;; Synthesize the code to validate any first-order surrogate solver for the 1D Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-euler-minmod-validate + (validate-vector3-1d-second-order pde-system-euler limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/euler_minmod_validate.c" + #:exists 'replace + (lambda () + (display code-euler-minmod-validate))) + +;; Define the 2D Euler equations (density, x-momentum and y-momentum, and total energy components). +(define pde-system-euler-2d + (hash + 'name "euler-2d" + 'cons-exprs (list + `rho + `mom_x + `mom_y + `energy) ; conserved variables: density, x-momentum, y-momentum, total energy + 'flux-exprs-x (list + `mom_x + `(+ (/ (* mom_x mom_x) rho) (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) + `(* mom_y (/ mom_x rho)) + `(* (+ energy (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) (/ mom_x rho))) + ; flux vector (x-direction) + 'flux-exprs-y (list + `mom_y + `(* mom_x (/ mom_y rho)) + `(+ (/ (* mom_y mom_y) rho) (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) + `(* (+ energy (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) (/ mom_y rho))) + ; flux vector (y-direction) + 'max-speed-exprs-x (list + `(abs (- (/ mom_x rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) rho)))) + `(abs (/ mom_x rho)) + `(abs (/ mom_x rho)) + `(abs (+ (/ mom_x rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) rho))))) + ; local wave-speeds (x-direction) + 'max-speed-exprs-y (list + `(abs (- (/ mom_y rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) rho)))) + `(abs (/ mom_y rho)) + `(abs (/ mom_y rho)) + `(abs (+ (/ mom_y rho) (sqrt (/ (* gamma (* (- gamma 1.0) (- energy (* 0.5 (+ (/ (* mom_x mom_x) rho) (/ (* mom_y mom_y) rho)))))) rho))))) + ; local wave-speeds (y-direction) + 'parameters (list + `(define gamma 1.4)) ; adiabatic index: gamma = 1.4 + )) + +;; Define 2D simulation parameters. +(define nx-2d 50) +(define ny-2d 50) +(define x0-2d 0.0) +(define x1-2d 1.0) +(define y0-2d 0.0) +(define y1-2d 1.0) +(define t-final-2d 0.8) +(define cfl-2d 0.95) +(define init-funcs-2d (list + `(cond + [(> y 0.8) + (cond + [(< x 0.8) 0.5323] + [else 1.5])] + [else + (cond + [(< x 0.8) 0.138] + [else 0.5323])]) + `(cond + [(> y 0.8) + (cond + [(< x 0.8) 0.641954] + [else 0.0])] + [else + (cond + [(< x 0.8) 0.166428] + [else 0.0])]) + `(cond + [(> y 0.8) + (cond + [(< x 0.8) 0.0] + [else 0.0])] + [else + (cond + [(< x 0.8) 0.166428] + [else 0.641954])]) + `(cond + [(> y 0.8) + (cond + [(< x 0.8) 1.137098] + [else 3.75])] + [else + (cond + [(< x 0.8) 0.273212] + [else 1.137098])]))) + +;; Define (shallow) neural network hyperparameters for 2D. +(define neural-net-shallow-2d + (hash + 'max-trains 10000 ; maximum number of training steps: 10000 + 'width 64 ; number of neurons in each layer: 64 + 'depth 6 ; total number of layers: 6 + 'num-threads 12 ; number of threads to use in training: 12 + 'mini-size 100 ; size of training mini-batch: 100 + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D Euler equations using a shallow neural network. +(define code-euler-lax-train-2d + (train-lax-friedrichs-vector4-2d pde-system-euler-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/euler_lax_train_2d.c" + #:exists 'replace + (lambda () + (display code-euler-lax-train-2d))) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-euler-lax-minmod-train-2d + (train-lax-friedrichs-vector4-2d-second-order pde-system-euler-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/euler_lax_minmod_train_2d.c" + #:exists 'replace + (lambda () + (display code-euler-lax-minmod-train-2d))) + +(display "2D compressible Euler properties: \n\n") + +;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 2D Euler equations. +(define proof-euler-smooth-2d + (call-with-output-file "proofs/proof_euler_smooth_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-vector4-2d-smooth pde-system-euler-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_euler_smooth_2d.rkt") + +;; Show the error bounds (if applicable) on smooth solutions. +(display "Error bound on rho (smooth solutions): ") +(display (max (list-ref proof-euler-smooth-2d 0) (list-ref proof-euler-smooth-2d 1) (list-ref proof-euler-smooth-2d 2) (list-ref proof-euler-smooth-2d 3))) +(display "\n") + +(display "Error bound on mom_x (smooth solutions): ") +(display (max (list-ref proof-euler-smooth-2d 4) (list-ref proof-euler-smooth-2d 5) (list-ref proof-euler-smooth-2d 6) (list-ref proof-euler-smooth-2d 7))) +(display "\n") + +(display "Error bound on mom_y (smooth solutions): ") +(display (max (list-ref proof-euler-smooth-2d 8) (list-ref proof-euler-smooth-2d 9) (list-ref proof-euler-smooth-2d 10) (list-ref proof-euler-smooth-2d 11))) +(display "\n") + +(display "Error bound on energy (smooth solutions): ") +(display (max (list-ref proof-euler-smooth-2d 12) (list-ref proof-euler-smooth-2d 13) (list-ref proof-euler-smooth-2d 14) (list-ref proof-euler-smooth-2d 15))) +(display "\n") + +;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 2D Euler equations. +(define proof-euler-non-smooth-2d + (call-with-output-file "proofs/proof_euler_non_smooth_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-vector4-2d-non-smooth pde-system-euler-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_euler_non_smooth_2d.rkt") + +;; Show the error bounds (if applicable) on non-smooth solutions. +(display "Error bound on rho (non-smooth solutions): ") +(display (max (list-ref proof-euler-non-smooth-2d 0) (list-ref proof-euler-non-smooth-2d 1) (list-ref proof-euler-non-smooth-2d 2) (list-ref proof-euler-non-smooth-2d 3))) +(display "\n") + +(display "Error bound on mom_x (non-smooth solutions): ") +(display (max (list-ref proof-euler-non-smooth-2d 4) (list-ref proof-euler-non-smooth-2d 5) (list-ref proof-euler-non-smooth-2d 6) (list-ref proof-euler-non-smooth-2d 7))) +(display "\n") + +(display "Error bound on mom_y (non-smooth solutions): ") +(display (max (list-ref proof-euler-non-smooth-2d 8) (list-ref proof-euler-non-smooth-2d 9) (list-ref proof-euler-non-smooth-2d 10) (list-ref proof-euler-non-smooth-2d 11))) +(display "\n") + +(display "Error bound on energy (non-smooth solutions): ") +(display (max (list-ref proof-euler-non-smooth-2d 12) (list-ref proof-euler-non-smooth-2d 13) (list-ref proof-euler-non-smooth-2d 14) (list-ref proof-euler-non-smooth-2d 15))) +(display "\n") + +;; Synthesize the code to validate any first-order surrogate solver for the 2D Euler equations using a shallow neural network. +(define code-euler-validate-2d + (validate-vector4-2d pde-system-euler-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/euler_validate_2d.c" + #:exists 'replace + (lambda () + (display code-euler-validate-2d))) + +;; Synthesize the code to validate any first-order surrogate solver for the 2D Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-euler-minmod-validate-2d + (validate-vector4-2d-second-order pde-system-euler-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/euler_minmod_validate_2d.c" + #:exists 'replace + (lambda () + (display code-euler-minmod-validate-2d))) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/test_inviscid_burgers_shallow.rkt b/provable-algorithms/neural_networks/test_inviscid_burgers_shallow.rkt new file mode 100644 index 00000000..f8904a5d --- /dev/null +++ b/provable-algorithms/neural_networks/test_inviscid_burgers_shallow.rkt @@ -0,0 +1,403 @@ +#lang racket + +(require "code_generator_core_training.rkt") +(require "code_generator_core_training_2d.rkt") +(require "code_generator_core_validation.rkt") +(require "prover_core.rkt") +(provide (all-from-out "code_generator_core_training.rkt")) +(provide (all-from-out "code_generator_core_training_2d.rkt")) +(provide (all-from-out "code_generator_core_validation.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D inviscid Burgers' equation: du/dt + u du/dx = 0. +(define pde-inviscid-burgers + (hash + 'name "burgers" + 'cons-expr `u ; conserved variable: u + 'flux-expr `(* 0.5 u u) ; flux function: f(u) = 0.5 * u^2 + 'max-speed-expr `(abs u) ; local wave-speed: alpha = |u| + 'parameters `() + )) + +;; Define simulation parameters. +(define nx 400) +(define x0 -3.0) +(define x1 3.0) +(define t-final 0.5) +(define cfl 0.95) +(define init-func `(cond + [(< (abs x) 1.0) 3.0] + [else -1.0])) + +;; Define (shallow) neural network hyperparameters. +(define neural-net-shallow + (hash + 'max-trains 10000 ; maximum number of training steps: 10000 + 'width 64 ; number of neurons in each layer: 64 + 'depth 6 ; total number of layers: 8 + 'num-threads 12 ; number of threads to use in training: 12 + 'mini-size 100 ; size of training mini-batch: 100 + )) + + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D inviscid Burgers' equation using a shallow neural network. +(define code-inviscid-burgers-lax-train + (train-lax-friedrichs-scalar-1d pde-inviscid-burgers neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax_train.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-train))) + +;; Synthesize the code to train a Roe surrogate solver for the 1D inviscid Burgers' equation using a shallow neural network. +(define code-inviscid-burgers-roe-train + (train-roe-scalar-1d pde-inviscid-burgers neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe_train.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-train))) + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-inviscid-burgers-lax-minmod-train + (train-lax-friedrichs-scalar-1d-second-order pde-inviscid-burgers limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax_minmod_train.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-minmod-train))) + +;; Synthesize the code to train a Roe surrogate solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-inviscid-burgers-roe-minmod-train + (train-roe-scalar-1d-second-order pde-inviscid-burgers limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe_minmod_train.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-minmod-train))) + +(display "1D inviscid Burgers' properties: \n\n") + +;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-smooth + (call-with-output-file "proofs/proof_inviscid_burgers_smooth.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-scalar-1d-smooth pde-inviscid-burgers neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_smooth.rkt") + +;; Show the error bound (if applicable) on smooth solutions. +(display "Error bound (smooth solutions): ") +(display proof-inviscid-burgers-smooth) +(display "\n") + +;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 1D inviscid Burgers' equation. +(define proof-inviscid-burgers-non-smooth + (call-with-output-file "proofs/proof_inviscid_burgers_non_smooth.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-scalar-1d-non-smooth pde-inviscid-burgers neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_non_smooth.rkt") + +;; Show the error bound (if applicable) on non-smooth solutions. +(display "Error bound (non-smooth solutions): ") +(display proof-inviscid-burgers-non-smooth) +(display "\n\n\n") + +;; Synthesize the code to validate any first-order surrogate solver for the 1D inviscid Burgers' equation using a shallow neural network. +(define code-inviscid-burgers-validate + (validate-scalar-1d pde-inviscid-burgers neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_validate.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-validate))) + +;; Synthesize the code to validate any first-order surrogate solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-inviscid-burgers-minmod-validate + (validate-scalar-1d-second-order pde-inviscid-burgers limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_minmod_validate.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-minmod-validate))) + +;; Define the 2D inviscid Burgers' equation: du/dt + u du/dx + u du/dy = 0. +(define pde-inviscid-burgers-2d + (hash + 'name "burgers-2d" + 'cons-expr `u ; conserved variable: u + 'flux-expr-x `(* 0.5 u u) ; x-flux function: f(u) = 0.5 * u^2 + 'flux-expr-y `(* 0.5 u u) ; y-flux function: f(u) = 0.5 * u^2 + 'max-speed-expr-x `(abs u) ; local wave-speed: alpha_x = |u| + 'max-speed-expr-y `(abs u) ; local wave-speed: alpha_y = |u| + 'parameters `() + )) + +;; Define 2D simulation parameters. +(define nx-2d 100) +(define ny-2d 100) +(define x0-2d 0.0) +(define x1-2d 2.0) +(define y0-2d 0.0) +(define y1-2d 2.0) +(define t-final-2d 0.5) +(define cfl-2d 0.95) +(define init-func-2d `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 2.0] + [else 0.0])) + +;; Define (shallow) neural network hyperparameters for 2D. +(define neural-net-shallow-2d + (hash + 'max-trains 10000 ; maximum number of training steps: 10000 + 'width 64 ; number of neurons in each layer: 64 + 'depth 6 ; total number of layers: 6 + 'num-threads 12 ; number of threads to use in training: 12 + 'mini-size 100 ; size of training mini-batch: 100 + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D inviscid Burgers' equation using a shallow neural network. +(define code-inviscid-burgers-lax-train-2d + (train-lax-friedrichs-scalar-2d pde-inviscid-burgers-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax_train_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-train-2d))) + +;; Synthesize the code to train a Roe surrogate solver for the 2D inviscid Burgers' equation using a shallow neural network. +(define code-inviscid-burgers-roe-train-2d + (train-roe-scalar-2d pde-inviscid-burgers-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe_train_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-train-2d))) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-inviscid-burgers-lax-minmod-train-2d + (train-lax-friedrichs-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_lax_minmod_train_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-lax-minmod-train-2d))) + +;; Synthesize the code to train a Roe surrogate solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-inviscid-burgers-roe-minmod-train-2d + (train-roe-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_roe_minmod_train_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-roe-minmod-train-2d))) + +(display "2D inviscid Burgers' properties: \n\n") + +;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 2D inviscid Burgers' equation. +(define proof-inviscid-burgers-smooth-2d + (call-with-output-file "proofs/proof_inviscid_burgers_smooth_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-scalar-2d-smooth pde-inviscid-burgers-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_smooth_2d.rkt") + +;; Show the error bound (if applicable) on smooth solutions. +(display "Error bound (smooth solutions): ") +(display proof-inviscid-burgers-smooth-2d) +(display "\n") + +;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 2D inviscid Burgers' equation. +(define proof-inviscid-burgers-non-smooth-2d + (call-with-output-file "proofs/proof_inviscid_burgers_non_smooth_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-scalar-2d-non-smooth pde-inviscid-burgers-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_non_smooth_2d.rkt") + +;; Show the error bound (if applicable) on non-smooth solutions. +(display "Error bound (non-smooth solutions): ") +(display proof-inviscid-burgers-non-smooth-2d) +(display "\n") + +;; Synthesize the code to validate any first-order surrogate solver for the 2D inviscid Burgers' equation using a shallow neural network. +(define code-inviscid-burgers-validate-2d + (validate-scalar-2d pde-inviscid-burgers-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_validate_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-validate-2d))) + +;; Synthesize the code to validate any first-order surrogate solver for the 2D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-inviscid-burgers-minmod-validate-2d + (validate-scalar-2d-second-order pde-inviscid-burgers-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/inviscid_burgers_minmod_validate_2d.c" + #:exists 'replace + (lambda () + (display code-inviscid-burgers-minmod-validate-2d))) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/test_isothermal_euler_shallow.rkt b/provable-algorithms/neural_networks/test_isothermal_euler_shallow.rkt new file mode 100644 index 00000000..69000e2d --- /dev/null +++ b/provable-algorithms/neural_networks/test_isothermal_euler_shallow.rkt @@ -0,0 +1,480 @@ +#lang racket + +(require "code_generator_core_training.rkt") +(require "code_generator_vector_training.rkt") +(require "code_generator_vector_training_2d.rkt") +(require "code_generator_vector_validation.rkt") +(require "prover_vector.rkt") +(provide (all-from-out "code_generator_core_training.rkt")) +(provide (all-from-out "code_generator_vector_training.rkt")) +(provide (all-from-out "code_generator_vector_training_2d.rkt")) +(provide (all-from-out "code_generator_vector_validation.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D isothermal Euler equations (density and x-momentum components). +(define pde-system-isothermal-euler + (hash + 'name "isothermal-euler" + 'cons-exprs (list + `rho + `mom_x) ; conserved variables: density, x-momentum + 'flux-exprs (list + `mom_x + `(+ (/ (* mom_x mom_x) rho) (* rho vt vt))) ; flux vector + 'max-speed-exprs (list + `(abs (- (/ mom_x rho) vt)) + `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds + 'parameters (list + `(define vt 1.0)) ; thermal velocity: vt = 1.0 + )) + +;; Define simulation parameters. +(define nx 400) +(define x0 0.0) +(define x1 1.0) +(define t-final 0.1) +(define cfl 0.95) +(define init-funcs (list + `(cond + [(< x 0.5) 3.0] + [else 1.0]) + `(cond + [(< x 0.5) 1.5] + [else 0.0]))) + +;; Define (shallow) neural network hyperparameters. +(define neural-net-shallow + (hash + 'max-trains 10000 ; maximum number of training steps: 10000 + 'width 64 ; number of neurons in each layer: 64 + 'depth 6 ; total number of layers: 6 + 'num-threads 12 ; number of threads to use in training: 12 + 'mini-size 100 ; size of training mini-batch: 100 + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D isothermal Euler equations using a shallow neural network. +(define code-isothermal-euler-lax-train + (train-lax-friedrichs-vector2-1d pde-system-isothermal-euler neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_lax_train.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-lax-train))) + +;; Synthesize the code to train a Roe surrogate solver for the 1D isothermal Euler equations using a shallow neural network. +(define code-isothermal-euler-roe-train + (train-roe-vector2-1d pde-system-isothermal-euler neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_roe_train.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-roe-train))) + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-isothermal-euler-lax-minmod-train + (train-lax-friedrichs-vector2-1d-second-order pde-system-isothermal-euler limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_lax_minmod_train.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-lax-minmod-train))) + +;; Synthesize the code to train a Roe surrogate solver for the 1D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-isothermal-euler-roe-minmod-train + (train-roe-vector2-1d-second-order pde-system-isothermal-euler limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_roe_minmod_train.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-roe-minmod-train))) + +(display "1D isothermal Euler properties: \n\n") + +;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 1D isothermal Euler equations. +(define proof-isothermal-euler-smooth + (call-with-output-file "proofs/proof_isothermal_euler_smooth.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-vector2-1d-smooth pde-system-isothermal-euler neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_smooth.rkt") + +;; Show the error bounds (if applicable) on smooth solutions. +(display "Error bound on rho (smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-smooth 0) (list-ref proof-isothermal-euler-smooth 1))) +(display "\n") + +(display "Error bound on mom_x (smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-smooth 2) (list-ref proof-isothermal-euler-smooth 3))) +(display "\n") + +;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 1D isothermal Euler equations. +(define proof-isothermal-euler-non-smooth + (call-with-output-file "proofs/proof_isothermal_euler_non_smooth.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-vector2-1d-non-smooth pde-system-isothermal-euler neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_non_smooth.rkt") + +;; Show the error bounds (if applicable) on non-smooth solutions. +(display "Error bound on rho (non-smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-non-smooth 0) (list-ref proof-isothermal-euler-non-smooth 1))) +(display "\n") + +(display "Error bound on mom_x (non-smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-non-smooth 2) (list-ref proof-isothermal-euler-non-smooth 3))) +(display "\n\n\n") + +;; Synthesize the code to validate any first-order surrogate solver for the 1D isothermal Euler equations using a shallow neural network. +(define code-isothermal-euler-validate + (validate-vector2-1d pde-system-isothermal-euler neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_validate.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-validate))) + +;; Synthesize the code to validate any first-order surrogate solver for the 1D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-isothermal-euler-minmod-validate + (validate-vector2-1d-second-order pde-system-isothermal-euler limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-funcs init-funcs)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_minmod_validate.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-minmod-validate))) + +;; Define the 2D isothermal Euler equations (density, x-momentum and y-momentum components). +(define pde-system-isothermal-euler-2d + (hash + 'name "isothermal-euler-2d" + 'cons-exprs (list + `rho + `mom_x + `mom_y) ; conserved variables: density, x-momentum, y-momentum + 'flux-exprs-x (list + `mom_x + `(+ (/ (* mom_x mom_x) rho) (* rho vt vt)) + `(* mom_y (/ mom_x rho))) ; x-flux vector + 'flux-exprs-y (list + `mom_y + `(* mom_x (/ mom_y rho)) + `(+ (/ (* mom_y mom_y) rho) (* rho vt vt))) ; y-flux vector + 'max-speed-exprs-x (list + `(abs (- (/ mom_x rho) vt)) + `(/ mom_x rho) + `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds (x-direction) + 'max-speed-exprs-y (list + `(abs (- (/ mom_y rho) vt)) + `(/ mom_y rho) + `(abs (+ (/ mom_y rho) vt))) ; local wave-speeds (y-direction) + 'parameters (list + `(define vt 1.0)) ; thermal velocity: vt = 1.0 + )) + +;; Define 2D simulation parameters. +(define nx-2d 50) +(define ny-2d 50) +(define x0-2d 0.0) +(define x1-2d 2.0) +(define y0-2d 0.0) +(define y1-2d 2.0) +(define t-final-2d 0.2) +(define cfl-2d 0.9) +(define init-funcs-2d (list + `(cond + [(> y 1.0) + (cond + [(< x 1.0) 0.5323] + [else 1.5])] + [else + (cond + [(< x 1.0) 0.138] + [else 0.5323])]) + `(cond + [(> y 1.0) + (cond + [(< x 1.0) 1.206] + [else 0.0])] + [else + (cond + [(< x 1.0) 1.206] + [else 0.0])]) + `(cond + [(> y 1.0) + (cond + [(< x 1.0) 0.0] + [else 0.0])] + [else + (cond + [(< x 1.0) 1.206] + [else 1.206])]))) + +;; Define (shallow) neural network hyperparameters for 2D. +(define neural-net-shallow-2d + (hash + 'max-trains 10000 ; maximum number of training steps: 10000 + 'width 64 ; number of neurons in each layer: 64 + 'depth 6 ; total number of layers: 6 + 'num-threads 12 ; number of threads to use in training: 12 + 'mini-size 100 ; size of training mini-batch: 100 + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D isothermal Euler equations using a shallow neural network. +(define code-isothermal-euler-lax-train-2d + (train-lax-friedrichs-vector3-2d pde-system-isothermal-euler-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_lax_train_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-lax-train-2d))) + +;; Synthesize the code to train a Roe surrogate solver for the 2D isothermal Euler equations using a shallow neural network. +(define code-isothermal-euler-roe-train-2d + (train-roe-vector3-2d pde-system-isothermal-euler-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_roe_train_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-roe-train-2d))) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-isothermal-euler-lax-minmod-train-2d + (train-lax-friedrichs-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_lax_minmod_train_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-lax-minmod-train-2d))) + +;; Synthesize the code to train a Roe surrogate solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-isothermal-euler-roe-minmod-train-2d + (train-roe-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_roe_minmod_train_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-roe-minmod-train-2d))) + +(display "2D isothermal Euler properties: \n\n") + +;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 2D isothermal Euler equations. +(define proof-isothermal-euler-smooth-2d + (call-with-output-file "proofs/proof_isothermal_euler_smooth_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-vector3-2d-smooth pde-system-isothermal-euler-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_smooth_2d.rkt") + +;; Show the error bounds (if applicable) on smooth solutions. +(display "Error bound on rho (smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-smooth-2d 0) (list-ref proof-isothermal-euler-smooth-2d 1) (list-ref proof-isothermal-euler-smooth-2d 2))) +(display "\n") + +(display "Error bound on mom_x (smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-smooth-2d 3) (list-ref proof-isothermal-euler-smooth-2d 4) (list-ref proof-isothermal-euler-smooth-2d 5))) +(display "\n") + +(display "Error bound on mom_y (smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-smooth-2d 6) (list-ref proof-isothermal-euler-smooth-2d 7) (list-ref proof-isothermal-euler-smooth-2d 8))) +(display "\n") + +;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 2D isothermal Euler equations. +(define proof-isothermal-euler-non-smooth-2d + (call-with-output-file "proofs/proof_isothermal_euler_non_smooth_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-vector3-2d-non-smooth pde-system-isothermal-euler-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_non_smooth_2d.rkt") + +;; Show the error bounds (if applicable) on non-smooth solutions. +(display "Error bound on rho (non-smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-non-smooth-2d 0) (list-ref proof-isothermal-euler-non-smooth-2d 1) (list-ref proof-isothermal-euler-non-smooth-2d 2))) +(display "\n") + +(display "Error bound on mom_x (non-smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-non-smooth-2d 3) (list-ref proof-isothermal-euler-non-smooth-2d 4) (list-ref proof-isothermal-euler-non-smooth-2d 5))) +(display "\n") + +(display "Error bound on mom_y (non-smooth solutions): ") +(display (max (list-ref proof-isothermal-euler-non-smooth-2d 6) (list-ref proof-isothermal-euler-non-smooth-2d 7) (list-ref proof-isothermal-euler-non-smooth-2d 8))) +(display "\n") + +;; Synthesize the code to validate any first-order surrogate solver for the 2D isothermal Euler equations using a shallow neural network. +(define code-isothermal-euler-validate-2d + (validate-vector3-2d pde-system-isothermal-euler-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_validate_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-validate-2d))) + +;; Synthesize the code to validate any first-order surrogate solver for the 2D isothermal Euler equations (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-isothermal-euler-minmod-validate-2d + (validate-vector3-2d-second-order pde-system-isothermal-euler-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-funcs init-funcs-2d)) + +;; Output the code to a file. +(with-output-to-file "code/isothermal_euler_minmod_validate_2d.c" + #:exists 'replace + (lambda () + (display code-isothermal-euler-minmod-validate-2d))) \ No newline at end of file diff --git a/provable-algorithms/neural_networks/test_linear_advection_shallow.rkt b/provable-algorithms/neural_networks/test_linear_advection_shallow.rkt new file mode 100644 index 00000000..c72dc05a --- /dev/null +++ b/provable-algorithms/neural_networks/test_linear_advection_shallow.rkt @@ -0,0 +1,405 @@ +#lang racket + +(require "code_generator_core_training.rkt") +(require "code_generator_core_training_2d.rkt") +(require "code_generator_core_validation.rkt") +(require "prover_core.rkt") +(provide (all-from-out "code_generator_core_training.rkt")) +(provide (all-from-out "code_generator_core_training_2d.rkt")) +(provide (all-from-out "code_generator_core_validation.rkt")) + +;; Construct /code and /proofs output directories if they do not already exist. +(cond + [(not (directory-exists? "code")) (make-directory "code")]) +(cond + [(not (directory-exists? "proofs")) (make-directory "proofs")]) + +;; Define the 1D linear advection equation: du/dt + d(au)/dx = 0. +(define pde-linear-advection + (hash + 'name "linear-advection" + 'cons-expr `u ; conserved variable: u + 'flux-expr `(* a u) ; flux function: f(u) = a * u + 'max-speed-expr `(abs a) ; local wave-speed: alpha = |a| + 'parameters (list + `(define a 1.0)) ; advection speed: a = 1.0 + )) + +;; Define simulation parameters. +(define nx 400) +(define x0 0.0) +(define x1 2.0) +(define t-final 0.5) +(define cfl 0.95) +(define init-func `(cond + [(< x 1.0) 1.0] + [else 0.0])) + +;; Define (shallow) neural network hyperparameters. +(define neural-net-shallow + (hash + 'max-trains 10000 ; maximum number of training steps: 10000 + 'width 64 ; number of neurons in each layer: 64 + 'depth 6 ; total number of layers: 6 + 'num-threads 12 ; number of threads to use in training: 12 + 'mini-size 100 ; size of training mini-batch: 100 + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D linear advection equation using a shallow neural network. +(define code-linear-advection-lax-train + (train-lax-friedrichs-scalar-1d pde-linear-advection neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax_train.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-train))) + +;; Synthesize the code to train a Roe surrogate solver for the 1D linear advection equation using a shallow neural network. +(define code-linear-advection-roe-train + (train-roe-scalar-1d pde-linear-advection neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe_train.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-train))) + +;; Define the minmod flux limiter. +(define limiter-minmod + (hash + 'name "minmod" + 'limiter-expr `(max 0.0 (min 1.0 r)) + 'limiter-ratio `r + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-linear-advection-lax-minmod-train + (train-lax-friedrichs-scalar-1d-second-order pde-linear-advection limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax_minmod_train.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-minmod-train))) + +;; Synthesize the code to train a Roe surrogate solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-linear-advection-roe-minmod-train + (train-roe-scalar-1d-second-order pde-linear-advection limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe_minmod_train.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-minmod-train))) + +(display "1D linear advection properties: \n\n") + +;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 1D linear advection equation. +(define proof-linear-advection-smooth + (call-with-output-file "proofs/proof_linear_advection_smooth.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-scalar-1d-smooth pde-linear-advection neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_smooth.rkt") + +;; Show the error bound (if applicable) on smooth solutions. +(display "Error bound (smooth solutions): ") +(display proof-linear-advection-smooth) +(display "\n") + +;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 1D linear advection equation. +(define proof-linear-advection-non-smooth + (call-with-output-file "proofs/proof_linear_advection_non_smooth.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-scalar-1d-non-smooth pde-linear-advection neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_non_smooth.rkt") + +;; Show the error bound (if applicable) on non-smooth solutions. +(display "Error bound (non-smooth solutions): ") +(display proof-linear-advection-non-smooth) +(display "\n\n\n") + +;; Synthesize the code to validate any first-order surrogate solver for the 1D linear advection equation using a shallow neural network. +(define code-linear-advection-validate + (validate-scalar-1d pde-linear-advection neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_validate.c" + #:exists 'replace + (lambda () + (display code-linear-advection-validate))) + +;; Synthesize the code to validate any first-order surrogate solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-linear-advection-minmod-validate + (validate-scalar-1d-second-order pde-linear-advection limiter-minmod neural-net-shallow + #:nx nx + #:x0 x0 + #:x1 x1 + #:t-final t-final + #:cfl cfl + #:init-func init-func)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_minmod_validate.c" + #:exists 'replace + (lambda () + (display code-linear-advection-minmod-validate))) + +;; Define the 2D linear advection equation: du/dt + d(au)/dx + d(bu)/dy = 0. +(define pde-linear-advection-2d + (hash + 'name "linear-advection-2d" + 'cons-expr `u ; conserved variable: u + 'flux-expr-x `(* a u) ; x-flux function: f(u) = a * u + 'flux-expr-y `(* b u) ; y-flux function: f(u) = b * u + 'max-speed-expr-x `(abs a) ; local x wave-speed: alpha_x = |a| + 'max-speed-expr-y `(abs b) ; local y wave-speed: alpha_y = |b| + 'parameters (list + `(define a 1.0) + `(define b 1.0)) ; advection speesd: a = 1.0, b = 1.0 + )) + +;; Define 2D simulation parameters. +(define nx-2d 100) +(define ny-2d 100) +(define x0-2d 0.0) +(define x1-2d 2.0) +(define y0-2d 0.0) +(define y1-2d 2.0) +(define t-final-2d 0.5) +(define cfl-2d 0.95) +(define init-func-2d `(cond + [(< (+ (* (- x 1.0) (- x 1.0)) (* (- y 1.0) (- y 1.0))) 0.25) 1.0] + [else 0.0])) + +;; Define (shallow) neural network hyperparameters for 2D. +(define neural-net-shallow-2d + (hash + 'max-trains 10000 ; maximum number of training steps: 10000 + 'width 64 ; number of neurons in each layer: 64 + 'depth 6 ; total number of layers: 6 + 'num-threads 12 ; number of threads to use in training: 12 + 'mini-size 100 ; size of training mini-batch: 100 + )) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D linear advection equation using a shallow neural network. +(define code-linear-advection-lax-train-2d + (train-lax-friedrichs-scalar-2d pde-linear-advection-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax_train_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-train-2d))) + +;; Synthesize the code to train a Roe surrogate solver for the 2D linear advection equation using a shallow neural network. +(define code-linear-advection-roe-train-2d + (train-roe-scalar-2d pde-linear-advection-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe_train_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-train-2d))) + +;; Synthesize the code to train a Lax-Friedrichs surrogate solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-linear-advection-lax-minmod-train-2d + (train-lax-friedrichs-scalar-2d-second-order pde-linear-advection-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_lax_minmod_train_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-lax-minmod-train-2d))) + +;; Synthesize the code to train a Roe surrogate solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-linear-advection-roe-minmod-train-2d + (train-roe-scalar-2d-second-order pde-linear-advection-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_roe_minmod_train_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-roe-minmod-train-2d))) + +(display "2D linear advection properties: \n\n") + +;; Attempt to prove error bounds on smooth solutions obtained from surrogate solvers for the 2D linear advection equation. +(define proof-linear-advection-smooth-2d + (call-with-output-file "proofs/proof_linear_advection_smooth_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-scalar-2d-smooth pde-linear-advection-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_smooth_2d.rkt") + +;; Show the error bound (if applicable) on smooth solutions. +(display "Error bound (smooth solutions): ") +(display proof-linear-advection-smooth-2d) +(display "\n") + +;; Attempt to prove error bounds on non-smooth solutions obtained from surrogate solvers for the 2D linear advection equation. +(define proof-linear-advection-non-smooth-2d + (call-with-output-file "proofs/proof_linear_advection_non_smooth_2d.rkt" + (lambda (out) + (parameterize ([current-output-port out] [pretty-print-columns `infinity]) + (display "#lang racket\n\n") + (display "(require \"../prover.rkt\")\n\n") + (prove-scalar-2d-non-smooth pde-linear-advection-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d))) + #:exists `replace)) +(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_non_smooth_2d.rkt") + +;; Show the error bound (if applicable) on non-smooth solutions. +(display "Error bound (non-smooth solutions): ") +(display proof-linear-advection-non-smooth-2d) +(display "\n") + +;; Synthesize the code to validate any first-order surrogate solver for the 2D linear advection equation using a shallow neural network. +(define code-linear-advection-validate-2d + (validate-scalar-2d pde-linear-advection-2d neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_validate_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-validate-2d))) + +;; Synthesize the code to validate any first-order surrogate solver for the 2D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter) +;; using a shallow neural network. +(define code-linear-advection-minmod-validate-2d + (validate-scalar-2d-second-order pde-linear-advection-2d limiter-minmod neural-net-shallow-2d + #:nx nx-2d + #:ny ny-2d + #:x0 x0-2d + #:x1 x1-2d + #:y0 y0-2d + #:y1 y1-2d + #:t-final t-final-2d + #:cfl cfl-2d + #:init-func init-func-2d)) + +;; Output the code to a file. +(with-output-to-file "code/linear_advection_minmod_validate_2d.c" + #:exists 'replace + (lambda () + (display code-linear-advection-minmod-validate-2d))) \ No newline at end of file From 41fb7e15018a9caba005a043027195a10ec4e66b Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 27 Apr 2026 15:19:47 -0400 Subject: [PATCH 59/66] checkout origin/main of some files that got lost --- .../ambi_bolt_potential_funcs.mac | 122 ++++---- .../ms-ambi_bolt_potential-header.mac | 6 +- .../g0/charge_exchange/ms-sigma-cx-calc.mac | 36 +++ maxima/g0/charge_exchange/sigma-cx-calc.mac | 117 ++++++++ .../gkCrossPrimMomsBGKFuncs.mac | 88 ++---- .../ms-gkCrossPrimMomsBGK-header.mac | 67 +++++ .../cross_prim_moms/ms-gkCrossPrimMomsBGK.mac | 56 ++-- .../gk_neut_fluid_prim_vars-flowE.mac | 187 ++++++++++++ .../gk_neut_fluid_prim_vars-pressure.mac | 58 ++++ .../gk_neut_fluid_prim_vars-temp.mac | 211 +++++++++++++ .../gk_neut_fluid_prim_vars-udrift.mac | 187 ++++++++++++ .../gk_neut_fluid_prim_vars-udrift_temp.mac | 279 ++++++++++++++++++ .../ms-gk_neut_fluid_prim_vars-flowE.mac | 61 ++++ .../ms-gk_neut_fluid_prim_vars-header.mac | 70 +++++ .../ms-gk_neut_fluid_prim_vars-pressure.mac | 53 ++++ .../ms-gk_neut_fluid_prim_vars-temp.mac | 61 ++++ .../ms-gk_neut_fluid_prim_vars-udrift.mac | 61 ++++ ...ms-gk_neut_fluid_prim_vars-udrift_temp.mac | 61 ++++ .../g0/gk_pol_den/ms-pol_density-header.mac | 8 +- maxima/g0/gk_pol_den/ms-pol_density.mac | 14 +- maxima/g0/gk_pol_den/pol_density.mac | 6 +- maxima/g0/neutrals/sigma-cx-calc.mac | 139 --------- maxima/g0/prim_moments/CrossPrimMomsLBO.mac | 55 ++-- .../g0/prim_moments/ms-gkCrossPrimMomsLBO.mac | 4 +- .../prim_moments/ms-gkPrimMoments-header.mac | 2 +- .../g0/twist_shift_calc/twistShift-calc.mac | 2 +- 26 files changed, 1696 insertions(+), 315 deletions(-) create mode 100644 maxima/g0/charge_exchange/ms-sigma-cx-calc.mac create mode 100644 maxima/g0/charge_exchange/sigma-cx-calc.mac create mode 100644 maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-flowE.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-header.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-pressure.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-temp.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift.mac create mode 100644 maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift_temp.mac delete mode 100644 maxima/g0/neutrals/sigma-cx-calc.mac diff --git a/maxima/g0/ambi_bolt_potential/ambi_bolt_potential_funcs.mac b/maxima/g0/ambi_bolt_potential/ambi_bolt_potential_funcs.mac index 2b9a5187..5cb2552c 100644 --- a/maxima/g0/ambi_bolt_potential/ambi_bolt_potential_funcs.mac +++ b/maxima/g0/ambi_bolt_potential/ambi_bolt_potential_funcs.mac @@ -8,19 +8,22 @@ load("modal-basis"); load("out-scripts"); load(stringproc)$ load("nodal_operations/quadrature_functions")$ +load("utilities_gyrokinetic")$ fpprec : 24$ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( /* Compute the sheath entrance potential using Gaussian quadrature. */ - [numQuad,vars,basis,numB,sheathDir,sheathVar,sheathSurfVars,varsLowD,basisLowD,numBLowD, - boundaryStr,ghostEvSign,skinEvSign,GammaJacIon_e,GammaJacIonB_c,GammaJacIonB_noZero_c, - GammaJacIonB_e,m0JacIon_e,m0JacIonB_c,m0JacIonB_noZero_c,m0JacIonB_e,phiSlowD_c, - phiSlowD_e,phiS_c,expr,jacInv_e,m0Ion_c,m0Ion_e,m0IonS_c], + [numQuad,vars,basis,numB,bmagBasis,sheathDir,sheathVar,sheathSurfVars,varsLowD,basisLowD,numBLowD, + boundaryStr,ghostEvSign,skinEvSign,GammaJacIon_e,GammaJacIonB_c, + cmag_e,jacobtotInv_e,x3HalfMomJacElc_e,x3HalfMomJacElcB_c,x3HalfMomJacElcB_e,x3HalfMomJacElcB_n, + GammaJacIonB_e,m0JacIon_e,m0JacIonB_c,m0JacIonB_e,phiSlowD_c, + phiSlowD_e,phiS_c,expr,m0Ion_c,m0Ion_e,m0IonS_c], numQuad : polyOrder+1, /* Number of quarature points in 1D. */ [vars, basis] : loadBasis(basisNm, dim, polyOrder), numB : length(basis), + bmagBasis : getAxisymmetricConfBasis(basis), sheathDir : dim, /* Assume the last dimension is the sheath direction. */ sheathVar : vars[sheathDir], @@ -48,57 +51,71 @@ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( ghostEvSign : [1, -1], skinEvSign : [-1, 1], for bS : 1 thru 2 do ( /* One kernel for each of lower and upper boundaries. */ - printf(fh,sconcat("GKYL_CU_DH void ",funcNm,"(double sheathDirDx, double q_e, double m_e, double T_e, const double *jacInv, const double *GammaJac_i, const double *m0JacIon, double *out) ~%{ ~%"), boundaryStr[bS]), + printf(fh,sconcat("GKYL_CU_DH void ",funcNm,"(double sheathDirDx, double q_e, double m_e, double T_e, const double *cmag, const double *jacobtotInv, const double *GammaJac_i, const double *m0Ion, const double *m0JacIon, double *out) ~%{ ~%"), boundaryStr[bS]), printf(fh," // sheathDirDx: cell length in direction of the sheath.~%"), printf(fh," // q_e: electron change.~%"), printf(fh," // m_e: electron mass.~%"), printf(fh," // T_e: electron temperature.~%"), - printf(fh," // jacInv: reciprocal of the geometry Jacobian (1/J).~%"), + printf(fh," // cmag: Clebsch function in definition of magnetic field.~%"), + printf(fh," // jacobtotInv: reciprocal of the phase-space and conf-space Jacobians (1/(J*B)).~%"), printf(fh," // GammaJac_i: ion particle flux (times the Jacobian) through sheath entrance.~%"), + printf(fh," // m0Ion: ion density.~%"), printf(fh," // m0JacIon: ion density (times the geometry Jacobian).~%"), printf(fh," // out: ion density and electrostatic potential at the sheath entrance.~%"), printf(fh,"~%"), + m0Ion_e : doExpand1(m0Ion, basis), + m0JacIon_e : doExpand1(m0JacIon, basis), + + m0IonS_c : calcInnerProdList(vars, 1, basis, subst(sheathVar=skinEvSign[bS],m0Ion_e)), + printf(fh," // Particle number density evaluate at the sheath entrance~%"), + expr : float(m0IonS_c), + for i : 1 thru length(expr) do ( + if expr[i] # 0.0 then printf(fh, " ~a = ~a; ~%", out[i-1], gcfac(expr[i])) + ), + printf(fh,"~%"), + /* Particle flux expanded in basis. Need to multiply by an extra dx/2 because of the way the boundary fluxes are computed. */ GammaJacIon_e : (sheathDirDx/2)*doExpand1(GammaJac_i, basis), /* Evaluate the (ghost cell) flux at the boundary surface. */ GammaJacIonB_c : calcInnerProdList(varsLowD,1,basisLowD,subst(sheathVar=ghostEvSign[bS], GammaJacIon_e)), - GammaJacIonB_noZero_c : makelistNoZeros1(GammaJacIonB_c, GammaJacIonB), - GammaJacIonB_e : doExpand(GammaJacIonB_noZero_c,basisLowD), printf(fh," double GammaJacIonB[~a];~%", numBLowD), writeCExprs1(GammaJacIonB, GammaJacIonB_c), printf(fh,"~%"), + GammaJacIonB_c : makelistNoZeros1(GammaJacIonB_c, GammaJacIonB), + GammaJacIonB_e : doExpand(GammaJacIonB_c,basisLowD), + + /* + Evaluate the x^3 half moment (over positive or negative vpar) of the electrons, + where x^3=C*vpar/(J*B), and assume quasineutrality so n_i appears instead of n_e. + */ + cmag_e : doExpand1(cmag, bmagBasis), + jacobtotInv_e : doExpand1(jacobtotInv, bmagBasis), + x3HalfMomJacElc_e : (1/sqrt(2*%pi))*cmag_e*jacobtotInv_e*m0JacIon_e*sqrt(T_e/m_e), + x3HalfMomJacElcB_c : calcInnerProdList(varsLowD,1,basisLowD,subst(sheathVar=skinEvSign[bS], x3HalfMomJacElc_e)), + printf(fh," double x3HalfMomJacElcB[~a];~%", numBLowD), + writeCExprs1(x3HalfMomJacElcB, x3HalfMomJacElcB_c), + printf(fh,"~%"), + x3HalfMomJacElcB_c : makelistNoZeros1(x3HalfMomJacElcB_c, x3HalfMomJacElcB), + x3HalfMomJacElcB_e : doExpand(x3HalfMomJacElcB_c,basisLowD), - m0JacIon_e : doExpand1(m0JacIon, basis), /* Evaluate the (skin cell) ion density at the boundary surface. */ m0JacIonB_c : calcInnerProdList(varsLowD,1,basisLowD,subst(sheathVar=skinEvSign[bS], m0JacIon_e)), - m0JacIonB_noZero_c : makelistNoZeros1(m0JacIonB_c, m0JacIonB), - m0JacIonB_e : doExpand(m0JacIonB_noZero_c,basisLowD), printf(fh," double m0JacIonB[~a];~%", numBLowD), writeCExprs1(m0JacIonB, m0JacIonB_c), printf(fh,"~%"), - - /* Density at the sheath entrance. */ - jacInv_e : doExpand1(jacInv,basis), - m0Ion_c : calcInnerProdList(vars, jacInv_e, basis, m0JacIon_e), - m0Ion_e : doExpand(m0Ion_c,basis), - - m0IonS_c : calcInnerProdList(vars, 1, basis, subst(sheathVar=skinEvSign[bS],m0Ion_e)), - printf(fh," // Particle number density evaluate at the sheath entrance~%"), - expr : float(m0IonS_c), - for i : 1 thru length(expr) do ( - if expr[i] # 0.0 then printf(fh, " ~a = ~a; ~%", out[i-1], gcfac(expr[i])) - ), - printf(fh,"~%"), + m0JacIonB_c : makelistNoZeros1(m0JacIonB_c, m0JacIonB), + m0JacIonB_e : doExpand(m0JacIonB_c,basisLowD), /* Compute the sheath potential - phiS = (T_e/q_e)*log( sqrt(2*pi)*GammaJac_i/(n_i*sqrt(T_e/m_e)) ) + phiS = (T_e/q_e)*log( GammaJac_i/((1/sqrt(2*pi))*(c/(J*B))*n_i*sqrt(T_e/m_e)) ) using quadrature. If dim=1 no quadrature is needed. */ phiSlowD_c : makelist(0,i,1,numBLowD), if dim=1 then ( + printf(fh," double phiS_qp[1];~%"), - phiSlowD_c : [(T_e/q_e)*log(sqrt(2*%pi)*GammaJacIonB_e/(m0JacIonB_e*sqrt(T_e/m_e)))], + phiSlowD_c : [(T_e/q_e)*log(GammaJacIonB_e/x3HalfMomJacElcB_e)], printf(fh," if ((isfinite(~a)) && (~a>0.) && (~a>0.)) {~%",GammaJacIonB_e,GammaJacIonB_e,m0JacIonB_e), printf(fh," phiS_qp[0] = ~a;~%",float(expand(phiSlowD_c[1]))), printf(fh," } else {~%"), @@ -106,21 +123,25 @@ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( printf(fh," }~%"), printf(fh,"~%"), phiSlowD_e : phiS_qp[0] + ) else ( - m0JacIonB_n : makelist(0,i,1,ordNum), + + m0JacIonB_n : makelist(0,i,1,ordNum), GammaJacIonB_n : makelist(0,i,1,ordNum), + x3HalfMomJacElcB_n : makelist(0,i,1,ordNum), for i : 1 thru ordNum do ( nOrd : normOrds[i], cSub : makelist(varsLowD[d]=normOrds[i][d],d,1,dim-1), - m0JacIonB_n[i] : subst(cSub, m0JacIonB_e), - GammaJacIonB_n[i] : subst(cSub, GammaJacIonB_e) + m0JacIonB_n[i] : subst(cSub, m0JacIonB_e), + GammaJacIonB_n[i] : subst(cSub, GammaJacIonB_e), + x3HalfMomJacElcB_n[i] : subst(cSub, x3HalfMomJacElcB_e) ), printf(fh," double phiS_qp[~a];~%", ordNum), phiS_n : makelist(0,i,1,ordNum), for i : 1 thru ordNum do ( - phiS_n[i] : (T_e/q_e)*log(sqrt(2*%pi)*GammaJacIonB_n[i]/(m0JacIonB_n[i]*sqrt(T_e/m_e))), + phiS_n[i] : (T_e/q_e)*log(GammaJacIonB_n[i]/x3HalfMomJacElcB_n[i]), printf(fh," if ((isfinite(~a)) && (~a>0.) && (~a>0.)) {~%",float(GammaJacIonB_n[i]),float(GammaJacIonB_n[i]),float(m0JacIonB_n[i])), printf(fh," phiS_qp[~a] = ~a;~%",i-1,float(expand(phiS_n[i]))), printf(fh," } else {~%"), @@ -138,6 +159,7 @@ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( ) ), phiSlowD_e : doExpand(phiSlowD_c, basisLowD) + ), phiS_c : calcInnerProdList(vars, 1, basis, phiSlowD_e), @@ -155,8 +177,8 @@ genSheathCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( genPhiCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( /* Compute the potential in the domain volume using Gaussian quadrature. */ - [numQuad,vars,basis,numB,normOrds,weights,ordNum,m0JacIon_e, - jacInv_e,m0Ion_c,m0Ion_e,m0Ion_noZero_c,m0IonS_e,phiS_e,m0Ion_n,m0IonS_n, + [numQuad,vars,basis,numB,normOrds,weights,ordNum, + m0Ion_e,m0IonS_e,phiS_e,m0Ion_n,m0IonS_n, phiS_n,nOrd,cSub,phi_n,phi_c], numQuad : polyOrder+1, /* Number of quarature points in 1D. */ @@ -168,25 +190,15 @@ genPhiCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( [normOrds, weights] : gaussOrdWeight(numQuad,dim), ordNum : length(normOrds), - printf(fh,sconcat("GKYL_CU_DH void ",funcNm,"(double q_e, double T_e, const double *jacInv, const double *m0JacIon, const double *sheathvals, double *phi) ~%{ ~%")), - printf(fh," // q_e: electron change.~%"), - printf(fh," // T_e: electron temperature.~%"), - printf(fh," // jacInv: reciprocal of the geometry Jacobian (1/J).~%"), - printf(fh," // m0JacIon: ion density.~%"), + printf(fh,sconcat("GKYL_CU_DH void ",funcNm,"(double q_e, double T_e, const double *m0Ion, const double *sheathvals, double *phi) ~%{ ~%")), + printf(fh," // q_e: electron change.~%"), + printf(fh," // T_e: electron temperature.~%"), + printf(fh," // m0Ion: ion density.~%"), printf(fh," // sheathvals: ion density and electrostatic potential at the sheath entrance.~%"), - printf(fh," // phi: electrostatic potential in domain volume.~%"), + printf(fh," // phi: electrostatic potential in domain volume.~%"), printf(fh,"~%"), - m0JacIon_e : doExpand1(m0JacIon, basis), - - jacInv_e : doExpand1(jacInv,basis), - m0Ion_c : calcInnerProdList(vars, jacInv_e, basis, m0JacIon_e), - m0Ion_e : doExpand(m0Ion_c,basis), - m0Ion_noZero_c : makelistNoZeros1(m0Ion_c, m0Ion), - m0Ion_e : doExpand(m0Ion_noZero_c,basis), - printf(fh," double m0Ion[~a];~%", numB), - writeCExprs1(m0Ion, m0Ion_c), - printf(fh,"~%"), + m0Ion_e : doExpand1(m0Ion, basis), m0IonS_e : doExpand(makelist(sheathvals[i-1],i,1,numB), basis), phiS_e : doExpand(makelist(sheathvals[numB+i-1],i,1,numB), basis), @@ -206,12 +218,20 @@ genPhiCalcKernel(fh, funcNm, dim, basisNm, polyOrder) := block( phiS_n[i] : subst(cSub, phiS_e) ), + printf(fh," double phi_qp[~a];~%", ordNum), + printf(fh," double m0IonS_curr;~%"), phi_n : makelist(0,i,1,ordNum), for i : 1 thru ordNum do ( - phi_n[i] : phiS_n[i] - (T_e/q_e)*log(m0Ion_n[i]/m0IonS_n[i]) + printf(fh," m0IonS_curr = ~a;~%",float(expand(m0IonS_n[i]))), + + phi_n[i] : phiS_n[i] - (T_e/q_e)*log(fmax(m0Ion_n[i],m0IonS_curr)/m0IonS_curr), + + printf(fh," if ((isfinite(~a)) && (~a>0.)) {~%",m0IonS_curr,m0IonS_curr), + printf(fh," phi_qp[~a] = ~a;~%",i-1,float(expand(phi_n[i]))), + printf(fh," } else {~%"), + printf(fh," phi_qp[~a] = 0.0;~%",i-1), + printf(fh," }~%") ), - printf(fh," double phi_qp[~a];~%", ordNum), - writeCExprs1(phi_qp, phi_n), printf(fh,"~%"), phi_c : makelist(0,i,1,numB), diff --git a/maxima/g0/ambi_bolt_potential/ms-ambi_bolt_potential-header.mac b/maxima/g0/ambi_bolt_potential/ms-ambi_bolt_potential-header.mac index 09618c60..4c1eb4f0 100644 --- a/maxima/g0/ambi_bolt_potential/ms-ambi_bolt_potential-header.mac +++ b/maxima/g0/ambi_bolt_potential/ms-ambi_bolt_potential-header.mac @@ -18,7 +18,7 @@ printf(fh, "//------------------------------------------------------------------ printf(fh, "#pragma once~%")$ printf(fh, "~%")$ printf(fh, "#include ~%")$ -printf(fh, "#include ~%~%")$ +printf(fh, "#include ~%~%")$ printf(fh, "~%")$ printf(fh, "EXTERN_C_BEG~%")$ @@ -30,9 +30,9 @@ for bInd : 1 thru length(bName) do ( for ci : 1 thru 3 do ( for bS : 1 thru 2 do ( /* One kernel for each of lower and upper boundaries. */ - printf(fh, " GKYL_CU_DH void ambi_bolt_potential_sheath_calc_~a_~ax_~a_p~a(double sheathDirDx, double q_e, double m_e, double T_e, const double *jacInv, const double *GammaJac_i, const double *m0JacIon, double *out); ~%", boundaryStr[bS], ci, bName[bInd], pi) + printf(fh, " GKYL_CU_DH void ambi_bolt_potential_sheath_calc_~a_~ax_~a_p~a(double sheathDirDx, double q_e, double m_e, double T_e, const double *cmag, const double *jacobtotInv, const double *GammaJac_i, const double *m0Ion, const double *m0JacIon, double *out); ~%", boundaryStr[bS], ci, bName[bInd], pi) ), - printf(fh, " GKYL_CU_DH void ambi_bolt_potential_phi_calc_~ax_~a_p~a(double q_e, double T_e, const double *jacInv, const double *m0JacIon, const double *sheathvals, double *phi); ~%", ci, bName[bInd], pi), + printf(fh, " GKYL_CU_DH void ambi_bolt_potential_phi_calc_~ax_~a_p~a(double q_e, double T_e, const double *m0Ion, const double *sheathvals, double *phi); ~%", ci, bName[bInd], pi), printf(fh, "~%") ), diff --git a/maxima/g0/charge_exchange/ms-sigma-cx-calc.mac b/maxima/g0/charge_exchange/ms-sigma-cx-calc.mac new file mode 100644 index 00000000..7b521f2d --- /dev/null +++ b/maxima/g0/charge_exchange/ms-sigma-cx-calc.mac @@ -0,0 +1,36 @@ +/* Generate CX cross section (vSigmaCX) kernels for charge + exchange operator */ + +load("charge_exchange/sigma-cx-calc.mac"); +load(stringproc)$ +fpprec : 24$ + +/* Serendipity basis. */ +maxPolyOrder_Ser : 2$ + +bName : ["ser"]$ +maxPolyOrder : [maxPolyOrder_Ser]$ + +fh : openw("~/max-out/gkyl_dg_cx_kernels.h")$ +printf(fh, "#pragma once ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ + +for bInd : 1 thru length(bName) do ( + for c : 1 thru 3 do ( + + max_p : maxPolyOrder[bInd], + if c = 3 then (max_p : 1), + + for p : 1 thru max_p do ( + disp(printf(false,sconcat("Creating v_sigma_cx ", bName[bInd]," ~ax"),c)), + + print("attempting to print",c,"x",p,"p functions..."), + /*. Calculate CX cross section. */ + funcNm : sconcat("sigma_cx_", c, "x_", bName[bInd]), + + calcSigmaCXcellAv(fh, funcNm, c, bName[bInd], p) + ) + ) +); +close(fh)$ diff --git a/maxima/g0/charge_exchange/sigma-cx-calc.mac b/maxima/g0/charge_exchange/sigma-cx-calc.mac new file mode 100644 index 00000000..24e71300 --- /dev/null +++ b/maxima/g0/charge_exchange/sigma-cx-calc.mac @@ -0,0 +1,117 @@ +/* Generate CX cross section (vSigmaCX) kernels for charge + exchange operator */ + +load("modal-basis"); +load("out-scripts"); +load(stringproc)$ +fpprec : 24$ + +declareWriteCExprsC(lhs, rhs) := block([expr], + expr : float(expand(rhs)), + if expr # 0.0 then ( + ep : string(expr), + for i : 0 thru 60 do ( + ep : ssubst(string(pow(u_ion[i],2.)),string(u_ion[i]^2),ep), + ep : ssubst(string(pow(u_neut[i],2.)),string(u_neut[i]^2),ep) + ), + printf(fh, " double ~a = ~a; ~%", lhs, ep) + ) +)$ + +writeCExprsCs(lhs, rhs) := block([expr], + expr : float(expand(rhs)), + for i : 1 thru length(expr) do ( + if expr[i] # 0.0 then ( + ep : string(expr[i]), + ep : ssubst("log(","ln(",ep), + printf(fh, " ~a = ~a; ~%", lhs[i-1], ep) + ) + ) +)$ + +writeCExprsC(lhs, rhs) := block([expr], + expr : float(expand(rhs)), + if expr # 0.0 then ( + ep : string(expr), + printf(fh, " ~a = ~a; ~%", lhs, ep) + ) +)$ + +/* vSigmaCX for charge exchange cross section */ +calcSigmaCXcellAv(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC,bC,NC,m0_e,m0_av,u_ion_av_c,u_neut_av_c,u_ion_av,u_neut_av,vi,vt_sq_ion_av_c, + vt_sq_neut_av_c,v_in_sq_c,v_sigma_cx_c,v_sigma_cx_e,v_sigma_cx_av], + + vdim : 3, /* Assume neutrals are always 3v. */ + + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + NC : length(bC), + + printf(fh, " ~%"), + printf(fh, "GKYL_CU_DH static inline ~%"), + printf(fh, "double ~a_p~a(const double a, const double b, double vt_sq_ion_min, double vt_sq_neut_min, const double *maxwellian_moms_ion, const double *maxwellian_moms_neut, const double *u_ion, double* GKYL_RESTRICT v_sigma_cx) ~%{ ~%", funcNm, p), + printf(fh, " // a: constant in fitting function.~%"), + printf(fh, " // b: constant in fitting function.~%"), + printf(fh, " // maxwellian_moms_ion[~a]: ion prim vars.~%", NC*(1+2)), + printf(fh, " // maxwellian_moms_neut[~a]: neut prim vars.~%", NC*(3+2)), + printf(fh, " // u_ion[~a]: ion drift velocity vector (upar_i b_1, upar_i b_2, upar_i b_3).~%",NC*3), + printf(fh, " // v_sigma_cx: cell ave cross section fitting eqn.~%"), + printf(fh, "~%"), + + m0_neut_e : doExpand1(maxwellian_moms_neut,bC), + m0_neut_av_e : innerProd(varsC,1.0,1.0,m0_neut_e)/innerProd(varsC,1.0,1.0,1.0), + declareWriteCExprsC(m0_neut_av, m0_neut_av_e), + printf(fh, " ~%"), + + printf(fh, " const double *vt_sq_ion = &maxwellian_moms_ion[~a]; ~%", NC*(1+1)), + printf(fh, " const double *u_neut = &maxwellian_moms_neut[~a]; ~%", NC), + printf(fh, " const double *vt_sq_neut = &maxwellian_moms_neut[~a]; ~%", NC*(3+1)), + printf(fh, " ~%"), + + u_ion_e : subst(makelist( u_ion[i]=u_ion[i+a0] ,i,0,NC-1), doExpand1(u_ion,bC)), + u_neut_e : subst(makelist(u_neut[i]=u_neut[i+a0],i,0,NC-1), doExpand1(u_neut,bC)), + + u_ion_av : makelist(0,i,1,vdim), + u_neut_av : makelist(0,i,1,vdim), + for vi : 1 thru vdim do ( + u_ion_av[vi] : innerProd(varsC,1.0,1.0,u_ion_e)/innerProd(varsC,1.0,1.0,1.0), + u_ion_av[vi] : fullratsimp(subst(a0=(vi-1)*NC,u_ion_av[vi])), + + u_neut_av[vi] : innerProd(varsC,1.0,1.0,u_neut_e)/innerProd(varsC,1.0,1.0,1.0), + u_neut_av[vi] : fullratsimp(subst(a0=(vi-1)*NC,u_neut_av[vi])) + ), + + vt_sq_ion_av_c : innerProd(varsC,1.0,1.0, doExpand1(vt_sq_ion,bC))/innerProd(varsC,1.0,1.0,1.0), + vt_sq_neut_av_c : innerProd(varsC,1.0,1.0, doExpand1(vt_sq_neut,bC))/innerProd(varsC,1.0,1.0,1.0), + + declareWriteCExprsC(vt_sq_ion_av, vt_sq_ion_av_c), + declareWriteCExprsC(vt_sq_neut_av, vt_sq_neut_av_c), + + /* Limit how low the temperature can get (set by the velocity grid). */ + printf(fh, " if ((vt_sq_ion_av > 0.) && (vt_sq_ion_av < vt_sq_ion_min)) vt_sq_ion_av = vt_sq_ion_min;~%"), + printf(fh, " if ((vt_sq_neut_av > 0.) && (vt_sq_neut_av < vt_sq_neut_min)) vt_sq_neut_av = vt_sq_neut_min;~%"), + printf(fh, " ~%"), + + /* Define and write v_sigma_cx */ + printf(fh, " if (m0_neut_av <= 0 || vt_sq_neut_av <= 0 || vt_sq_ion_av <= 0) { ~%"), + printf(fh, " v_sigma_cx[0] = 0.0;~%"), + printf(fh, " return 0.0; ~%"), + printf(fh, " } else {~%"), + + /* Define v_in variable: v_in_sq = |u_ion - u_neut|^2 */ + v_in_sq_c : innerProd(varsC,1.0,1.0,sum((u_ion_av[d] - u_neut_av[d])^2,d,1,vdim))/innerProd(varsC,1.0,1.0,1.0), + declareWriteCExprsC(v_in_sq_av, v_in_sq_c), + printf(fh, " ~%"), + + printf(fh, " double v_cx = ~a;~%",float(sqrt(4/%pi*vt_sq_ion_av + 4/%pi*vt_sq_neut_av + v_in_sq_av))), + v_sigma_cx_c : calcInnerProdList(varsC,1.0,bC,v_cx*(a - b*ln(v_cx))), + writeCExprsCs(v_sigma_cx, v_sigma_cx_c), + printf(fh, " ~%"), + + v_sigma_cx_e : doExpand1(v_sigma_cx,bC), + v_sigma_cx_av : innerProd(varsC,1.0,1.0,v_sigma_cx_e)/innerProd(varsC,1.0,1.0,1.0), + cflRate : float(expand(fullratsimp(m0_neut_av*v_sigma_cx_av/(2*p+1)))), + printf(fh, " return ~a; ~%",cflRate), + printf(fh, " }~%"), + printf(fh, "} ~%") +)$ diff --git a/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac b/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac index 63575363..318dbbf9 100644 --- a/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac +++ b/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac @@ -9,18 +9,16 @@ load("nodal_operations/nodal_functions"); load(stringproc)$ fpprec : 24$ -calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vgk, basisFun, polyOrder) := block( +calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( [varsC, bC, NC], - kill(varsC, bC), - /* Load basis of dimensionality requested. */ [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), /* Number of basis monomials. */ - NC : length(bC), + NC : length(bC), - print("gk ", cdim,"x", vgk, "v", polyOrder, "p"), + print("gk ", cdim,"x", vdim, "v", polyOrder, "p"), /* Include the header files. */ printf(fh, "#include ~%"), @@ -29,9 +27,13 @@ calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vgk, basisFun, polyOrder) := block( printf(fh, " ~%"), /* Function declaration with input/output variables. */ - printf(fh, "GKYL_CU_DH void ~a(const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, const double *nu_sr, const double *nu_rs, double *prim_moms_cross) ~%{ ~%", funcNm), - printf(fh, " // m_: mass. ~%"), - printf(fh, " // prim_moms_: primitive moments of the distribution function. ~%"), + printf(fh, "GKYL_CU_DH void ~a(const double delta_sr, const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, double *prim_moms_cross) ~%{ ~%", funcNm), + printf(fh, " // delta_sr: Free parameter in relation between nu_sr and alpha_E. ~%"), + printf(fh, " // betaGreenep1: Greene's beta + 1. ~%"), + printf(fh, " // m_self: mass of this species. ~%"), + printf(fh, " // prim_moms_self: primitive moments of this species. ~%"), + printf(fh, " // m_other: mass of other species. ~%"), + printf(fh, " // prim_moms_other: primitive moments of other species. ~%"), printf(fh, " // prim_moms_cross: cross primitive moments. ~%"), printf(fh, " ~%"), @@ -49,41 +51,6 @@ calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vgk, basisFun, polyOrder) := block( printf(fh, " double *n_sr = &prim_moms_cross[~a]; ~%", 0), printf(fh, " double *upar_sr = &prim_moms_cross[~a]; ~%", NC*1), printf(fh, " double *vtsq_sr = &prim_moms_cross[~a]; ~%", NC*2), - printf(fh, " ~%"), - /* Create the arrays of the temps. */ - printf(fh, " double msNsNusr[~a] = {0.0}; ~%", NC), - printf(fh, " double mrNrNurs[~a] = {0.0}; ~%", NC), - printf(fh, " double m_n_nu[~a] = {0.0}; ~%", NC), - printf(fh, " double m_n_nu_inv[~a] = {0.0}; ~%", NC), - printf(fh, " double alphaE[~a] = {0.0}; ~%", NC), - printf(fh, "~%"), - printf(fh, " double msNsNusr_inv[~a] = {0.0}; ~%", NC), - printf(fh, " double coeff[~a] = {0.0}; ~%", NC), - printf(fh, " double dUpar[~a] = {0.0}; ~%", NC), - printf(fh, " double cUpar[~a] = {0.0}; ~%", NC), - printf(fh, "~%"), - printf(fh, " double dv; ~%"), - printf(fh, " double T1[~a] = {0.0}; ~%", NC), - printf(fh, " double T2[~a] = {0.0}; ~%", NC), - printf(fh, " double T3[~a] = {0.0}; ~%", NC), - printf(fh, " double cVtsq[~a] = {0.0}; ~%", NC), - printf(fh, " bool negative_cross_temp = false; ~%"), - printf(fh, "~%"), - - /* Caculate alphaE. */ - printf(fh, " binop_mul_~ad_~a_p~a(n_s, nu_sr, msNsNusr); ~%", cdim, basisFun, polyOrder), - printf(fh, " binop_mul_~ad_~a_p~a(n_r, nu_rs, mrNrNurs); ~%", cdim, basisFun, polyOrder), - for i : 1 thru NC do ( - printf(fh, " msNsNusr[~a] = m_s * msNsNusr[~a]; ~%", i-1, i-1), - printf(fh, " mrNrNurs[~a] = m_r * mrNrNurs[~a]; ~%", i-1, i-1), - printf(fh, " m_n_nu[~a] = msNsNusr[~a] + mrNrNurs[~a]; ~%", i-1, i-1, i-1) - ), - printf(fh, " ~a_~ax_p~a_inv(m_n_nu, m_n_nu_inv); ~%", basisFun, cdim, polyOrder), - printf(fh, " binop_mul_~ad_~a_p~a(msNsNusr, mrNrNurs, alphaE); ~%", cdim, basisFun, polyOrder), - printf(fh, " binop_mul_~ad_~a_p~a(alphaE, m_n_nu_inv, alphaE); ~%", cdim, basisFun, polyOrder), - for i : 1 thru NC do ( - printf(fh, " alphaE[~a] = alphaE[~a] * 2.0 * betaGreenep1 / (m_s+m_r); ~%", i-1, i-1) - ), printf(fh, "~%"), /* Calculate cross density n_sr. */ @@ -93,39 +60,40 @@ calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vgk, basisFun, polyOrder) := block( printf(fh, " ~%"), /* Calculate cross parallel velocity upar_sr. */ - printf(fh, " ~a_~ax_p~a_inv(msNsNusr, msNsNusr_inv); ~%", basisFun, cdim, polyOrder), - printf(fh, " binop_mul_~ad_~a_p~a(alphaE, msNsNusr_inv, coeff); ~%", cdim, basisFun, polyOrder), + printf(fh, " const double deltaTbetap1 = delta_sr*betaGreenep1;~%"), + printf(fh, " ~%"), + + printf(fh, " double dUpar[~a]; ~%", NC), for i : 1 thru NC do ( printf(fh, " dUpar[~a] = upar_r[~a] - upar_s[~a]; ~%", i-1, i-1, i-1) ), - printf(fh, " binop_mul_~ad_~a_p~a(coeff, dUpar, cUpar); ~%", cdim, basisFun, polyOrder), for i : 1 thru NC do ( - printf(fh, " upar_sr[~a] = upar_s[~a] + cUpar[~a]*(m_s+m_r)/2.0; ~%", i-1, i-1, i-1) + printf(fh, " upar_sr[~a] = upar_s[~a] + 0.5*deltaTbetap1*dUpar[~a]; ~%", i-1, i-1, i-1) ), printf(fh, " ~%"), /* Calculate cross thermal velocity square vtsq_sr. */ - if vgk=1 then ( - printf(fh, " dv = 1.0; ~%") - ) else ( - printf(fh, " dv = 3.0; ~%") - ), - for i : 1 thru NC do ( - printf(fh, " T1[~a] = dv * (m_r*vtsq_r[~a]-m_s*vtsq_s[~a]); ~%", i-1, i-1, i-1) - ), - printf(fh, " binop_mul_~ad_~a_p~a(dUpar, dUpar, T2); ~%", cdim, basisFun, polyOrder), - printf(fh, " binop_mul_~ad_~a_p~a(coeff, T2, T3); ~%", cdim, basisFun, polyOrder), + printf(fh, " const double vdimPhys = ~a; ~%", (vdim-1)*2+1), + printf(fh, " const double mSum = m_self + m_other;~%"), + printf(fh, " ~%"), + + printf(fh, " double dTemp[~a] = {0.0}; ~%", NC), for i : 1 thru NC do ( - printf(fh, " cVtsq[~a] = T1[~a] + m_r*T2[~a] - (m_s+m_r)*(m_s+m_r)/4.0*T3[~a] ; ~%", i-1, i-1, i-1, i-1) + printf(fh, " dTemp[~a] = vdimPhys * (m_r*vtsq_r[~a]-m_s*vtsq_s[~a]); ~%", i-1, i-1, i-1) ), - printf(fh, " binop_mul_~ad_~a_p~a(coeff, cVtsq, cVtsq); ~%", cdim, basisFun, polyOrder), + + printf(fh, " double dUparSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(dUpar, dUpar, dUparSq); ~%", cdim, basisFun, polyOrder), + + printf(fh, " const double dUparSq_fac = (m_r-0.25*deltaTbetap1*mSum/vdimPhys);~%"), for i : 1 thru NC do ( - printf(fh, " vtsq_sr[~a] = vtsq_s[~a] + cVtsq[~a]/dv; ~%", i-1, i-1, i-1) + printf(fh, " vtsq_sr[~a] = vtsq_s[~a] + deltaTbetap1/(vdimPhys*mSum)*(dTemp[~a]+dUparSq_fac*dUparSq[~a]); ~%", i-1, i-1, i-1, i-1) ), printf(fh, " ~%"), /* Turn collisions off when vtsq_sr is not positive-definite. */ printf(fh, " // If vtsq_sr is negative at a corner, turn off collisions.~%"), + printf(fh, " bool negative_cross_temp = false; ~%"), nodes : getNodes(basisFun, cdim, 1), vtsq_sr_e : doExpand1(vtsq_sr,bC), vtsq_sr_corners : gcfac(float(fullratsimp( evAtNodes(vtsq_sr_e,nodes,varsC) ))), diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac new file mode 100644 index 00000000..752a42c8 --- /dev/null +++ b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac @@ -0,0 +1,67 @@ +load("cross_prim_moms/gkCrossPrimMomsBGKFuncs")$ +load(stringproc)$ + +/* Generate a header file for cross primitive moments kernels in the GkBGK. */ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 1$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor order basis. No need to generate p=1. */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 1$ +maxCdim_Tensor : 0$ + +/* Vdim possibilities for each of Cdim=[1,2,3]. */ +gkVdims : [[1,2], [2], [2]]$ + +/* ...... END OF USER INPUTS........ */ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +printPrototypeGK(deco, ci, vi, bStr, pi) := block([si], + printf(fh, "~avoid gyrokinetic_cross_prim_moms_bgk_~ax~av_~a_p~a(const double delta_sr, const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, double *prim_moms_cross); ~%", deco, ci, vi, bStr, pi), + printf(fh, "~%") +)$ + +fh : openw("~/max-out/gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h")$ +printf(fh, "#pragma once ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, " ~%")$ +printf(fh, "EXTERN_C_BEG ~%")$ +printf(fh, "~%")$ + +decorator : "GKYL_CU_DH "$ + +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ + for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + + printPrototypeGK(decorator, c, v, bName[bInd], polyOrder) + + ) + ) + ) +); + +printf(fh, "EXTERN_C_END ~%")$ +close(fh)$ + +/* gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h */ diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac index 958e86f5..834a14f2 100644 --- a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac +++ b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac @@ -5,47 +5,41 @@ load(stringproc)$ /* Serendipity basis. */ minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 2$ +maxPolyOrder_Ser : 1$ minCdim_Ser : 1$ maxCdim_Ser : 3$ -minVdim_Ser : 1$ -maxVdim_Ser : 3$ -minGkVdim_Ser : 1$ -maxGkVdim_Ser : 2$ +/* Tensor order basis. No need to generate p=1. */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 1$ +maxCdim_Tensor : 0$ -/* ...... END OF USER INPUTS........ */ +/* Vdim possibilities for each of Cdim=[1,2,3]. */ +gkVdims : [[1,2], [2], [2]]$ -bName : ["ser"]$ -minPolyOrder : [minPolyOrder_Ser]$ -maxPolyOrder : [maxPolyOrder_Ser]$ -minCdim : [minCdim_Ser]$ -maxCdim : [maxCdim_Ser]$ -minVdim : [minVdim_Ser]$ -maxVdim : [maxVdim_Ser]$ -minGkVdim : [minGkVdim_Ser]$ -maxGkVdim : [maxGkVdim_Ser]$ +/* ...... END OF USER INPUTS........ */ +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ -polyOrder : 1$ for bInd : 1 thru length(bName) do ( for c : minCdim[bInd] thru maxCdim[bInd] do ( - minPolyOrderB : minPolyOrder[bInd], - maxPolyOrderB : maxPolyOrder[bInd], - for polyOrder : minPolyOrderB thru maxPolyOrderB do ( - if (c=1) then ( - for vgk : minGkVdim[bInd] thru maxGkVdim[bInd] do ( - fname : sconcat("~/max-out/cross_prim_moms/gyrokinetic_cross_prim_moms_bgk_", c, "x", vgk, "v_", bName[bInd], "_p", polyOrder, ".c"), - fh : openw(fname), - funcName : sconcat("gyrokinetic_cross_prim_moms_bgk_", c, "x", vgk, "v_", bName[bInd], "_p", polyOrder), - calcGKCrossPrimMomsBGK(fh, funcName, c, vgk, bName[bInd], polyOrder), - close(fh) - ) - ) else ( - fname : sconcat("~/max-out/cross_prim_moms/gyrokinetic_cross_prim_moms_bgk_", c, "x", 2, "v_", bName[bInd], "_p", polyOrder, ".c"), + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ + for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + + fname : sconcat("~/max-out/gyrokinetic_cross_prim_moms_bgk_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), fh : openw(fname), - funcName : sconcat("gyrokinetic_cross_prim_moms_bgk_", c, "x", 2, "v_", bName[bInd], "_p", polyOrder), - calcGKCrossPrimMomsBGK(fh, funcName, c, 2, bName[bInd], polyOrder), + funcName : sconcat("gyrokinetic_cross_prim_moms_bgk_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + calcGKCrossPrimMomsBGK(fh, funcName, c, v, bName[bInd], polyOrder), close(fh) ) ) diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE.mac new file mode 100644 index 00000000..d92b341e --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE.mac @@ -0,0 +1,187 @@ +/* This script generates the kernels for calculating the flow energy + using weak division. */ + +load("modal-basis")$ +load("out-scripts")$ +load(stringproc)$ +load("scifac")$ +load("nodal_operations/nodal_functions")$ +fpprec : 24$ + +/* Special set of kernels which analytically invert the matrix for 1/rho + for p=1 using the basis_inv operator. Significantly faster than the bin_op operator, + but only works for p=1 */ +gk_neut_fluid_prim_vars_flowE_set_prob_p1(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, rho_e, expr_flowE, i], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, + const double *moms) ~%{ ~%", funcNm, polyOrder), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // A: preallocated LHS matrix. ~%"), + printf(fh, " // rhs: preallocated RHS vector. ~%"), + printf(fh, " // moms: moments (rho, rho ux, rho uy, rho uz, totalE).~%"), + printf(fh, "~%"), + + printf(fh, " // For poly_order = 1, we can analytically invert the matrix and just store the solution ~%"), + printf(fh, " struct gkyl_mat rhs_flowE = gkyl_nmat_get(rhs, count); ~%"), + + printf(fh, " // Clear rhs for each component of flow velocity being solved for ~%"), + printf(fh, " gkyl_mat_clear(&rhs_flowE, 0.0); ~%"), + + printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), + printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), + printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), + printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), + printf(fh, "~%"), + + /* Terms in sum rhou . rhou */ + printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Compute 0.5 * (rho u)^2. */ + printf(fh, " double rhouSqD2[~a]; ~%", NC), + for i : 1 thru NC do ( + printf(fh, " rhouSqD2[~a] = 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a]); ~%", i-1, i-1, i-1, i-1) + ), + printf(fh, "~%"), + + /* Expand rho. */ + rho_e : doExpand1(rho, bC), + + /* Arrays for storing inverse of rho */ + printf(fh, " double rho_inv[~a] = {0.0}; ~%", NC), + printf(fh, " ~a_~ax_p~a_inv(rho, rho_inv); ~%", basisFun, cdim, polyOrder), + + printf(fh, " // Calculate expansions of flow energy. ~%"), + printf(fh, " double flowE[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouSqD2, flowE); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + expr_flowE : float(expand(makelist(flowE[i],i,0,NC-1))), + + for i : 1 thru length(expr_flowE) do ( + printf(fh," gkyl_mat_set(&rhs_flowE,~a,0,~a); ~%", i-1, expr_flowE[i]) + ), + printf(fh, " ~%"), + printf(fh, "} ~%") +)$ + +gk_neut_fluid_prim_vars_flowE_set_prob(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, rho_e, expr_flowE, i, flowE_e, flowE_c, eq_rho, E_rho, j], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, + const double *moms) ~%{ ~%", funcNm, polyOrder), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // A: preallocated LHS matrix. ~%"), + printf(fh, " // rhs: preallocated RHS vector. ~%"), + printf(fh, " // moms: Moments [rho, rho ux, rho uy, rho uz, totalE].~%"), + printf(fh, "~%"), + + printf(fh, " struct gkyl_mat A_flowE = gkyl_nmat_get(A, count); ~%"), + + printf(fh, " struct gkyl_mat rhs_flowE = gkyl_nmat_get(rhs, count); ~%"), + + printf(fh, " // Clear matrix and rhs.~%"), + printf(fh, " gkyl_mat_clear(&A_flowE, 0.0); gkyl_mat_clear(&rhs_flowE, 0.0); ~%"), + + printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), + printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), + printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), + printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), + + printf(fh, "~%"), + /* Terms in sum rhou . rhou */ + printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Compute 0.5 * (rho u)^2. */ + printf(fh, " double rhouSqD2[~a]; ~%", NC), + for i : 1 thru NC do ( + printf(fh, " rhouSqD2[~a] = 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a]); ~%", i-1, i-1, i-1, i-1) + ), + printf(fh, "~%"), + + /* Expand rho. */ + rho_e : doExpand1(rho, bC), + + expr_flowE : float(expand(makelist(rhouSqD2[i],i,0,NC-1))), + + for i : 1 thru length(expr_flowE) do ( + printf(fh," gkyl_mat_set(&rhs_flowE,~a,0,~a); ~%", i-1, expr_flowE[i]) + ), + printf(fh, " ~%"), + + /* Generate matrix of unknown coefficients */ + flowE_e : doExpand1(flowE,bC), + flowE_c : makelist(flowE[i],i,0,NC-1), + eq_rho : calcInnerProdList(varsC,flowE_e,bC,rho_e), + E_rho : fullratsimp(coefmatrix(eq_rho,flowE_c)), + + /* Matrix is dense so just do a simple write routine */ + for i : 1 thru NC do ( + for j : 1 thru NC do ( + printf(fh," gkyl_mat_set(&A_flowE,~a,~a,~a); ~%", i-1, j-1, float(expand(E_rho[i,j]))), + printf(fh, " ~%") + ) + ), + printf(fh, "} ~%") +)$ + +gk_neut_fluid_prim_vars_flowE_get_sol(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, i], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + /* Function declaration with input/output variables. */ + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *xsol, + double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // xsol: Input solution vector. ~%"), + printf(fh, " // out: Output volume expansion of flow velocity and temperature;~%"), + printf(fh, " ~%"), + + printf(fh, " struct gkyl_mat x_flowE = gkyl_nmat_get(xsol, count); ~%"), + + printf(fh, " double *flowE = &out[~a]; ~%", 0*NC), + printf(fh, "~%"), + + /* Fetch volume expansion solution from linear solve */ + for i : 1 thru NC do ( + printf(fh," flowE[~a] = gkyl_mat_get(&x_flowE,~a,0); ~%", i-1, i-1) + ), + printf(fh, "~%"), + + printf(fh, "} ~%"), + printf(fh, " ~%") +)$ + diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac new file mode 100644 index 00000000..b29df747 --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac @@ -0,0 +1,58 @@ +/* This script generates the kernels for calculating the pressure for updating + fluid equations. Pressure different for each equation system: + Euler -> p = (gas_gamma - 1)*(E - 1/2 rho u^2)*/ + +load("modal-basis")$ +load("out-scripts")$ +load(stringproc)$ +load("scifac")$ +fpprec : 24$ + +gk_neut_fluid_prim_vars_pressure(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, i], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + printf(fh, "GKYL_CU_DH void ~a(double gas_gamma, const double *moms, const double *udrift, + double* GKYL_RESTRICT out) ~%{ ~%", funcNm, polyOrder), + printf(fh, " // gas_gamma: Adiabatic index.~%"), + printf(fh, " // moms: Moments (rho, rho ux, rho uy, rho uz, totalE).~%"), + printf(fh, " // udrift: Input volume expansion of flow velocity: [ux, uy, uz]. ~%"), + printf(fh, " // out: Output volume expansion of pressure.~%"), + printf(fh, "~%"), + + /* Fetch pointers needed to compute pressure from other fluid variables + Either p = (gas_gamma - 1)*(E - 1/2 rho u^2) */ + printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), + printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), + printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), + printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), + printf(fh, " const double *energy = &moms[~a]; ~%", 4*NC), + printf(fh, "~%"), + printf(fh, " const double *ux = &udrift[~a]; ~%", 0*NC), + printf(fh, " const double *uy = &udrift[~a]; ~%", 1*NC), + printf(fh, " const double *uz = &udrift[~a]; ~%", 2*NC), + printf(fh, "~%"), + + /* First construct volume expansion of rhou . u */ + printf(fh, " double rhoux2[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhoux, ux, rhoux2); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouy2[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouy, uy, rhouy2); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouz2[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouz, uz, rhouz2); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Compute pressure from energy */ + for i : 1 thru NC do ( + printf(fh, " out[~a] = (gas_gamma - 1.0)*(energy[~a] - 0.5*(rhoux2[~a] + rhouy2[~a] + rhouz2[~a])); ~%", i-1, i-1, i-1, i-1, i-1) + ), + + printf(fh, "} ~%") +)$ diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp.mac new file mode 100644 index 00000000..4fc7a6de --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp.mac @@ -0,0 +1,211 @@ +/* This script generates the kernels for calculating the temperature + using weak division. */ + +load("modal-basis")$ +load("out-scripts")$ +load(stringproc)$ +load("scifac")$ +load("nodal_operations/nodal_functions")$ +fpprec : 24$ + +/* Special set of kernels which analytically invert the matrix for 1/rho + for p=1 using the basis_inv operator. Significantly faster than the bin_op operator, + but only works for p=1 */ +gk_neut_fluid_prim_vars_temp_set_prob_p1(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, expr_ux, expr_uy, expr_uz, i], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, + const double *moms, double gas_gamma, double mass) ~%{ ~%", funcNm, polyOrder), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // A: preallocated LHS matrix. ~%"), + printf(fh, " // rhs: preallocated RHS vector. ~%"), + printf(fh, " // moms: moments (rho, rho ux, rho uy, rho uz, totalE).~%"), + printf(fh, " // gas_gamma: Adiabatic index. ~%"), + printf(fh, " // mass: Species mass. ~%"), + printf(fh, "~%"), + + printf(fh, " // For poly_order = 1, we can analytically invert the matrix and just store the solution ~%"), + printf(fh, " struct gkyl_mat rhs_temp = gkyl_nmat_get(rhs, count); ~%"), + + printf(fh, " // Clear rhs for each component of flow velocity being solved for ~%"), + printf(fh, " gkyl_mat_clear(&rhs_temp, 0.0); ~%"), + + printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), + printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), + printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), + printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), + printf(fh, " const double *totE = &moms[~a]; ~%", 4*NC), + printf(fh, "~%"), + + /* Mass density squared. */ + printf(fh, " double rhoSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rho, rho, rhoSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Mass density times total kinetic energy. */ + printf(fh, " double rho_totE[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rho, totE, rho_totE); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Terms in sum rhou . rhou */ + printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Compute mass density times temperature. */ + /* rho T = (gas_gamma - 1)*(mass * E - m/2 rho u^2) */ + /* rho^2 T = m (gas_gamma - 1)*(rho * E - 1/2 (rho u)^2) */ + printf(fh, " double rhoSq_temp[~a]; ~%", NC), + for i : 1 thru NC do ( + printf(fh, " rhoSq_temp[~a] = mass*(gas_gamma-1.0)*(rho_totE[~a] - 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a])); ~%", i-1, i-1, i-1, i-1, i-1) + ), + printf(fh, "~%"), + + /* Arrays for storing inverse of rho^2 */ + printf(fh, " double rhoSq_inv[~a] = {0.0}; ~%", NC), + printf(fh, " ~a_~ax_p~a_inv(rhoSq, rhoSq_inv); ~%", basisFun, cdim, polyOrder), + + printf(fh, " // Calculate expansions of temperature. ~%"), + printf(fh, " double temp[~a] = {0.0}; ~%", NC), + printf(fh, " ~%"), + + printf(fh, " binop_mul_~ad_~a_p~a(rhoSq_inv, rhoSq_temp, temp); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + expr_temp : float(expand(makelist(temp[i],i,0,NC-1))), + + for i : 1 thru length(expr_temp) do ( + printf(fh," gkyl_mat_set(&rhs_temp,~a,0,~a); ~%", i-1, expr_temp[i]) + ), + printf(fh, " ~%"), + printf(fh, "} ~%") +)$ + +gk_neut_fluid_prim_vars_temp_set_prob(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, i, ue, un, eq_rho, E_rhoSq, j], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, + const double *moms, double gas_gamma, double mass) ~%{ ~%", funcNm, polyOrder), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // A: preallocated LHS matrix. ~%"), + printf(fh, " // rhs: preallocated RHS vector. ~%"), + printf(fh, " // moms: Moments [rho, rho ux, rho uy, rho uz, totalE].~%"), + printf(fh, " // gas_gamma: Adiabatic index. ~%"), + printf(fh, " // mass: Species mass. ~%"), + printf(fh, "~%"), + + printf(fh, " struct gkyl_mat A_temp = gkyl_nmat_get(A, count); ~%"), + + printf(fh, " struct gkyl_mat rhs_temp = gkyl_nmat_get(rhs, count); ~%"), + + printf(fh, " // Clear matrix and rhs. ~%"), + printf(fh, " gkyl_mat_clear(&A_temp, 0.0); gkyl_mat_clear(&rhs_temp, 0.0); ~%"), + + printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), + printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), + printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), + printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), + printf(fh, " const double *totE = &moms[~a]; ~%", 4*NC), + printf(fh, "~%"), + + /* Mass density squared. */ + printf(fh, " double rhoSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rho, rho, rhoSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Mass density times total kinetic energy. */ + printf(fh, " double rho_totE[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rho, totE, rho_totE); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Terms in sum rhou . rhou */ + printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Compute mass density times temperature. */ + /* rho T = (gas_gamma - 1)*(mass * E - m/2 rho u^2) */ + /* rho^2 T = m (gas_gamma - 1)*(rho * E - 1/2 (rho u)^2) */ + printf(fh, " double rhoSq_temp[~a]; ~%", NC), + for i : 1 thru NC do ( + printf(fh, " rhoSq_temp[~a] = mass*(gas_gamma-1.0)*(rho_totE[~a] - 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a])); ~%", i-1, i-1, i-1, i-1, i-1) + ), + printf(fh, "~%"), + + expr_rhoSq_temp : float(expand(makelist(rhoSq_temp[i],i,0,NC-1))), + + for i : 1 thru length(expr_rhoSq_temp) do ( + printf(fh," gkyl_mat_set(&rhs_temp,~a,0,~a); ~%", i-1, expr_rhoSq_temp[i]) + ), + printf(fh, " ~%"), + + /* Generate matrix of unknown coefficients */ + rhoSq_e : doExpand1(rhoSq, bC), + temp_e : doExpand1(temp_e,bC), + temp_c : makelist(temp[i],i,0,NC-1), + eq_rhoSq : calcInnerProdList(varsC,temp_e,bC,rhoSq_e), + E_rhoSq : fullratsimp(coefmatrix(eq_rhoSq,temp_c)), + + /* Matrix is dense so just do a simple write routine */ + for i : 1 thru NC do ( + for j : 1 thru NC do ( + printf(fh," gkyl_mat_set(&A_temp,~a,~a,~a); ~%", i-1, j-1, float(expand(E_rhoSq[i,j]))), + printf(fh, " ~%") + ) + ), + printf(fh, "} ~%") +)$ + +gk_neut_fluid_prim_vars_temp_get_sol(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, i], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + /* Function declaration with input/output variables. */ + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *xsol, + double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // xsol: Input solution vector. ~%"), + printf(fh, " // out: Output volume expansion of temperaure. ~%"), + printf(fh, " ~%"), + + printf(fh, " struct gkyl_mat x_temp = gkyl_nmat_get(xsol, count); ~%"), + printf(fh, "~%"), + + /* Fetch volume expansion solution from linear solve */ + for i : 1 thru NC do ( + printf(fh," out[~a] = gkyl_mat_get(&x_temp,~a,0); ~%", i-1, i-1) + ), + printf(fh, "~%"), + + printf(fh, "} ~%"), + printf(fh, " ~%") +)$ diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift.mac new file mode 100644 index 00000000..48046514 --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift.mac @@ -0,0 +1,187 @@ +/* This script generates the kernels for calculating the flow velocity udrift_i + using weak division. */ + +load("modal-basis")$ +load("out-scripts")$ +load(stringproc)$ +load("scifac")$ +load("nodal_operations/nodal_functions")$ +fpprec : 24$ + +/* Special set of kernels which analytically invert the matrix for 1/rho + for p=1 using the basis_inv operator. Significantly faster than the bin_op operator, + but only works for p=1 */ +gk_neut_fluid_prim_vars_udrift_set_prob_p1(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, i], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, + const double *moms) ~%{ ~%", funcNm, polyOrder), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // A: preallocated LHS matrix. ~%"), + printf(fh, " // rhs: preallocated RHS vector. ~%"), + printf(fh, " // moms: moments (rho, rho ux, rho uy, rho uz, totalE).~%"), + printf(fh, "~%"), + + printf(fh, " // For poly_order = 1, we can analytically invert the matrix and just store the solution ~%"), + printf(fh, " struct gkyl_mat rhs_ux = gkyl_nmat_get(rhs, count); ~%"), + printf(fh, " struct gkyl_mat rhs_uy = gkyl_nmat_get(rhs, count+1); ~%"), + printf(fh, " struct gkyl_mat rhs_uz = gkyl_nmat_get(rhs, count+2); ~%"), + + printf(fh, " // Clear rhs for each component of flow velocity being solved for ~%"), + printf(fh, " gkyl_mat_clear(&rhs_ux, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&rhs_uy, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&rhs_uz, 0.0); ~%"), + + printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), + printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), + printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), + printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), + printf(fh, "~%"), + + /* Expand rho. */ + rho_e : doExpand1(rho, bC), + + /* Arrays for storing inverse of rho */ + printf(fh, " double rho_inv[~a] = {0.0}; ~%", NC), + printf(fh, " ~a_~ax_p~a_inv(rho, rho_inv); ~%", basisFun, cdim, polyOrder), + + printf(fh, " // Calculate expansions of flow velocity, which can be calculated free of aliasing errors. ~%"), + printf(fh, " double ux[~a] = {0.0}; ~%", NC), + printf(fh, " double uy[~a] = {0.0}; ~%", NC), + printf(fh, " double uz[~a] = {0.0}; ~%", NC), + printf(fh, " ~%"), + + printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhoux, ux); ~%", cdim, basisFun, polyOrder), + printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouy, uy); ~%", cdim, basisFun, polyOrder), + printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouz, uz); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + expr_ux : float(expand(makelist(ux[i],i,0,NC-1))), + expr_uy : float(expand(makelist(uy[i],i,0,NC-1))), + expr_uz : float(expand(makelist(uz[i],i,0,NC-1))), + + for i : 1 thru length(expr_ux) do ( + printf(fh," gkyl_mat_set(&rhs_ux,~a,0,~a); ~%", i-1, expr_ux[i]), + printf(fh," gkyl_mat_set(&rhs_uy,~a,0,~a); ~%", i-1, expr_uy[i]), + printf(fh," gkyl_mat_set(&rhs_uz,~a,0,~a); ~%", i-1, expr_uz[i]) + ), + printf(fh, " ~%"), + printf(fh, "} ~%") +)$ + +gk_neut_fluid_prim_vars_udrift_set_prob(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, i, ue, un, eq_rho, E_rho, j], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, + const double *moms) ~%{ ~%", funcNm, polyOrder), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // A: preallocated LHS matrix. ~%"), + printf(fh, " // rhs: preallocated RHS vector. ~%"), + printf(fh, " // moms: Moments [rho, rho ux, rho uy, rho uz, totalE].~%"), + printf(fh, "~%"), + + printf(fh, " struct gkyl_mat A_ux = gkyl_nmat_get(A, count); ~%"), + printf(fh, " struct gkyl_mat A_uy = gkyl_nmat_get(A, count+1); ~%"), + printf(fh, " struct gkyl_mat A_uz = gkyl_nmat_get(A, count+2); ~%"), + + printf(fh, " struct gkyl_mat rhs_ux = gkyl_nmat_get(rhs, count); ~%"), + printf(fh, " struct gkyl_mat rhs_uy = gkyl_nmat_get(rhs, count+1); ~%"), + printf(fh, " struct gkyl_mat rhs_uz = gkyl_nmat_get(rhs, count+2); ~%"), + + printf(fh, " // Clear matrix and rhs for each component of flow velocity being solved for ~%"), + printf(fh, " gkyl_mat_clear(&A_ux, 0.0); gkyl_mat_clear(&rhs_ux, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&A_uy, 0.0); gkyl_mat_clear(&rhs_uy, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&A_uz, 0.0); gkyl_mat_clear(&rhs_uz, 0.0); ~%"), + + printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), + printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), + printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), + printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), + printf(fh, "~%"), + + /* Expand rho. */ + rho_e : doExpand1(rho, bC), + + expr_ux : float(expand(makelist(rhoux[i],i,0,NC-1))), + expr_uy : float(expand(makelist(rhouy[i],i,0,NC-1))), + expr_uz : float(expand(makelist(rhouz[i],i,0,NC-1))), + + for i : 1 thru length(expr_ux) do ( + printf(fh," gkyl_mat_set(&rhs_ux,~a,0,~a); ~%", i-1, expr_ux[i]), + printf(fh," gkyl_mat_set(&rhs_uy,~a,0,~a); ~%", i-1, expr_uy[i]), + printf(fh," gkyl_mat_set(&rhs_uz,~a,0,~a); ~%", i-1, expr_uz[i]) + ), + printf(fh, " ~%"), + + /* Generate matrix of unknown coefficients */ + ue : doExpand1(u,bC), + un : makelist(u[i],i,0,NC-1), + eq_rho : calcInnerProdList(varsC,ue,bC,rho_e), + E_rho : fullratsimp(coefmatrix(eq_rho,un)), + + /* declare temp_rho and temp_p_perp since matrix entries in A are the same for all operations */ + printf(fh, " double temp_rho = 0.0; ~%"), + /* Matrix is dense so just do a simple write routine */ + for i : 1 thru NC do ( + for j : 1 thru NC do ( + printf(fh," temp_rho = ~a; ~%", float(expand(E_rho[i,j]))), + printf(fh," gkyl_mat_set(&A_ux,~a,~a,~a); ~%", i-1, j-1, temp_rho), + printf(fh," gkyl_mat_set(&A_uy,~a,~a,~a); ~%", i-1, j-1, temp_rho), + printf(fh," gkyl_mat_set(&A_uz,~a,~a,~a); ~%", i-1, j-1, temp_rho), + printf(fh, " ~%") + ) + ), + printf(fh, "} ~%") +)$ + +gk_neut_fluid_prim_vars_udrift_get_sol(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, ux_e, uy_e, uz_e], + + kill(varsC, basisC), + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + /* Function declaration with input/output variables. */ + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *xsol, + double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // xsol: Input solution vector. ~%"), + printf(fh, " // out: Output volume expansion of flow velocity;~%"), + printf(fh, " ~%"), + + printf(fh, " struct gkyl_mat x_ux = gkyl_nmat_get(xsol, count); ~%"), + printf(fh, " struct gkyl_mat x_uy = gkyl_nmat_get(xsol, count+1); ~%"), + printf(fh, " struct gkyl_mat x_uz = gkyl_nmat_get(xsol, count+2); ~%"), + + printf(fh, " double *ux = &out[~a]; ~%", 0*NC), + printf(fh, " double *uy = &out[~a]; ~%", 1*NC), + printf(fh, " double *uz = &out[~a]; ~%", 2*NC), + printf(fh, "~%"), + + /* Fetch volume expansion solution from linear solve */ + for i : 1 thru NC do ( + printf(fh," ux[~a] = gkyl_mat_get(&x_ux,~a,0); ~%", i-1, i-1), + printf(fh," uy[~a] = gkyl_mat_get(&x_uy,~a,0); ~%", i-1, i-1), + printf(fh," uz[~a] = gkyl_mat_get(&x_uz,~a,0); ~%", i-1, i-1) + ), + printf(fh, "~%"), + + printf(fh, "} ~%"), + printf(fh, " ~%") +)$ diff --git a/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp.mac b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp.mac new file mode 100644 index 00000000..b172d8a5 --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp.mac @@ -0,0 +1,279 @@ +/* This script generates the kernels for calculating the flow velocity udrift_i + and the temperature using weak division. */ + +load("modal-basis")$ +load("out-scripts")$ +load(stringproc)$ +load("scifac")$ +load("nodal_operations/nodal_functions")$ +fpprec : 24$ + +/* Special set of kernels which analytically invert the matrix for 1/rho + for p=1 using the basis_inv operator. Significantly faster than the bin_op operator, + but only works for p=1 */ +gk_neut_fluid_prim_vars_udrift_temp_set_prob_p1(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, expr_temp, i], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, + const double *moms, double gas_gamma, double mass) ~%{ ~%", funcNm, polyOrder), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // A: preallocated LHS matrix. ~%"), + printf(fh, " // rhs: preallocated RHS vector. ~%"), + printf(fh, " // moms: moments (rho, rho ux, rho uy, rho uz, totalE).~%"), + printf(fh, " // gas_gamma: Adiabatic index. ~%"), + printf(fh, " // mass: Species mass. ~%"), + printf(fh, "~%"), + + printf(fh, " // For poly_order = 1, we can analytically invert the matrix and just store the solution ~%"), + printf(fh, " struct gkyl_mat rhs_ux = gkyl_nmat_get(rhs, count); ~%"), + printf(fh, " struct gkyl_mat rhs_uy = gkyl_nmat_get(rhs, count+1); ~%"), + printf(fh, " struct gkyl_mat rhs_uz = gkyl_nmat_get(rhs, count+2); ~%"), + printf(fh, " struct gkyl_mat rhs_temp = gkyl_nmat_get(rhs, count+3); ~%"), + + printf(fh, " // Clear rhs for each component of flow velocity being solved for ~%"), + printf(fh, " gkyl_mat_clear(&rhs_ux, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&rhs_uy, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&rhs_uz, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&rhs_temp, 0.0); ~%"), + + printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), + printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), + printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), + printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), + printf(fh, " const double *totE = &moms[~a]; ~%", 4*NC), + printf(fh, "~%"), + + /* Mass density squared. */ + printf(fh, " double rhoSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rho, rho, rhoSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Mass density times total kinetic energy. */ + printf(fh, " double rho_totE[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rho, totE, rho_totE); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Terms in sum rhou . rhou */ + printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Expand rho. */ + rho_e : doExpand1(rho, bC), + + /* Arrays for storing inverse of rho */ + printf(fh, " double rho_inv[~a] = {0.0}; ~%", NC), + printf(fh, " ~a_~ax_p~a_inv(rho, rho_inv); ~%", basisFun, cdim, polyOrder), + + printf(fh, " // Calculate expansions of flow velocity. ~%"), + printf(fh, " double ux[~a] = {0.0}; ~%", NC), + printf(fh, " double uy[~a] = {0.0}; ~%", NC), + printf(fh, " double uz[~a] = {0.0}; ~%", NC), + printf(fh, " ~%"), + + printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhoux, ux); ~%", cdim, basisFun, polyOrder), + printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouy, uy); ~%", cdim, basisFun, polyOrder), + printf(fh, " binop_mul_~ad_~a_p~a(rho_inv, rhouz, uz); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Compute mass density times temperature. */ + /* rho T = (gas_gamma - 1)*(mass * E - m/2 rho u^2) */ + /* rho^2 T = m (gas_gamma - 1)*(rho * E - 1/2 (rho u)^2) */ + printf(fh, " double rhoSq_temp[~a]; ~%", NC), + for i : 1 thru NC do ( + printf(fh, " rhoSq_temp[~a] = mass*(gas_gamma-1.0)*(rho_totE[~a] - 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a])); ~%", i-1, i-1, i-1, i-1, i-1) + ), + printf(fh, "~%"), + + /* Arrays for storing inverse of rho^2 */ + printf(fh, " double rhoSq_inv[~a] = {0.0}; ~%", NC), + printf(fh, " ~a_~ax_p~a_inv(rhoSq, rhoSq_inv); ~%", basisFun, cdim, polyOrder), + + printf(fh, " // Calculate expansions of temperature. ~%"), + printf(fh, " double temp[~a] = {0.0}; ~%", NC), + printf(fh, " ~%"), + + printf(fh, " binop_mul_~ad_~a_p~a(rhoSq_inv, rhoSq_temp, temp); ~%", cdim, basisFun, polyOrder), + + expr_ux : float(expand(makelist(ux[i],i,0,NC-1))), + expr_uy : float(expand(makelist(uy[i],i,0,NC-1))), + expr_uz : float(expand(makelist(uz[i],i,0,NC-1))), + expr_temp : float(expand(makelist(temp[i],i,0,NC-1))), + + for i : 1 thru length(expr_ux) do ( + printf(fh," gkyl_mat_set(&rhs_ux,~a,0,~a); ~%", i-1, expr_ux[i]), + printf(fh," gkyl_mat_set(&rhs_uy,~a,0,~a); ~%", i-1, expr_uy[i]), + printf(fh," gkyl_mat_set(&rhs_uz,~a,0,~a); ~%", i-1, expr_uz[i]), + printf(fh," gkyl_mat_set(&rhs_temp,~a,0,~a); ~%", i-1, expr_temp[i]) + ), + printf(fh, " ~%"), + printf(fh, "} ~%") +)$ + +gk_neut_fluid_prim_vars_udrift_temp_set_prob(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, rho_e, expr_ux, expr_uy, expr_uz, expr_temp, i, u_e, u_c, eq_rho, E_rho, j], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, + const double *moms, double gas_gamma, double mass) ~%{ ~%", funcNm, polyOrder), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // A: preallocated LHS matrix. ~%"), + printf(fh, " // rhs: preallocated RHS vector. ~%"), + printf(fh, " // moms: Moments [rho, rho ux, rho uy, rho uz, totalE].~%"), + printf(fh, " // gas_gamma: Adiabatic index. ~%"), + printf(fh, " // mass: Species mass. ~%"), + printf(fh, "~%"), + + printf(fh, " struct gkyl_mat A_ux = gkyl_nmat_get(A, count); ~%"), + printf(fh, " struct gkyl_mat A_uy = gkyl_nmat_get(A, count+1); ~%"), + printf(fh, " struct gkyl_mat A_uz = gkyl_nmat_get(A, count+2); ~%"), + printf(fh, " struct gkyl_mat A_temp = gkyl_nmat_get(A, count+3); ~%"), + + printf(fh, " struct gkyl_mat rhs_ux = gkyl_nmat_get(rhs, count); ~%"), + printf(fh, " struct gkyl_mat rhs_uy = gkyl_nmat_get(rhs, count+1); ~%"), + printf(fh, " struct gkyl_mat rhs_uz = gkyl_nmat_get(rhs, count+2); ~%"), + printf(fh, " struct gkyl_mat rhs_temp = gkyl_nmat_get(rhs, count+3); ~%"), + + printf(fh, " // Clear matrix and rhs for each component of flow velocity being solved for ~%"), + printf(fh, " gkyl_mat_clear(&A_ux, 0.0); gkyl_mat_clear(&rhs_ux, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&A_uy, 0.0); gkyl_mat_clear(&rhs_uy, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&A_uz, 0.0); gkyl_mat_clear(&rhs_uz, 0.0); ~%"), + printf(fh, " gkyl_mat_clear(&A_temp, 0.0); gkyl_mat_clear(&rhs_temp, 0.0); ~%"), + + printf(fh, " const double *rho = &moms[~a]; ~%", 0*NC), + printf(fh, " const double *rhoux = &moms[~a]; ~%", 1*NC), + printf(fh, " const double *rhouy = &moms[~a]; ~%", 2*NC), + printf(fh, " const double *rhouz = &moms[~a]; ~%", 3*NC), + printf(fh, " const double *totE = &moms[~a]; ~%", 4*NC), + printf(fh, "~%"), + + /* Mass density squared. */ + printf(fh, " double rhoSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rho, rho, rhoSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Mass density times total kinetic energy. */ + printf(fh, " double rho_totE[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rho, totE, rho_totE); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Terms in sum rhou . rhou */ + printf(fh, " double rhouxSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhoux, rhoux, rhouxSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouySq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouy, rhouy, rhouySq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + printf(fh, " double rhouzSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(rhouz, rhouz, rhouzSq); ~%", cdim, basisFun, polyOrder), + printf(fh, " ~%"), + + /* Compute mass density times temperature. */ + /* rho T = (gas_gamma - 1)*(mass * E - m/2 rho u^2) */ + /* rho^2 T = m (gas_gamma - 1)*(rho * E - 1/2 (rho u)^2) */ + printf(fh, " double rhoSq_temp[~a]; ~%", NC), + for i : 1 thru NC do ( + printf(fh, " rhoSq_temp[~a] = mass*(gas_gamma-1.0)*(rho_totE[~a] - 0.5*(rhouxSq[~a] + rhouySq[~a] + rhouzSq[~a])); ~%", i-1, i-1, i-1, i-1, i-1) + ), + printf(fh, "~%"), + + expr_ux : float(expand(makelist(rhoux[i],i,0,NC-1))), + expr_uy : float(expand(makelist(rhouy[i],i,0,NC-1))), + expr_uz : float(expand(makelist(rhouz[i],i,0,NC-1))), + expr_temp : float(expand(makelist(rhoSq_temp[i],i,0,NC-1))), + + for i : 1 thru length(expr_ux) do ( + printf(fh," gkyl_mat_set(&rhs_ux,~a,0,~a); ~%", i-1, expr_ux[i]), + printf(fh," gkyl_mat_set(&rhs_uy,~a,0,~a); ~%", i-1, expr_uy[i]), + printf(fh," gkyl_mat_set(&rhs_uz,~a,0,~a); ~%", i-1, expr_uz[i]), + printf(fh," gkyl_mat_set(&rhs_temp,~a,0,~a); ~%", i-1, expr_temp[i]) + ), + printf(fh, " ~%"), + + /* Generate matrix of unknown coefficients */ + rho_e : doExpand1(rho, bC), + u_e : doExpand1(u,bC), + u_c : makelist(u[i],i,0,NC-1), + eq_rho : calcInnerProdList(varsC,u_e,bC,rho_e), + E_rho : fullratsimp(coefmatrix(eq_rho,u_c)), + + rhoSq_e : doExpand1(rhoSq, bC), + temp_e : doExpand1(temp_e,bC), + temp_c : makelist(temp[i],i,0,NC-1), + eq_rhoSq : calcInnerProdList(varsC,temp_e,bC,rhoSq_e), + E_rhoSq : fullratsimp(coefmatrix(eq_rhoSq,temp_c)), + + /* declare tmp_rho since matrix entries in A are the same for all operations */ + printf(fh, " double tmp_rho = 0.0; ~%"), + /* Matrix is dense so just do a simple write routine */ + for i : 1 thru NC do ( + for j : 1 thru NC do ( + printf(fh," tmp_rho = ~a; ~%", float(expand(E_rho[i,j]))), + printf(fh," gkyl_mat_set(&A_ux,~a,~a,~a); ~%", i-1, j-1, tmp_rho), + printf(fh," gkyl_mat_set(&A_uy,~a,~a,~a); ~%", i-1, j-1, tmp_rho), + printf(fh," gkyl_mat_set(&A_uz,~a,~a,~a); ~%", i-1, j-1, tmp_rho), + printf(fh," gkyl_mat_set(&A_temp,~a,~a,~a); ~%", i-1, j-1, float(expand(E_rhoSq[i,j]))), + printf(fh, " ~%") + ) + ), + printf(fh, "} ~%") +)$ + +gk_neut_fluid_prim_vars_udrift_temp_get_sol(fh, funcNm, cdim, basisFun, polyOrder) := block( + [varsC, bC, NC, i], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + /* Function declaration with input/output variables. */ + printf(fh, "GKYL_CU_DH void ~a(int count, struct gkyl_nmat *xsol, + double* GKYL_RESTRICT out) ~%{ ~%", funcNm), + printf(fh, " // count: integer to indicate which matrix being fetched. ~%"), + printf(fh, " // xsol: Input solution vector. ~%"), + printf(fh, " // out: Output volume expansion of flow velocity and temperature;~%"), + printf(fh, " ~%"), + + printf(fh, " struct gkyl_mat x_ux = gkyl_nmat_get(xsol, count); ~%"), + printf(fh, " struct gkyl_mat x_uy = gkyl_nmat_get(xsol, count+1); ~%"), + printf(fh, " struct gkyl_mat x_uz = gkyl_nmat_get(xsol, count+2); ~%"), + printf(fh, " struct gkyl_mat x_temp = gkyl_nmat_get(xsol, count+3); ~%"), + + printf(fh, " double *ux = &out[~a]; ~%", 0*NC), + printf(fh, " double *uy = &out[~a]; ~%", 1*NC), + printf(fh, " double *uz = &out[~a]; ~%", 2*NC), + printf(fh, " double *temp = &out[~a]; ~%", 3*NC), + printf(fh, "~%"), + + /* Fetch volume expansion solution from linear solve */ + for i : 1 thru NC do ( + printf(fh," ux[~a] = gkyl_mat_get(&x_ux,~a,0); ~%", i-1, i-1), + printf(fh," uy[~a] = gkyl_mat_get(&x_uy,~a,0); ~%", i-1, i-1), + printf(fh," uz[~a] = gkyl_mat_get(&x_uz,~a,0); ~%", i-1, i-1), + printf(fh," temp[~a] = gkyl_mat_get(&x_temp,~a,0); ~%", i-1, i-1) + ), + printf(fh, "~%"), + + printf(fh, "} ~%"), + printf(fh, " ~%") +)$ + diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-flowE.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-flowE.mac new file mode 100644 index 00000000..cd02689e --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-flowE.mac @@ -0,0 +1,61 @@ +load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-flowE")$ +load(stringproc)$ +/* This script calls the functions which generate the kernels for calculating the flow + energy using weak division. */ + + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 2$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor product basis. */ +/* Note that Serendipity, p = 1, is equivalent to Tensor */ +/* Thus no need to calculate p = 1 Tensor basis */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 2$ +maxCdim_Tensor : 0$ + +/* ...... END OF USER INPUTS........ */ + +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +for bInd : 1 thru length(bName) do ( + for d : minCdim[bInd] thru maxCdim[bInd] do ( + minPolyOrderB : minPolyOrder[bInd], + maxPolyOrderB : maxPolyOrder[bInd], + if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, + + for polyOrder : minPolyOrderB thru maxPolyOrderB do ( + disp(printf(false,sconcat("Creating prim vars flow energy funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), + + fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_flowE_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), + fh : openw(fname), + + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + printf(fh, "#include ~%", bName[bInd], d, polyOrder), + + funcName : sconcat("gk_neut_fluid_prim_vars_flowE_set_prob_", d, "x_", bName[bInd], "_p", polyOrder), + if (polyOrder = 1) then ( + gk_neut_fluid_prim_vars_flowE_set_prob_p1(fh, funcName, d, bName[bInd], polyOrder) + ) + else ( + gk_neut_fluid_prim_vars_flowE_set_prob(fh, funcName, d, bName[bInd], polyOrder) + ), + + funcName : sconcat("gk_neut_fluid_prim_vars_flowE_get_sol_", d, "x_", bName[bInd], "_p", polyOrder), + gk_neut_fluid_prim_vars_flowE_get_sol(fh, funcName, d, bName[bInd], polyOrder), + close(fh) + ) + ) +); diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-header.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-header.mac new file mode 100644 index 00000000..d8b1ab73 --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-header.mac @@ -0,0 +1,70 @@ +/* Generate the header file for gk neutral fluid prim vars kernels. */ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 2$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor product basis. */ +/* Note that Serendipity, p = 1, is equivalent to Tensor */ +/* Thus no need to calculate p = 1 Tensor basis */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 2$ +maxCdim_Tensor : 0$ + +/* ...... END OF USER INPUTS........ */ + +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +printPrototype(deco, ci, bStr, pi) := block([si], + + printf(fh, "~avoid gk_neut_fluid_prim_vars_udrift_set_prob_~ax_~a_p~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, const double *moms); ~%", deco, ci, bStr, pi), + printf(fh, "~avoid gk_neut_fluid_prim_vars_udrift_get_sol_~ax_~a_p~a(int count, struct gkyl_nmat *xsol, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), + + printf(fh, "~avoid gk_neut_fluid_prim_vars_pressure_~ax_~a_p~a(double gas_gamma, const double *moms, const double *udrift, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), + + printf(fh, "~avoid gk_neut_fluid_prim_vars_temp_set_prob_~ax_~a_p~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, const double *moms, double gas_gamma, double mass); ~%", deco, ci, bStr, pi), + printf(fh, "~avoid gk_neut_fluid_prim_vars_temp_get_sol_~ax_~a_p~a(int count, struct gkyl_nmat *xsol, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), + + printf(fh, "~avoid gk_neut_fluid_prim_vars_udrift_temp_set_prob_~ax_~a_p~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, const double *moms, double gas_gamma, double mass); ~%", deco, ci, bStr, pi), + printf(fh, "~avoid gk_neut_fluid_prim_vars_udrift_temp_get_sol_~ax_~a_p~a(int count, struct gkyl_nmat *xsol, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), + + printf(fh, "~avoid gk_neut_fluid_prim_vars_flowE_set_prob_~ax_~a_p~a(int count, struct gkyl_nmat *A, struct gkyl_nmat *rhs, const double *moms); ~%", deco, ci, bStr, pi), + printf(fh, "~avoid gk_neut_fluid_prim_vars_flowE_get_sol_~ax_~a_p~a(int count, struct gkyl_nmat *xsol, double* GKYL_RESTRICT out); ~%", deco, ci, bStr, pi), + + printf(fh, "~%") +)$ + +/* ............ Write out the C header file ............ */ +fh : openw("~/max-out/gkyl_gk_neut_fluid_prim_vars_kernels.h")$ + +printf(fh, "#pragma once ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "EXTERN_C_BEG ~%")$ +printf(fh, "~%")$ + +decorator : "GKYL_CU_DH "$ +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + + minPolyOrderB : minPolyOrder[bInd], + maxPolyOrderB : maxPolyOrder[bInd], + if (c>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, + for polyOrder : minPolyOrderB thru maxPolyOrderB do ( + printPrototype(decorator, c, bName[bInd], polyOrder) + ) + ) +); +printf(fh, "EXTERN_C_END ~%")$ +close(fh)$ +/* ............ Finished writing out the C header file ............ */ diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-pressure.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-pressure.mac new file mode 100644 index 00000000..7f349108 --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-pressure.mac @@ -0,0 +1,53 @@ +load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-pressure.mac")$ +load(stringproc)$ +/* This script calls the functions which generate the kernels for calculating the + pressure via weak multiplication. Pressure different for each equation system: + Euler -> p = (gas_gamma - 1)*(E - 1/2 rho u^2) + Computes both the volume expansion and the necessary surface expansions of p at + the corresponding surfaces */ + + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 2$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor product basis. */ +/* Note that Serendipity, p = 1, is equivalent to Tensor */ +/* Thus no need to calculate p = 1 Tensor basis */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 2$ +maxCdim_Tensor : 0$ + +/* ...... END OF USER INPUTS........ */ + +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +for bInd : 1 thru length(bName) do ( + for d : minCdim[bInd] thru maxCdim[bInd] do ( + minPolyOrderB : minPolyOrder[bInd], + maxPolyOrderB : maxPolyOrder[bInd], + if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, + + for polyOrder : minPolyOrderB thru maxPolyOrderB do ( + disp(printf(false,sconcat("Creating prim var pressure funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), + fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_pressure_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), + fh : openw(fname), + + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + + funcName : sconcat("gk_neut_fluid_prim_vars_pressure_", d, "x_", bName[bInd], "_p", polyOrder), + gk_neut_fluid_prim_vars_pressure(fh, funcName, d, bName[bInd], polyOrder), + close(fh) + ) + ) +); diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-temp.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-temp.mac new file mode 100644 index 00000000..992eb21f --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-temp.mac @@ -0,0 +1,61 @@ +load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-temp")$ +load(stringproc)$ +/* This script calls the functions which generate the kernels for calculating the + temperature using weak division. */ + + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 2$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor product basis. */ +/* Note that Serendipity, p = 1, is equivalent to Tensor */ +/* Thus no need to calculate p = 1 Tensor basis */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 2$ +maxCdim_Tensor : 0$ + +/* ...... END OF USER INPUTS........ */ + +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +for bInd : 1 thru length(bName) do ( + for d : minCdim[bInd] thru maxCdim[bInd] do ( + minPolyOrderB : minPolyOrder[bInd], + maxPolyOrderB : maxPolyOrder[bInd], + if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, + + for polyOrder : minPolyOrderB thru maxPolyOrderB do ( + disp(printf(false,sconcat("Creating prim vars temp funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), + + fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_temp_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), + fh : openw(fname), + + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + printf(fh, "#include ~%", bName[bInd], d, polyOrder), + + funcName : sconcat("gk_neut_fluid_prim_vars_temp_set_prob_", d, "x_", bName[bInd], "_p", polyOrder), + if (polyOrder = 1) then ( + gk_neut_fluid_prim_vars_temp_set_prob_p1(fh, funcName, d, bName[bInd], polyOrder) + ) + else ( + gk_neut_fluid_prim_vars_temp_set_prob(fh, funcName, d, bName[bInd], polyOrder) + ), + + funcName : sconcat("gk_neut_fluid_prim_vars_temp_get_sol_", d, "x_", bName[bInd], "_p", polyOrder), + gk_neut_fluid_prim_vars_temp_get_sol(fh, funcName, d, bName[bInd], polyOrder), + close(fh) + ) + ) +); diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift.mac new file mode 100644 index 00000000..eda17370 --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift.mac @@ -0,0 +1,61 @@ +load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift")$ +load(stringproc)$ +/* This script calls the functions which generate the kernels for calculating the flow + velocity using weak division. */ + + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 2$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor product basis. */ +/* Note that Serendipity, p = 1, is equivalent to Tensor */ +/* Thus no need to calculate p = 1 Tensor basis */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 2$ +maxCdim_Tensor : 0$ + +/* ...... END OF USER INPUTS........ */ + +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +for bInd : 1 thru length(bName) do ( + for d : minCdim[bInd] thru maxCdim[bInd] do ( + minPolyOrderB : minPolyOrder[bInd], + maxPolyOrderB : maxPolyOrder[bInd], + if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, + + for polyOrder : minPolyOrderB thru maxPolyOrderB do ( + disp(printf(false,sconcat("Creating prim vars udrift funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), + + fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_udrift_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), + fh : openw(fname), + + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + printf(fh, "#include ~%", bName[bInd], d, polyOrder), + + funcName : sconcat("gk_neut_fluid_prim_vars_udrift_set_prob_", d, "x_", bName[bInd], "_p", polyOrder), + if (polyOrder = 1) then ( + gk_neut_fluid_prim_vars_udrift_set_prob_p1(fh, funcName, d, bName[bInd], polyOrder) + ) + else ( + gk_neut_fluid_prim_vars_udrift_set_prob(fh, funcName, d, bName[bInd], polyOrder) + ), + + funcName : sconcat("gk_neut_fluid_prim_vars_udrift_get_sol_", d, "x_", bName[bInd], "_p", polyOrder), + gk_neut_fluid_prim_vars_udrift_get_sol(fh, funcName, d, bName[bInd], polyOrder), + close(fh) + ) + ) +); diff --git a/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift_temp.mac b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift_temp.mac new file mode 100644 index 00000000..4e07293c --- /dev/null +++ b/maxima/g0/gk_neut_fluid_prim_vars/ms-gk_neut_fluid_prim_vars-udrift_temp.mac @@ -0,0 +1,61 @@ +load("gk_neut_fluid_prim_vars/gk_neut_fluid_prim_vars-udrift_temp")$ +load(stringproc)$ +/* This script calls the functions which generate the kernels for calculating the flow + velocity and temperature using weak division. */ + + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 2$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor product basis. */ +/* Note that Serendipity, p = 1, is equivalent to Tensor */ +/* Thus no need to calculate p = 1 Tensor basis */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 2$ +maxCdim_Tensor : 0$ + +/* ...... END OF USER INPUTS........ */ + +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +for bInd : 1 thru length(bName) do ( + for d : minCdim[bInd] thru maxCdim[bInd] do ( + minPolyOrderB : minPolyOrder[bInd], + maxPolyOrderB : maxPolyOrder[bInd], + if (d>1 and bName[bInd] = "ser") then maxPolyOrderB : 1, + + for polyOrder : minPolyOrderB thru maxPolyOrderB do ( + disp(printf(false,sconcat("Creating prim vars udrift funcs ",bName[bInd]," ~axp~a"),d,polyOrder)), + + fname : sconcat("~/max-out/gk_neut_fluid_prim_vars_udrift_temp_", d, "x_", bName[bInd], "_p", polyOrder, ".c"), + fh : openw(fname), + + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + printf(fh, "#include ~%", bName[bInd], d, polyOrder), + + funcName : sconcat("gk_neut_fluid_prim_vars_udrift_temp_set_prob_", d, "x_", bName[bInd], "_p", polyOrder), + if (polyOrder = 1) then ( + gk_neut_fluid_prim_vars_udrift_temp_set_prob_p1(fh, funcName, d, bName[bInd], polyOrder) + ) + else ( + gk_neut_fluid_prim_vars_udrift_temp_set_prob(fh, funcName, d, bName[bInd], polyOrder) + ), + + funcName : sconcat("gk_neut_fluid_prim_vars_udrift_temp_get_sol_", d, "x_", bName[bInd], "_p", polyOrder), + gk_neut_fluid_prim_vars_udrift_temp_get_sol(fh, funcName, d, bName[bInd], polyOrder), + close(fh) + ) + ) +); diff --git a/maxima/g0/gk_pol_den/ms-pol_density-header.mac b/maxima/g0/gk_pol_den/ms-pol_density-header.mac index eaf5a722..4264549a 100644 --- a/maxima/g0/gk_pol_den/ms-pol_density-header.mac +++ b/maxima/g0/gk_pol_den/ms-pol_density-header.mac @@ -40,7 +40,13 @@ for bInd : 1 thru length(bName) do ( for cd : minCdim[bInd] thru maxCdim[bInd] do ( for polyOrder : minPolyOrder[bInd] thru maxPolyOrder[bInd] do ( - funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder), + funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_",bName[bInd],"_p",polyOrder), + printf(fh, "GKYL_CU_DH void ~a(const double *dx, const double *epsilon, const double *phi, double *out);~%", funcName), + + funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_",bName[bInd],"_p",polyOrder+1), + printf(fh, "GKYL_CU_DH void ~a(const double *dx, const double *epsilon, const double *phi, double *out);~%", funcName), + + funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_","tensor","_p",polyOrder+1), printf(fh, "GKYL_CU_DH void ~a(const double *dx, const double *epsilon, const double *phi, double *out);~%", funcName) ) ), diff --git a/maxima/g0/gk_pol_den/ms-pol_density.mac b/maxima/g0/gk_pol_den/ms-pol_density.mac index 9709f329..60ba36eb 100644 --- a/maxima/g0/gk_pol_den/ms-pol_density.mac +++ b/maxima/g0/gk_pol_den/ms-pol_density.mac @@ -42,8 +42,18 @@ for bInd : 1 thru length(bName) do ( for cd : minCdim[bInd] thru maxCdim[bInd] do ( for polyOrder : minPolyOrder[bInd] thru maxPolyOrder[bInd] do ( disp(printf(false,sconcat("Creating gkyl_gyrokinetic_pol_density ~ax p~a ", bName[bInd]),cd,polyOrder)), - funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder), - gen_pol_den_kernel(fh, funcName, cd, bName[bInd], polyOrder) + + /* Represent phi with same basis and poly_order. */ + funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_",bName[bInd],"_p",polyOrder), + gen_pol_den_kernel(fh, funcName, cd, bName[bInd], polyOrder, bName[bInd], polyOrder), + + /* Represent phi with same basis and poly_order+1. */ + funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_",bName[bInd],"_p",polyOrder+1), + gen_pol_den_kernel(fh, funcName, cd, bName[bInd], polyOrder, bName[bInd], polyOrder+1), + + /* Represent phi with tensor basis and poly_order+1. */ + funcName : sconcat("gkyl_gyrokinetic_pol_density_",cd,"x_",bName[bInd],"_p",polyOrder,"_from_phi_","tensor","_p",polyOrder+1), + gen_pol_den_kernel(fh, funcName, cd, bName[bInd], polyOrder, "tensor", polyOrder+1) ) ), diff --git a/maxima/g0/gk_pol_den/pol_density.mac b/maxima/g0/gk_pol_den/pol_density.mac index 6ff5b4c2..43897a9b 100644 --- a/maxima/g0/gk_pol_den/pol_density.mac +++ b/maxima/g0/gk_pol_den/pol_density.mac @@ -6,12 +6,12 @@ load("modal-basis"); load("out-scripts"); fpprec : 24$ -gen_pol_den_kernel(fh, funcNm, dim, basisFun, polyOrder) := block( +gen_pol_den_kernel(fh, funcNm, dim, basisFun, polyOrder, basisFunPhi, polyOrderPhi) := block( [vars,basis_p,numB_p,basis,numB,phi_e,dimPerp,varsPerp,varCombos,epsSup_l, eps,eps_e,i,j,varsSorted,epsNew,isNew,k,rdx_ij,ijSorted,pol_den_c], - /* Load a higher order tensor basis to represent phi. */ - [vars, basis_p] : loadBasis("tensor", dim, polyOrder+1), + /* Load a basis to represent phi. */ + [vars, basis_p] : loadBasis(basisFunPhi, dim, polyOrderPhi), numB_p : length(basis_p), /* Load basis to represent other quantities. */ diff --git a/maxima/g0/neutrals/sigma-cx-calc.mac b/maxima/g0/neutrals/sigma-cx-calc.mac deleted file mode 100644 index e54cc6d1..00000000 --- a/maxima/g0/neutrals/sigma-cx-calc.mac +++ /dev/null @@ -1,139 +0,0 @@ -/* Generate CX cross section (vSigmaCX) kernels for charge - exchange operator */ - -load("modal-basis"); -load("out-scripts"); -load(stringproc)$ -fpprec : 24$ - -/* Serendipity basis. */ -maxPolyOrder_Ser : 2$ - -declareWriteCExprsC(lhs, rhs) := block([expr], - expr : float(expand(rhs)), - if expr # 0.0 then ( - ep : string(expr), - for i : 0 thru 60 do ( - ep : ssubst(string(pow(u_ion[i],2.)),string(u_ion[i]^2),ep), - ep : ssubst(string(pow(u_neut[i],2.)),string(u_neut[i]^2),ep) - ), - printf(fh, " double ~a = ~a; ~%", lhs, ep) - ) -)$ - -writeCExprsCs(lhs, rhs) := block([expr], - expr : float(expand(rhs)), - for i : 1 thru length(expr) do ( - if expr[i] # 0.0 then ( - ep : string(expr[i]), - ep : ssubst("log(","ln(",ep), - printf(fh, " ~a = ~a; ~%", lhs[i-1], ep) - ) - ) -)$ - -writeCExprsC(lhs, rhs) := block([expr], - expr : float(expand(rhs)), - if expr # 0.0 then ( - ep : string(expr), - printf(fh, " ~a = ~a; ~%", lhs, ep) - ) -)$ - -/* vSigmaCX for charge exchange cross section */ -calcSigmaCXcellAv(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block([], - kill(varsC, varsP, basisC, basisP), - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - NC : length(bC), - - printf(fh, " ~%"), - printf(fh, "GKYL_CU_DH static inline ~%"), - printf(fh, "double ~a_p~a(const double a, const double b, double vt_sq_ion_min, double vt_sq_neut_min, const double *m0, const double *prim_vars_ion, const double *prim_vars_neut, double* GKYL_RESTRICT v_sigma_cx) ~%{ ~%", funcNm, p), - printf(fh, " // a constant in fitting function. ~%"), - printf(fh, " // b constant in fitting function. ~%"), - printf(fh, " // m0[~a]: neutral particle density. ~%", NC), - printf(fh, " // prim_vars_ion[~a]: ion prim vars. ~%", NC*(vdim+1)), - printf(fh, " // prim_vars_neut[~a]: neut prim vars. ~%", NC*(vdim+1)), - printf(fh, " // v_sigma_cx: cell ave cross section fitting eqn. ~%"), - printf(fh, " ~%"), - - m0_e : doExpand1(m0,bC), - m0_av : innerProd(varsC,1.0,1.0,m0_e)/innerProd(varsC,1.0,1.0,1.0), - declareWriteCExprsC(m0_neut_av, m0_av), - - printf(fh, " const double *u_ion = &prim_vars_ion[~a]; ~%", 0), - printf(fh, " const double *vt_sq_ion = &prim_vars_ion[~a]; ~%", NC*vdim), - printf(fh, " const double *u_neut = &prim_vars_neut[~a]; ~%", 0), - printf(fh, " const double *vt_sq_neut = &prim_vars_neut[~a]; ~%", NC*vdim), - printf(fh, " ~%"), - - u_ion_av_c : subst(makelist(u_ion[i]=u_ion[i+a0],i,0,NC-1),innerProd(varsC,1.0,1.0,doExpand1(u_ion,bC))/innerProd(varsC,1.0,1.0,1.0)), - u_neut_av_c : subst(makelist(u_neut[i]=u_neut[i+a0],i,0,NC-1),innerProd(varsC,1.0,1.0,doExpand1(u_neut,bC))/innerProd(varsC,1.0,1.0,1.0)), - - u_ion_av : makelist(0,i,1,vdim), - u_neut_av : makelist(0,i,1,vdim), - for vi : 1 thru vdim do ( - u_ion_av[vi] : fullratsimp(subst(a0=(vi-1)*NC,u_ion_av_c)), - u_neut_av[vi] : fullratsimp(subst(a0=(vi-1)*NC,u_neut_av_c)) - ), - - vt_sq_ion_av_c : innerProd(varsC,1.0,1.0, doExpand1(vt_sq_ion,bC))/innerProd(varsC,1.0,1.0,1.0), - vt_sq_neut_av_c : innerProd(varsC,1.0,1.0, doExpand1(vt_sq_neut,bC))/innerProd(varsC,1.0,1.0,1.0), - - declareWriteCExprsC(vt_sq_ion_av, vt_sq_ion_av_c), - declareWriteCExprsC(vt_sq_neut_av, vt_sq_neut_av_c), - - /* Limit how low the temperature can get (set by the velocity grid). */ - printf(fh, " if ((vt_sq_ion_av > 0.) && (vt_sq_ion_av < vt_sq_ion_min)) vt_sq_ion_av = vt_sq_ion_min;~%"), - printf(fh, " if ((vt_sq_neut_av > 0.) && (vt_sq_neut_av < vt_sq_neut_min)) vt_sq_neut_av = vt_sq_neut_min;~%"), - printf(fh, " ~%"), - - /* Define and write v_sigma_cx */ - printf(fh, " if (m0_neut_av <= 0 || vt_sq_neut_av <= 0 || vt_sq_ion_av <= 0) { ~%"), - printf(fh, " v_sigma_cx[0] = 0.0;~%"), - printf(fh, " return 0.0; ~%"), - printf(fh, " } else {~%"), - - /* Define v_in variable: v_in_sq = |u_ion - u_neut|^2 */ - v_in_sq_c : innerProd(varsC,1.0,1.0,sum((u_ion_av[d] - u_neut_av[d])^2,d,1,vdim))/innerProd(varsC,1.0,1.0,1.0), - declareWriteCExprsC(v_in_sq_av, v_in_sq_c), - printf(fh, " ~%"), - - printf(fh, " double v_cx = ~a;~%",float(sqrt(4/%pi*vt_sq_ion_av + 4/%pi*vt_sq_neut_av + v_in_sq_av))), - v_sigma_cx_c : calcInnerProdList(varsC,1.0,bC,v_cx*(a - b*ln(v_cx))), - writeCExprsCs(v_sigma_cx, v_sigma_cx_c), - printf(fh, " ~%"), - - v_sigma_cx_e : doExpand1(v_sigma_cx,bC), - v_sigma_cx_av : innerProd(varsC,1.0,1.0,v_sigma_cx_e)/innerProd(varsC,1.0,1.0,1.0), - cflRate : float(expand(fullratsimp(m0_av*v_sigma_cx_av/(2*p+1)))), - printf(fh, " return ~a; ~%",cflRate), - printf(fh, " }~%"), - printf(fh, "} ~%") -)$ - -bName : ["ser"]$ -maxPolyOrder : [maxPolyOrder_Ser]$ - -fh : openw("~/max-out/gkyl_dg_cx_kernels.h")$ -printf(fh, "#pragma once ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ - -for bInd : 1 thru length(bName) do ( - for c : 1 thru 3 do ( - for v : c thru 3 do ( - for p : 1 thru maxPolyOrder[bInd] do ( - print(p), - disp(printf(false,sconcat("Creating v_sigma_cx ", bName[bInd]," ~ax~av"),c,v)), - - print("attempting to print",c,"x",v,"v",p,"p functions..."), - /*. Calculate CX cross section. */ - funcNm : sconcat("sigma_cx_", c, "x", v, "v_", bName[bInd]), - - calcSigmaCXcellAv(fh, funcNm, c, v, bName[bInd], p) - ) - ) - ) -); -close(fh)$ diff --git a/maxima/g0/prim_moments/CrossPrimMomsLBO.mac b/maxima/g0/prim_moments/CrossPrimMomsLBO.mac index a50045ae..54008836 100644 --- a/maxima/g0/prim_moments/CrossPrimMomsLBO.mac +++ b/maxima/g0/prim_moments/CrossPrimMomsLBO.mac @@ -37,11 +37,13 @@ writeCExprs1s(lhs, rhs) := block([expr], )$ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( - [udim,vDegFreedom,basis,numB,expr,m0_e,m0_c,m2_e,m2_c,vtsq_self_e,vtsq_self_c, - vtsq_other_e,vtsq_other_c,vtSqCross_e,vtSqCross_c,cE_e,cE_c,N,u_self_e,u_self_c, - u_other_e,u_other_c,m1_e,m1_c,cM_e,cM_c,uCross_e,uCross_c,eq,E,Eflat,Elhs,momRHS_c, - ucMSelf_c,ucMSelf_e,ucMOther_c,ucMOther_e,uM1Self_c,uM1Self_e,uM1Other_c,uM1Other_e, - uSumSq_c,uSumSq_e,enRHS1_c,enRHS2_c,enRHS_c,tempVars,sqCoeffs], + [udim,vDegFreedom,vars,basis,numB,nodes,momsin,vtsqin,m0in_e,m0Corners,m2in_e, + m2Corners,vtsqin_e,vtsqCorners,alphaE_c,alphaE_e,alphaECorners,expr,m0_e,m0_c,m2_e,m2_c, + vtsq_self_e,vtsq_self_c,vtsq_other_e,vtsq_other_c,vtSqCross_e,vtSqCross_c,cE_e, + cE_c,N,u_self_e,u_self_c,u_other_e,u_other_c,m1_e,m1_c,cM_e,cM_c,uCross_e,uCross_c, + eq,E,Eflat,Elhs,momRHS_c,ucMSelf_c,ucMSelf_e,ucMOther_c,ucMOther_e,uM1Self_c, + uM1Self_e,uM1Other_c,uM1Other_e,uSumSq_c,uSumSq_e,enRHS1_c,enRHS2_c,enRHS_c, + tempVars,sqCoeffs], if (sequal(substring(funcNm,1,7),"vlasov")) then ( udim : vdim, @@ -58,15 +60,22 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( numB : length(basis), /* Function declaration with input/output variables. */ - printf(fh, "GKYL_CU_DH void ~a(struct gkyl_mat *A, struct gkyl_mat *rhs, const double *greene, const double m_self, const double *moms_self, const double *prim_mom_self, const double m_other, const double *moms_other, const double *prim_mom_other, const double *boundary_corrections, const double *nu) ~%{ ~%", funcNm), - printf(fh, " // greene: Greene's factor. ~%"), - printf(fh, " // m_: mass. ~%"), - printf(fh, " // moms: moments of the distribution function. ~%"), - printf(fh, " // prim_mom self primitive moments: mean flow velocity and thermal speed squared. ~%"), + printf(fh, "GKYL_CU_DH void ~a(struct gkyl_mat *A, struct gkyl_mat *rhs, const double *alphaE, const double m_self, const double *moms_self, const double *prim_mom_self, const double m_other, const double *moms_other, const double *prim_mom_other, const double *boundary_corrections, const double *nu) ~%{ ~%", funcNm), + printf(fh, " // A: Left-side matrix. ~%"), + printf(fh, " // rhs: Right-side vector. ~%"), + printf(fh, " // alphaE: Morse's alpha_E factor. ~%"), + printf(fh, " // m_self: self mass. ~%"), + printf(fh, " // moms_self: self moments of the distribution function. ~%"), + printf(fh, " // prim_mom_self: self primitive moments: mean flow velocity and thermal speed squared. ~%"), + printf(fh, " // m_other: mass of other species. ~%"), + printf(fh, " // moms_other: moments of the other distribution function. ~%"), + printf(fh, " // prim_mom_other: cross primitive moments: mean flow velocity and thermal speed squared. ~%"), printf(fh, " // boundary_corrections: corrections to momentum and energy conservation due to finite velocity space. ~%"), - printf(fh, " // nu: Collision frequency. ~%"), + printf(fh, " // nu: Cross-species collision frequency. ~%"), printf(fh, " ~%"), + printf(fh, " const double m_sumDms = (m_self+m_other)/m_self;~%"), + /* Create pointers to u and vtsq of each species. */ printf(fh, " const double *u_self = &prim_mom_self[~a];~%", 0*numB), printf(fh, " const double *vtsq_self = &prim_mom_self[~a];~%", udim*numB), @@ -115,6 +124,13 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( ), printf(fh, " ~%") ), + /* Also check alpha_E. */ + alphaE_c : makelist(alphaE[i-1],i,1,numB), + alphaE_e : doExpand(alphaE_c, basis), + alphaECorners : gcfac(float(fullratsimp(evAtNodes(alphaE_e,nodes,vars)))), + for i : 1 thru length(nodes) do ( + printf(fh, " if (notCellAvg && (~a < 0)) notCellAvg = false; ~%", alphaECorners[i]) + ), printf(fh, " if (notCellAvg) { ~%"), /* Use the original expansion polynomial. */ @@ -169,13 +185,11 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( printf(fh, " ~%"), /* Expansion in configuration space basis and coefficients - of m0, m2 and the Greene factor. */ - m0_c : makelist(m0r[i-1],i,1,numB), - m2_c : makelist(m2r[i-1],i,1,numB), - m0_e : doExpand(m0_c, basis), - m2_e : doExpand(m2_c, basis), - greene_c : makelist(greene[i-1],i,1,numB), - greene_e : doExpand(greene_c, basis), + of m0 and m2. */ + m0_c : makelist(m0r[i-1],i,1,numB), + m2_c : makelist(m2r[i-1],i,1,numB), + m0_e : doExpand(m0_c, basis), + m2_e : doExpand(m2_c, basis), /* Equivalently for vtSq .*/ vtsq_self_c : makelist(vtsq_self[i-1],i,1,numB), vtsq_other_c : makelist(vtsq_other[i-1],i,1,numB), @@ -256,7 +270,7 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( printf(fh, " ~%"), /*....... Matrix block corresponding to RHS of momentum equation .......*/ - expr : calcInnerProdList(vars,1,basis,2*m1_e - greene_e*(u_self_e - u_other_e)), + expr : calcInnerProdList(vars,1,basis,2*m1_e - alphaE_e*m_sumDms*(u_self_e - u_other_e)), for i : 1 thru numB do ( printf(fh, " ~a += ~a; ~%", momRHS[(vd-1)*numB+i-1], float(expr[i])) ), @@ -336,9 +350,8 @@ calcCrossPrimMomsLBO(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( printf(fh, " } ~%"), printf(fh, " ~%"), - printf(fh, " double m_sum = ~a;~%",m_self + m_other), printf(fh, " double m_diff = ~a;~%",m_other - m_self), - enRHS1_c : calcInnerProdList(vars,greene_e/m_sum,basis, + enRHS1_c : calcInnerProdList(vars,alphaE_e/m_self,basis, vDegFreedom*(m_other*vtsq_other_e - m_self*vtsq_self_e) + 0.5*m_diff*uSumSq_e), enRHS2_c : calcInnerProdList(vars,1,basis,2*m2_e - uM1Self_e - uM1Other_e), enRHS_c : enRHS1_c + enRHS2_c, diff --git a/maxima/g0/prim_moments/ms-gkCrossPrimMomsLBO.mac b/maxima/g0/prim_moments/ms-gkCrossPrimMomsLBO.mac index a95245d4..077212c1 100644 --- a/maxima/g0/prim_moments/ms-gkCrossPrimMomsLBO.mac +++ b/maxima/g0/prim_moments/ms-gkCrossPrimMomsLBO.mac @@ -14,9 +14,9 @@ maxCdim_Ser : 3$ /* Note that Serendipity, p = 1, is equivalent to Tensor */ /* Thus no need to calculate p = 1 Tensor basis */ minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ minCdim_Tensor : 1$ -maxCdim_Tensor : 2$ +maxCdim_Tensor : 0$ /* Vdim possibilities for each of Cdim=[1,2,3]. */ gkVdims : [[1,2], [2], [2]]$ diff --git a/maxima/g0/prim_moments/ms-gkPrimMoments-header.mac b/maxima/g0/prim_moments/ms-gkPrimMoments-header.mac index 1db923fb..ecb89234 100644 --- a/maxima/g0/prim_moments/ms-gkPrimMoments-header.mac +++ b/maxima/g0/prim_moments/ms-gkPrimMoments-header.mac @@ -56,7 +56,7 @@ for bInd : 1 thru length(bName) do ( printf(fh, "GKYL_CU_DH void gyrokinetic_self_prim_moments_~ax~av_~a_p~a(struct gkyl_mat *A, struct gkyl_mat *rhs,~% const double *moms, const double *boundary_corrections, const double *nu); ~%", ci, vi, bName[bInd], pi), /* Primitive moments for cross-collision GkLBO terms. */ - printf(fh, "GKYL_CU_DH void gyrokinetic_cross_prim_moments_~ax~av_~a_p~a(struct gkyl_mat *A, struct gkyl_mat *rhs,~% const double *greene, const double m_self, const double *moms_self, const double *prim_mom_self,~% const double m_other, const double *moms_other, const double *prim_mom_other,~% const double *boundary_corrections, const double *nu); ~%", ci, vi, bName[bInd], pi), + printf(fh, "GKYL_CU_DH void gyrokinetic_cross_prim_moments_~ax~av_~a_p~a(struct gkyl_mat *A, struct gkyl_mat *rhs,~% const double *alphaE, const double m_self, const double *moms_self, const double *prim_mom_self,~% const double m_other, const double *moms_other, const double *prim_mom_other,~% const double *boundary_corrections, const double *nu); ~%", ci, vi, bName[bInd], pi), printf(fh, "~%") ) diff --git a/maxima/g0/twist_shift_calc/twistShift-calc.mac b/maxima/g0/twist_shift_calc/twistShift-calc.mac index 868f546d..097320c4 100644 --- a/maxima/g0/twist_shift_calc/twistShift-calc.mac +++ b/maxima/g0/twist_shift_calc/twistShift-calc.mac @@ -41,7 +41,7 @@ for bInd : 1 thru length(bName) do ( print("pOrder = ",pOrder), vStr : "", if (v>0) then (vStr: sconcat(v,"v")), - fname : sconcat("~/max-out/bc_twistshift_gyrokinetic_", bName[bInd], "_", c, "x", vStr, "_p", pOrder, ".c"), + fname : sconcat("/home/akash/max-out/bc_twistshift_gyrokinetic_", bName[bInd], "_", c, "x", vStr, "_p", pOrder, ".c"), fh : openw(fname), disp(printf(false,sconcat("Creating ~ax", vStr, "P~a ", bName[bInd]),c,pOrder)), From 1ae09b7f7ad470fe270a175f645dacdffb375a8a Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 27 Apr 2026 15:20:50 -0400 Subject: [PATCH 60/66] checkout origin/main of some files that got lost --- .../gkCrossPrimMomsBGKFuncs.mac | 111 -- .../ms-gkCrossPrimMomsBGK-header.mac | 67 - .../cross_prim_moms/ms-gkCrossPrimMomsBGK.mac | 49 - .../ms-gkCrossPrimMomsBGKHeader.mac | 66 - provable-algorithms/code_generator_core.rkt | 1012 ------------ provable-algorithms/code_generator_vector.rkt | 1383 ----------------- .../gkyl_code_generator_lax.rkt | 1282 --------------- .../gkyl_code_generator_lax_vector.rkt | 1305 ---------------- .../gkyl_code_generator_roe.rkt | 1261 --------------- .../gkyl_code_generator_roe_vector.rkt | 1335 ---------------- .../gkyl_test_inviscid_burgers.rkt | 275 ---- .../gkyl_test_isothermal_euler_mom_x.rkt | 339 ---- .../gkyl_test_isothermal_euler_mom_yz.rkt | 333 ---- provable-algorithms/gkyl_test_limiters.rkt | 219 --- .../gkyl_test_linear_advection.rkt | 276 ---- .../gkyl_test_maxwell_1d_Bx_psi.rkt | 339 ---- .../gkyl_test_maxwell_1d_Ex_phi.rkt | 339 ---- .../gkyl_test_maxwell_1d_Ey_Bz.rkt | 339 ---- .../gkyl_test_maxwell_1d_Ez_By.rkt | 339 ---- provable-algorithms/prover_core.rkt | 919 ----------- provable-algorithms/prover_vector.rkt | 1052 ------------- provable-algorithms/test_inviscid_burgers.rkt | 217 --- .../test_isothermal_euler_mom_x.rkt | 282 ---- .../test_isothermal_euler_mom_yz.rkt | 276 ---- provable-algorithms/test_limiters.rkt | 177 --- provable-algorithms/test_linear_advection.rkt | 218 --- .../test_maxwell_1d_Bx_psi.rkt | 282 ---- .../test_maxwell_1d_Ex_phi.rkt | 282 ---- provable-algorithms/test_maxwell_1d_Ey_Bz.rkt | 282 ---- provable-algorithms/test_maxwell_1d_Ez_By.rkt | 282 ---- 30 files changed, 14938 deletions(-) delete mode 100644 maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac delete mode 100644 maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac delete mode 100644 maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac delete mode 100644 maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGKHeader.mac delete mode 100644 provable-algorithms/code_generator_core.rkt delete mode 100644 provable-algorithms/code_generator_vector.rkt delete mode 100644 provable-algorithms/gkyl_code_generator_lax.rkt delete mode 100644 provable-algorithms/gkyl_code_generator_lax_vector.rkt delete mode 100644 provable-algorithms/gkyl_code_generator_roe.rkt delete mode 100644 provable-algorithms/gkyl_code_generator_roe_vector.rkt delete mode 100644 provable-algorithms/gkyl_test_inviscid_burgers.rkt delete mode 100644 provable-algorithms/gkyl_test_isothermal_euler_mom_x.rkt delete mode 100644 provable-algorithms/gkyl_test_isothermal_euler_mom_yz.rkt delete mode 100644 provable-algorithms/gkyl_test_limiters.rkt delete mode 100644 provable-algorithms/gkyl_test_linear_advection.rkt delete mode 100644 provable-algorithms/gkyl_test_maxwell_1d_Bx_psi.rkt delete mode 100644 provable-algorithms/gkyl_test_maxwell_1d_Ex_phi.rkt delete mode 100644 provable-algorithms/gkyl_test_maxwell_1d_Ey_Bz.rkt delete mode 100644 provable-algorithms/gkyl_test_maxwell_1d_Ez_By.rkt delete mode 100644 provable-algorithms/prover_core.rkt delete mode 100644 provable-algorithms/prover_vector.rkt delete mode 100644 provable-algorithms/test_inviscid_burgers.rkt delete mode 100644 provable-algorithms/test_isothermal_euler_mom_x.rkt delete mode 100644 provable-algorithms/test_isothermal_euler_mom_yz.rkt delete mode 100644 provable-algorithms/test_limiters.rkt delete mode 100644 provable-algorithms/test_linear_advection.rkt delete mode 100644 provable-algorithms/test_maxwell_1d_Bx_psi.rkt delete mode 100644 provable-algorithms/test_maxwell_1d_Ex_phi.rkt delete mode 100644 provable-algorithms/test_maxwell_1d_Ey_Bz.rkt delete mode 100644 provable-algorithms/test_maxwell_1d_Ez_By.rkt diff --git a/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac b/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac deleted file mode 100644 index 318dbbf9..00000000 --- a/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac +++ /dev/null @@ -1,111 +0,0 @@ -/* Generate kernels for the updater that computes the cross primitive moments - upar_ei and vtsq_ei (or upar_ie and vtsq_ie) used in the cross collision - terms, given the moments of electrons and ions. - Weak division and multiplication are employed. */ - -load("modal-basis"); -load("out-scripts"); -load("nodal_operations/nodal_functions"); -load(stringproc)$ -fpprec : 24$ - -calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( - [varsC, bC, NC], - - /* Load basis of dimensionality requested. */ - [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), - - /* Number of basis monomials. */ - NC : length(bC), - - print("gk ", cdim,"x", vdim, "v", polyOrder, "p"), - - /* Include the header files. */ - printf(fh, "#include ~%"), - printf(fh, "#include ~%"), - printf(fh, "#include ~%", basisFun, cdim, polyOrder), - printf(fh, " ~%"), - - /* Function declaration with input/output variables. */ - printf(fh, "GKYL_CU_DH void ~a(const double delta_sr, const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, double *prim_moms_cross) ~%{ ~%", funcNm), - printf(fh, " // delta_sr: Free parameter in relation between nu_sr and alpha_E. ~%"), - printf(fh, " // betaGreenep1: Greene's beta + 1. ~%"), - printf(fh, " // m_self: mass of this species. ~%"), - printf(fh, " // prim_moms_self: primitive moments of this species. ~%"), - printf(fh, " // m_other: mass of other species. ~%"), - printf(fh, " // prim_moms_other: primitive moments of other species. ~%"), - printf(fh, " // prim_moms_cross: cross primitive moments. ~%"), - printf(fh, " ~%"), - - printf(fh, " const double m_s = m_self; ~%"), - printf(fh, " const double m_r = m_other; ~%"), - /* Create pointers to the moments of each species. */ - printf(fh, " const double *n_s = &prim_moms_self[~a]; ~%", 0), - printf(fh, " const double *upar_s = &prim_moms_self[~a]; ~%", NC), - printf(fh, " const double *vtsq_s = &prim_moms_self[~a]; ~%", NC*2), - printf(fh, " const double *n_r = &prim_moms_other[~a]; ~%", 0), - printf(fh, " const double *upar_r = &prim_moms_other[~a]; ~%", NC), - printf(fh, " const double *vtsq_r = &prim_moms_other[~a]; ~%", NC*2), - printf(fh, " ~%"), - /* Create pointers to the cross moments. */ - printf(fh, " double *n_sr = &prim_moms_cross[~a]; ~%", 0), - printf(fh, " double *upar_sr = &prim_moms_cross[~a]; ~%", NC*1), - printf(fh, " double *vtsq_sr = &prim_moms_cross[~a]; ~%", NC*2), - printf(fh, "~%"), - - /* Calculate cross density n_sr. */ - for i : 1 thru NC do ( - printf(fh, " n_sr[~a] = n_s[~a]; ~%", i-1, i-1) - ), - printf(fh, " ~%"), - - /* Calculate cross parallel velocity upar_sr. */ - printf(fh, " const double deltaTbetap1 = delta_sr*betaGreenep1;~%"), - printf(fh, " ~%"), - - printf(fh, " double dUpar[~a]; ~%", NC), - for i : 1 thru NC do ( - printf(fh, " dUpar[~a] = upar_r[~a] - upar_s[~a]; ~%", i-1, i-1, i-1) - ), - for i : 1 thru NC do ( - printf(fh, " upar_sr[~a] = upar_s[~a] + 0.5*deltaTbetap1*dUpar[~a]; ~%", i-1, i-1, i-1) - ), - printf(fh, " ~%"), - - /* Calculate cross thermal velocity square vtsq_sr. */ - printf(fh, " const double vdimPhys = ~a; ~%", (vdim-1)*2+1), - printf(fh, " const double mSum = m_self + m_other;~%"), - printf(fh, " ~%"), - - printf(fh, " double dTemp[~a] = {0.0}; ~%", NC), - for i : 1 thru NC do ( - printf(fh, " dTemp[~a] = vdimPhys * (m_r*vtsq_r[~a]-m_s*vtsq_s[~a]); ~%", i-1, i-1, i-1) - ), - - printf(fh, " double dUparSq[~a] = {0.0}; ~%", NC), - printf(fh, " binop_mul_~ad_~a_p~a(dUpar, dUpar, dUparSq); ~%", cdim, basisFun, polyOrder), - - printf(fh, " const double dUparSq_fac = (m_r-0.25*deltaTbetap1*mSum/vdimPhys);~%"), - for i : 1 thru NC do ( - printf(fh, " vtsq_sr[~a] = vtsq_s[~a] + deltaTbetap1/(vdimPhys*mSum)*(dTemp[~a]+dUparSq_fac*dUparSq[~a]); ~%", i-1, i-1, i-1, i-1) - ), - printf(fh, " ~%"), - - /* Turn collisions off when vtsq_sr is not positive-definite. */ - printf(fh, " // If vtsq_sr is negative at a corner, turn off collisions.~%"), - printf(fh, " bool negative_cross_temp = false; ~%"), - nodes : getNodes(basisFun, cdim, 1), - vtsq_sr_e : doExpand1(vtsq_sr,bC), - vtsq_sr_corners : gcfac(float(fullratsimp( evAtNodes(vtsq_sr_e,nodes,varsC) ))), - for i : 1 thru length(nodes) do ( - printf(fh, " if (~a < 0.0) negative_cross_temp = true; ~%", vtsq_sr_corners[i]) - ), - printf(fh, " if (negative_cross_temp) { ~%"), - for j : 1 thru NC do ( - printf(fh, " upar_sr[~a] = upar_s[~a]; ~%", j-1, j-1), - printf(fh, " vtsq_sr[~a] = vtsq_s[~a]; ~%", j-1, j-1) - ), - printf(fh, " } ~%"), - - printf(fh, "} ~%") -)$ diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac deleted file mode 100644 index 752a42c8..00000000 --- a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac +++ /dev/null @@ -1,67 +0,0 @@ -load("cross_prim_moms/gkCrossPrimMomsBGKFuncs")$ -load(stringproc)$ - -/* Generate a header file for cross primitive moments kernels in the GkBGK. */ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 1$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor order basis. No need to generate p=1. */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ - -/* Vdim possibilities for each of Cdim=[1,2,3]. */ -gkVdims : [[1,2], [2], [2]]$ - -/* ...... END OF USER INPUTS........ */ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -printPrototypeGK(deco, ci, vi, bStr, pi) := block([si], - printf(fh, "~avoid gyrokinetic_cross_prim_moms_bgk_~ax~av_~a_p~a(const double delta_sr, const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, double *prim_moms_cross); ~%", deco, ci, vi, bStr, pi), - printf(fh, "~%") -)$ - -fh : openw("~/max-out/gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h")$ -printf(fh, "#pragma once ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, " ~%")$ -printf(fh, "EXTERN_C_BEG ~%")$ -printf(fh, "~%")$ - -decorator : "GKYL_CU_DH "$ - -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - - printPrototypeGK(decorator, c, v, bName[bInd], polyOrder) - - ) - ) - ) -); - -printf(fh, "EXTERN_C_END ~%")$ -close(fh)$ - -/* gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h */ diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac deleted file mode 100644 index 834a14f2..00000000 --- a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac +++ /dev/null @@ -1,49 +0,0 @@ -load("cross_prim_moms/gkCrossPrimMomsBGKFuncs")$ -load(stringproc)$ - -/* Generate a header file for cross moment kernels in the GkBGK. */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 1$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ - -/* Tensor order basis. No need to generate p=1. */ -minPolyOrder_Tensor : 2$ -maxPolyOrder_Tensor : 0$ -minCdim_Tensor : 1$ -maxCdim_Tensor : 0$ - -/* Vdim possibilities for each of Cdim=[1,2,3]. */ -gkVdims : [[1,2], [2], [2]]$ - -/* ...... END OF USER INPUTS........ */ - -/* To generate other bases, just add corresponding column to arrays below. */ -bName : ["ser", "tensor"]$ -minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ -maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ -minCdim : [minCdim_Ser, minCdim_Tensor]$ -maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ - -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - for gkV : 1 thru length(gkVdims[c]) do ( - v : gkVdims[c][gkV], - - maxPolyOrderB : maxPolyOrder[bInd], - if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ - for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( - - fname : sconcat("~/max-out/gyrokinetic_cross_prim_moms_bgk_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), - fh : openw(fname), - funcName : sconcat("gyrokinetic_cross_prim_moms_bgk_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), - calcGKCrossPrimMomsBGK(fh, funcName, c, v, bName[bInd], polyOrder), - close(fh) - ) - ) - ) -); - -/* gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h */ diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGKHeader.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGKHeader.mac deleted file mode 100644 index 2422988a..00000000 --- a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGKHeader.mac +++ /dev/null @@ -1,66 +0,0 @@ -load("cross_prim_moms/gkCrossPrimMomsBGKFuncs")$ -load(stringproc)$ - -/* Generate a header file for cross primitive moments kernels in the GkBGK. */ - -/* ...... USER INPUTS........ */ - -/* Serendipity basis. */ -minPolyOrder_Ser : 1$ -maxPolyOrder_Ser : 2$ -minCdim_Ser : 1$ -maxCdim_Ser : 3$ -minVdim_Ser : 1$ -maxVdim_Ser : 3$ -minGkVdim_Ser : 1$ -maxGkVdim_Ser : 2$ - - -/* ...... END OF USER INPUTS........ */ - -bName : ["ser"]$ -minPolyOrder : [minPolyOrder_Ser]$ -maxPolyOrder : [maxPolyOrder_Ser]$ -minCdim : [minCdim_Ser]$ -maxCdim : [maxCdim_Ser]$ -minVdim : [minVdim_Ser]$ -maxVdim : [maxVdim_Ser]$ -minGkVdim : [minGkVdim_Ser]$ -maxGkVdim : [maxGkVdim_Ser]$ - -printPrototypeGK(deco, ci, vi, bStr, pi) := block([si], - printf(fh, "~avoid gyrokinetic_cross_prim_moms_bgk_~ax~av_~a_p~a(const double beta, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, const double *nu_sr, const double *nu_rs, double *prim_moms_cross); ~%", deco, ci, vi, bStr, pi), - printf(fh, "~%") -)$ - -fh : openw("~/max-out/cross_prim_moms/gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h")$ -printf(fh, "#pragma once ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, "#include ~%")$ -printf(fh, " ~%")$ -printf(fh, "EXTERN_C_BEG ~%")$ -printf(fh, "~%")$ - -decorator : "GKYL_CU_DH "$ -for bInd : 1 thru length(bName) do ( - for c : minCdim[bInd] thru maxCdim[bInd] do ( - minPolyOrderB : minPolyOrder[bInd], - maxPolyOrderB : maxPolyOrder[bInd], - if c=1 then ( - for vgk : minGkVdim[bInd] thru maxGkVdim[bInd] do ( - for polyOrder : minPolyOrderB thru maxPolyOrderB do ( - printPrototypeGK(decorator, c, vgk, bName[bInd], polyOrder) - ) - ) - ) else ( - for polyOrder : minPolyOrderB thru maxPolyOrderB do ( - printPrototypeGK(decorator, c, 2, bName[bInd], polyOrder) - ) - ) - ) -); -printf(fh, "EXTERN_C_END ~%")$ -close(fh)$ - -/* gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h */ diff --git a/provable-algorithms/code_generator_core.rkt b/provable-algorithms/code_generator_core.rkt deleted file mode 100644 index 19608fa7..00000000 --- a/provable-algorithms/code_generator_core.rkt +++ /dev/null @@ -1,1012 +0,0 @@ -#lang racket - -(require "prover_core.rkt") -(provide convert-expr - remove-bracketed-expressions - remove-bracketed-expressions-from-file - flux-substitute - generate-lax-friedrichs-scalar-1d - generate-lax-friedrichs-scalar-1d-second-order - generate-roe-scalar-1d - generate-roe-scalar-1d-second-order) - -;; Lightweight converter from Racket expressions (expr) into strings representing equivalent C code. -(define (convert-expr expr) - (match expr - ;; If expr is a symbol, then convert it directly to a string. - [(? symbol? symb) (symbol->string symb)] - - ;; If expr is a numerical constant, then convert it directly to a string. - [(? number? num) (number->string num)] - - ;; If expr is a sum of the form (+ expr1 expr2 ...), then convert it to "(expr1 + expr2 + ...)" in C. - [`(+ . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " + ") ")"))] - ;; Likewise for differences. - [`(- . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " - ") ")"))] - - ;; If expr is a product of the form (* expr1 expr2 ...), then convert it to "(expr1 * expr2 * ...)" in C. - [`(* . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " * ") ")"))] - ;; Likewise for quotients. - [`(/ . ,terms) - (let ([c-terms (map convert-expr terms)]) - (string-append "(" (string-join c-terms " / ") ")"))] - - ;; If expr is an absolute value of the form (abs expr1), then convert it to "fabs(expr1)" in C. - [`(abs ,arg) - (format "fabs(~a)" (convert-expr arg))] - - ;; If expr is a square root of the form (sqrt expr1), then convert it to "sqrt(expr1)" in C. - [`(sqrt ,arg) - (format "sqrt(~a)" (convert-expr arg))] - - ;; If expr is a maximum of the form (max expr1 expr2), then convert it to "fmax(expr1, expr2)" in C. - [`(max ,arg1 ,arg2) - (format "fmax(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a maximum of the form (max expr1 expr2 expr2), then convert it to "fmax(expr1, expr2, expr3)" in C. - [`(max ,arg1 ,arg2 ,arg3) - (format "fmax3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] - - ;; If expr is a minimum of the form (max expr1 expr2), then convert it to "fmin(expr1, expr2)" in C. - [`(min ,arg1 ,arg2) - (format "fmin(~a, ~a)" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a minimum of the form (max expr1 expr2 expr2), then convert it to "fmin(expr1, expr2, expr3)" in C. - [`(min ,arg1 ,arg2 ,arg3) - (format "fmin3(~a, ~a, ~a)" (convert-expr arg1) (convert-expr arg2) (convert-expr arg3))] - - ;; If expr is a variable assignment of the form (define expr1 expr2), then convert it to "expr1 = expr2" in C. - [`(define ,arg1 ,arg2) - (format "~a = ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a strict comparison of the form (< expr1 expr2), then convert it to "expr1 < expr2" in C. - [`(< ,arg1 ,arg2) - (format "~a < ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a comparison of the form (<= expr1 expr2), then convert it to "expr1 <= expr2" in C. - [`(<= ,arg1 ,arg2) - (format "~a <= ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a strict comparison of the form (> expr1 expr2), then convert it to "expr1 > expr2" in C. - [`(> ,arg1 ,arg2) - (format "~a > ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a comparison of the form (>= expr1 expr2), then convert it to "expr1 >= expr2" in C. - [`(>= ,arg1 ,arg2) - (format "~a >= ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is an equality comparison of the form (equal? expr1 expr2), then convert it to "expr1 == expr2" in C. - [`(equal? ,arg1 ,arg2) - (format "~a == ~a" (convert-expr arg1) (convert-expr arg2))] - - ;; If expr is a conditional of the form [(cond [cond1 expr1] [else expr2])], then convert it to the ternary operator "(cond1) ? expr1 : expr2" in C. - [`(cond - [,cond1 ,expr1] - [else ,expr2]) - (format "(~a) ? ~a : ~a" (convert-expr cond1) (convert-expr expr1) (convert-expr expr2))])) - -;; A simple boilerplate function for removing bracketed expressions from strings. -(define (remove-bracketed-expressions str) - (regexp-replace* #rx"\\[.*?\\]" str "")) - -;; A simple boilerplate function for removing bracketed expressions from files. -(define (remove-bracketed-expressions-from-file output-file) - (define content - (with-input-from-file output-file - (lambda () - (port->string (current-input-port))))) - (define cleaned - (remove-bracketed-expressions content)) - (with-output-to-file output-file #:exists 'replace - (lambda () - (display cleaned)))) - -(define (flux-substitute flux-expr cons-expr var-name) - (string-replace flux-expr cons-expr var-name)) - -;; ------------------------------------------------------------- -;; Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE -;; ------------------------------------------------------------- -(define (generate-lax-friedrichs-scalar-1d pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define flux-um (flux-substitute flux-code cons-code "um")) - (define flux-ui (flux-substitute flux-code cons-code "ui")) - (define flux-up (flux-substitute flux-code cons-code "up")) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR SCALAR PDE: ~a -// Lax–Friedrichs first-order finite-difference solver for a scalar PDE in 1D. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * sizeof(double)); - double *un = (double*) malloc((nx + 2) * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[i] = ~a; // init-func in C. - } - - double t = 0.0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable. - for (int i = 1; i <= nx; i++) { - double um = u[i - 1]; - double ui = u[i]; - double up = u[i + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um = ~a; // f(u_{i - 1}). - double f_ui = ~a; // f(u_i). - double f_up = ~a; // f(u_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * alpha * (u_i - u_{i - 1}). - double fluxL = 0.5 * (f_um + f_ui) - 0.5 * alpha * (ui - um); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * alpha * (u_{i + 1} - u_i). - double fluxR = 0.5 * (f_ui + f_up) - 0.5 * alpha * (up - ui); - - // Update the conserved variable. - un[i] = ui - (dt / dx) * (fluxR - fluxL); - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - u[i] = un[i]; - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[1]; - u[nx + 1] = u[nx]; - - // Increment time. - t += dt; - } - - // Output solution to stdout. - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - printf(\"%g %g\\n\", x, u[i]); - } - - free(u); - free(un); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - ;; Expression for local wave-speed estimate. - max-speed-local - ;; Left flux f(u_{i - 1}). - flux-um - ;; Middle flux f(u_i). - flux-ui - ;; Right flux f(u_{i + 1}). - flux-up - )) - code) - -;; ---------------------------------------------------------------------------------------------------- -;; Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE with a Second-Order Flux Extrapolation -;; ---------------------------------------------------------------------------------------------------- -(define (generate-lax-friedrichs-scalar-1d-second-order pde limiter - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method with a second-order flux extrapolation using flux limiter `limiter`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umL (flux-substitute flux-code cons-code "umL")) - (define flux-umR (flux-substitute flux-code cons-code "umR")) - (define flux-uiL (flux-substitute flux-code cons-code "uiL")) - (define flux-uiR (flux-substitute flux-code cons-code "uiR")) - (define flux-upL (flux-substitute flux-code cons-code "upL")) - (define flux-upR (flux-substitute flux-code cons-code "upR")) - - (define flux-umR-evol (flux-substitute flux-code cons-code "umR_evol")) - (define flux-uiL-evol (flux-substitute flux-code cons-code "uiL_evol")) - (define flux-uiR-evol (flux-substitute flux-code cons-code "uiR_evol")) - (define flux-upL-evol (flux-substitute flux-code cons-code "upL_evol")) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Lax–Friedrichs first-order finite-difference solver for a scalar PDE in 1D, with a second-order flux extrapolation. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Array for storing slopes. - double *slope = (double*) malloc((nx + 4) * sizeof(double)); - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * sizeof(double)); - double *un = (double*) malloc((nx + 4) * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[i] = ~a; // init-func in C. - } - - double t = 0.0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - double r = (u[i] - u[i - 1]) / (u[i + 1] - u[i]); - double limiter = ~a; // limiter-r in C. - - slope[i] = limiter * (0.5 * ((u[i] - u[i - 1]) + (u[i + 1] - u[i]))); - } - - // Compute fluxes with Lax-Friedrichs approximation (with a second-order flux extrapolation) and update the conserved variable. - for (int i = 2; i <= nx + 1; i++) { - // Extrapolate boundary states. - double umL = u[i - 1] - (0.5 * slope[i - 1]); - double umR = u[i - 1] + (0.5 * slope[i - 1]); - - double uiL = u[i] - (0.5 * slope[i]); - double uiR = u[i] + (0.5 * slope[i]); - - double upL = u[i + 1] - (0.5 * slope[i + 1]); - double upR = u[i + 1] + (0.5 * slope[i + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL = ~a; - double f_umR = ~a; - - double f_uiL = ~a; - double f_uiR = ~a; - - double f_upL = ~a; - double f_upR = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol = umR + ((dt / (2.0 * dx)) * (f_umL - f_umR)); - - double uiL_evol = uiL + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); - double uiR_evol = uiR + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); - - double upL_evol = upL + ((dt / (2.0 * dx)) * (f_upL - f_upR)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol = ~a; - double f_uiL_evol = ~a; - - double f_uiR_evol = ~a; - double f_upL_evol = ~a; - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * alpha * (u_{i, L+} - u_{i - 1, R+}). - double fluxL = 0.5 * (f_umR_evol + f_uiL_evol) - 0.5 * alpha * (uiL_evol - umR_evol); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * alpha * (u_{i + 1, L+} - u_{i, R+}). - double fluxR = 0.5 * (f_uiR_evol + f_upL_evol) - 0.5 * alpha * (upL_evol - uiR_evol); - - // Update the conserved variable. - un[i] = u[i] - (dt / dx) * (fluxR - fluxL); - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - u[i] = un[i]; - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[2]; - u[1] = u[2]; - u[nx + 2] = u[nx + 1]; - u[nx + 3] = u[nx + 1]; - - // Increment time. - t += dt; - } - - // Output solution to stdout. - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - printf(\"%g %g\\n\", x, u[i]); - } - - free(u); - free(un); - free(slope); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - ;; Expression for local wave-speed estimate. - max-speed-local - ;; Expression for flux limiter function. - limiter-r - ;; Left negative flux f(u_{i - 1, L}). - flux-umL - ;; Right negative flux f(u_{i - 1, R}). - flux-umR - ;; Left central flux f(u_{i, L}). - flux-uiL - ;; Right central flux f(u_{i, R}). - flux-uiR - ;; Left positive flux f(u_{i + 1, L}). - flux-upL - ;; Right positive flux f(u_{i + 1, R}). - flux-upR - ;; Evolved right negative flux f(u_{i - 1, R+}). - flux-umR-evol - ;; Evolved left central flux f(u_{i, L+}). - flux-uiL-evol - ;; Evolved right central flux f(u_{i, R+}). - flux-uiR-evol - ;; Evolved left positive flux f(u_{i + 1, L+}). - flux-upL-evol - )) - code) - -;; ---------------------------------------------- -;; Roe (Finite-Volume) Solver for a 1D Scalar PDE -;; ---------------------------------------------- -(define (generate-roe-scalar-1d pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define flux-deriv-code (convert-expr flux-deriv)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define flux-um (flux-substitute flux-code cons-code "um")) - (define flux-ui (flux-substitute flux-code cons-code "ui")) - (define flux-up (flux-substitute flux-code cons-code "up")) - - (define flux-deriv-um (flux-substitute flux-deriv-code cons-code "um")) - (define flux-deriv-ui (flux-substitute flux-deriv-code cons-code "ui")) - (define flux-deriv-up (flux-substitute flux-deriv-code cons-code "up")) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR SCALAR PDE: ~a -// Roe higher-order finite-volume solver for a scalar PDE in 1D. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * sizeof(double)); - double *un = (double*) malloc((nx + 2) * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[i] = ~a; // init-func in C. - } - - double t = 0.0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Roe approximation and update the conserved variable. - for (int i = 1; i <= nx; i++) { - double um = u[i - 1]; - double ui = u[i]; - double up = u[i + 1]; - - // Evaluate flux for each value of the conserved variable. - double f_um = ~a; // f(u_{i - 1}). - double f_ui = ~a; // f(u_i). - double f_up = ~a; // f(u_{i + 1}). - - // Evaluate flux derivative for each value of the conserved variable. - double f_deriv_um = ~a; // f'(u_{i - 1}). - double f_deriv_ui = ~a; // f'(u_i). - double f_deriv_up = ~a; // f'(u_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1}) + f(u_i)) - 0.5 * |aL_roe| * (u_i - u_{i - 1}). - double aL_roe = 0.5 * (f_deriv_um + f_deriv_ui); - double fluxL = 0.5 * (f_um + f_ui) - 0.5 * fabs(aL_roe) * (ui - um); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1}) + f(u_i)) - 0.5 * |aR_roe| * (u_{i + 1} - u_i). - double aR_roe = 0.5 * (f_deriv_ui + f_deriv_up); - double fluxR = 0.5 * (f_ui + f_up) - 0.5 * fabs(aR_roe) * (up - ui); - - // Update the conserved variable. - un[i] = ui - (dt / dx) * (fluxR - fluxL); - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 1; i++) { - u[i] = un[i]; - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[1]; - u[nx + 1] = u[nx]; - - // Increment time. - t += dt; - } - - // Output solution to stdout. - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - printf(\"%g %g\\n\", x, u[i]); - } - - free(u); - free(un); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - ;; Expression for local wave-speed estimate. - max-speed-local - ;; Left flux f(u_{i - 1}). - flux-um - ;; Middle flux f(u_i). - flux-ui - ;; Right flux f(u_{i + 1}). - flux-up - ;; Left flux derivative f'(u_{i - 1}). - flux-deriv-um - ;; Middle flux derivative f'(u_i). - flux-deriv-ui - ;; Right flux derivative f'(u_{i + 1}). - flux-deriv-up - )) - code) - -;; ------------------------------------------------------------------------------------- -;; Roe (Finite-Volume) Solver for a 1D Scalar PDE with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------- -(define (generate-roe-scalar-1d-second-order pde limiter - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate C code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method with a second-order flux extrapolation using flux limiter `limiter`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define flux-deriv-code (convert-expr flux-deriv)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umL (flux-substitute flux-code cons-code "umL")) - (define flux-umR (flux-substitute flux-code cons-code "umR")) - (define flux-uiL (flux-substitute flux-code cons-code "uiL")) - (define flux-uiR (flux-substitute flux-code cons-code "uiR")) - (define flux-upL (flux-substitute flux-code cons-code "upL")) - (define flux-upR (flux-substitute flux-code cons-code "upR")) - - (define flux-umR-evol (flux-substitute flux-code cons-code "umR_evol")) - (define flux-uiL-evol (flux-substitute flux-code cons-code "uiL_evol")) - (define flux-uiR-evol (flux-substitute flux-code cons-code "uiR_evol")) - (define flux-upL-evol (flux-substitute flux-code cons-code "upL_evol")) - - (define flux-deriv-umR-evol (flux-substitute flux-deriv-code cons-code "umR_evol")) - (define flux-deriv-uiL-evol (flux-substitute flux-deriv-code cons-code "uiL_evol")) - (define flux-deriv-uiR-evol (flux-substitute flux-deriv-code cons-code "uiR_evol")) - (define flux-deriv-upL-evol (flux-substitute flux-deriv-code cons-code "upL_evol")) - - (define max-speed-local (flux-substitute max-speed-code cons-code "u[i]")) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR SCALAR PDE: ~a -// FLUX LIMITER: ~a -// Roe higher-order finite-volume solver for a scalar PDE in 1D, with a second-order flux extrapolation. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Array for storing slopes. - double *slope = (double*) malloc((nx + 4) * sizeof(double)); - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * sizeof(double)); - double *un = (double*) malloc((nx + 4) * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[i] = ~a; // init-func in C. - } - - double t = 0.0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - double local_alpha = ~a; // max-speed-expr in C. - - if (local_alpha > alpha) { - alpha = local_alpha; - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - double r = (u[i] - u[i - 1]) / (u[i + 1] - u[i]); - double limiter = ~a; // limiter-r in C. - - slope[i] = limiter * (0.5 * ((u[i] - u[i - 1]) + (u[i + 1] - u[i]))); - } - - // Compute fluxes with Roe approximation and update the conserved variable. - for (int i = 2; i <= nx + 1; i++) { - // Extrapolate boundary states. - double umL = u[i - 1] - (0.5 * slope[i - 1]); - double umR = u[i - 1] + (0.5 * slope[i - 1]); - - double uiL = u[i] - (0.5 * slope[i]); - double uiR = u[i] + (0.5 * slope[i]); - - double upL = u[i + 1] - (0.5 * slope[i + 1]); - double upR = u[i + 1] + (0.5 * slope[i + 1]); - - // Evaluate flux for each extrapolated boundary state. - double f_umL = ~a; - double f_umR = ~a; - - double f_uiL = ~a; - double f_uiR = ~a; - - double f_upL = ~a; - double f_upR = ~a; - - // Evolve each extrapolated boundary state. - double umR_evol = umR + ((dt / (2.0 * dx)) * (f_umL - f_umR)); - - double uiL_evol = uiL + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); - double uiR_evol = uiR + ((dt / (2.0 * dx)) * (f_uiL - f_uiR)); - - double upL_evol = upL + ((dt / (2.0 * dx)) * (f_upL - f_upR)); - - // Evaluate flux for each value of the (evolved) conserved variable. - double f_umR_evol = ~a; - double f_uiL_evol = ~a; - - double f_uiR_evol = ~a; - double f_upL_evol = ~a; - - // Evaluate flux derivative for each value of the (evolved) conserved variable. - double f_deriv_umR_evol = ~a; - double f_deriv_uiL_evol = ~a; - - double f_deriv_uiR_evol = ~a; - double f_deriv_upL_evol = ~a; - - // Left interface flux: F_{i - 1/2} = 0.5 * (f(u_{i - 1, R+}) + f(u_{i, L+})) - 0.5 * |aL_roe| * (u_{i, L+} - u_{i - 1, R+}). - double aL_roe = 0.5 * (f_deriv_umR_evol + f_deriv_uiL_evol); - double fluxL = 0.5 * (f_umR_evol + f_uiL_evol) - 0.5 * fabs(aL_roe) * (uiL_evol - umR_evol); - - // Right interface flux: F_{i + 1/2} = 0.5 * (f(u_{i + 1, L+}) + f(u_{i, R+})) - 0.5 * |aR_roe| * (u_{i + 1, L+} - u_{i, R+}). - double aR_roe = 0.5 * (f_deriv_uiR_evol + f_deriv_upL_evol); - double fluxR = 0.5 * (f_uiR_evol + f_upL_evol) - 0.5 * fabs(aR_roe) * (upL_evol - uiR_evol); - - // Update the conserved variable. - un[i] = u[i] - (dt / dx) * (fluxR - fluxL); - } - - // Copy un -> u (updated conserved variables to new conserved variables). - for (int i = 0; i <= nx + 3; i++) { - u[i] = un[i]; - } - - // Apply simple boundary conditions (transmissive). - u[0] = u[2]; - u[1] = u[2]; - u[nx + 2] = u[nx + 1]; - u[nx + 3] = u[nx + 1]; - - // Increment time. - t += dt; - } - - // Output solution to stdout. - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - printf(\"%g %g\\n\", x, u[i]); - } - - free(u); - free(un); - free(slope); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expression (e.g. (x < 1.0) ? 1.0 : 0.0)). - init-func-code - ;; Expression for local wave-speed estimate. - max-speed-local - ;; Expression for flux limiter function. - limiter-r - ;; Left negative flux f(u_{i - 1, L}). - flux-umL - ;; Right negative flux f(u_{i - 1, R}). - flux-umR - ;; Left central flux f(u_{i, L}). - flux-uiL - ;; Right central flux f(u_{i, R}). - flux-uiR - ;; Left positive flux f(u_{i + 1, L}). - flux-upL - ;; Right positive flux f(u_{i + 1, R}). - flux-upR - ;; Evolved right negative flux f(u_{i - 1, R+}). - flux-umR-evol - ;; Evolved left central flux f(u_{i, L+}). - flux-uiL-evol - ;; Evolved right central flux f(u_{i, R+}). - flux-uiR-evol - ;; Evolved left positive flux f(u_{i + 1, L+}). - flux-upL-evol - ;; Evolved right negative flux derivative f'(u_{i - 1, R+}). - flux-deriv-umR-evol - ;; Evolved left central flux derivative f'(u_{i, L+}). - flux-deriv-uiL-evol - ;; Evolved right central flux derivative f'(u_{i, R+}). - flux-deriv-uiR-evol - ;; Evolved left positive flux derivative f'(u_{i + 1, L+}). - flux-deriv-upL-evol - )) - code) \ No newline at end of file diff --git a/provable-algorithms/code_generator_vector.rkt b/provable-algorithms/code_generator_vector.rkt deleted file mode 100644 index d7fff704..00000000 --- a/provable-algorithms/code_generator_vector.rkt +++ /dev/null @@ -1,1383 +0,0 @@ -#lang racket - -(require "prover_core.rkt") -(require "prover_vector.rkt") -(require "code_generator_core.rkt") -(provide generate-lax-friedrichs-vector2-1d - generate-lax-friedrichs-vector2-1d-second-order - generate-roe-vector2-1d - generate-roe-vector2-1d-second-order) - -;; ---------------------------------------------------------------------------------- -;; Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; ---------------------------------------------------------------------------------- -(define (generate-lax-friedrichs-vector2-1d pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") - (list-ref cons-codes 1) "um[1]")) flux-codes)) - (define flux-uis (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") - (list-ref cons-codes 1) "ui[1]")) flux-codes)) - (define flux-ups (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") - (list-ref cons-codes 1) "up[1]")) flux-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a -// Lax–Friedrichs first-order finite-difference solver for a coupled vector system of 2 PDEs in 1D. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); - double *un = (double*) malloc((nx + 2) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - double *um = (double*) malloc(2 * sizeof(double)); - double *ui = (double*) malloc(2 * sizeof(double)); - double *up = (double*) malloc(2 * sizeof(double)); - - double *f_um = (double*) malloc(2 * sizeof(double)); - double *f_ui = (double*) malloc(2 * sizeof(double)); - double *f_up = (double*) malloc(2 * sizeof(double)); - - double *fluxL = (double*) malloc(2 * sizeof(double)); - double *fluxR = (double*) malloc(2 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - double t = 0.0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. - for (int i = 1; i <= nx; i++) { - for (int j = 0; j < 2; j++) { - um[j] = u[((i - 1) * 2) + j]; - ui[j] = u[(i * 2) + j]; - up[j] = u[((i + 1) * 2) + j]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um[0] = ~a; - f_um[1] = ~a; // F(U_{i - 1}). - - f_ui[0] = ~a; - f_ui[1] = ~a; // F(U_i). - - f_up[0] = ~a; - f_up[1] = ~a; // F(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * alpha * (U_i - U_{i - 1}). - for (int j = 0; j < 2; j++) { - fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * alpha * (ui[j] - um[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * alpha * (U_{i + 1} - U_i). - for (int j = 0; j < 2; j++) { - fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * alpha * (up[j] - ui[j]); - } - - // Update the conserved variable vector. - for (int j = 0; j < 2; j++) { - un[(i * 2) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j < 2; j++) { - u[(i * 2) + j] = un[(i * 2) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(1 * 2) + j]; - u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; - } - - // Increment time. - t += dt; - } - - // Output solution to stdout. - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - printf(\"%g %g %g\\n\", x, u[(i * 2) + 0], u[(i * 2) + 1]); - } - - free(u); - free(un); - - free(local_alpha); - - free(um); - free(ui); - free(up); - - free(f_um); - free(f_ui); - free(f_up); - - free(fluxL); - free(fluxR); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; Left flux vector F(u_{i - 1}). - (list-ref flux-ums 0) - (list-ref flux-ums 1) - ;; Middle flux vector F(u_i). - (list-ref flux-uis 0) - (list-ref flux-uis 1) - ;; Right flux vector F(u_{i + 1}). - (list-ref flux-ups 0) - (list-ref flux-ups 1) - )) - code) - -;; ------------------------------------------------------------------------------------------------------------------------- -;; Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs with a Second-Order Flux Extrapolation -;; ------------------------------------------------------------------------------------------------------------------------- -(define (generate-lax-friedrichs-vector2-1d-second-order pde-system limiter - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method with a - second-order flux extrapolation using flux limiter `limiter`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") - (list-ref cons-codes 1) "umL[1]")) flux-codes)) - (define flux-umRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") - (list-ref cons-codes 1) "umR[1]")) flux-codes)) - (define flux-uiLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") - (list-ref cons-codes 1) "uiL[1]")) flux-codes)) - (define flux-uiRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") - (list-ref cons-codes 1) "uiR[1]")) flux-codes)) - (define flux-upLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") - (list-ref cons-codes 1) "upL[1]")) flux-codes)) - (define flux-upRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") - (list-ref cons-codes 1) "upR[1]")) flux-codes)) - - (define flux-umR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") - (list-ref cons-codes 1) "umR_evol[1]")) flux-codes)) - (define flux-uiL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") - (list-ref cons-codes 1) "uiL_evol[1]")) flux-codes)) - (define flux-uiR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") - (list-ref cons-codes 1) "uiR_evol[1]")) flux-codes)) - (define flux-upL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") - (list-ref cons-codes 1) "upL_evol[1]")) flux-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Lax–Friedrichs first-order finite-difference solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Array for storing slopes. - double *slope = (double*) malloc((nx + 4) * 2 * sizeof(double)); - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); - double *un = (double*) malloc((nx + 4) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - double *umL = (double*) malloc(2 * sizeof(double)); - double *umR = (double*) malloc(2 * sizeof(double)); - double *uiL = (double*) malloc(2 * sizeof(double)); - double *uiR = (double*) malloc(2 * sizeof(double)); - double *upL = (double*) malloc(2 * sizeof(double)); - double *upR = (double*) malloc(2 * sizeof(double)); - - double *f_umL = (double*) malloc(2 * sizeof(double)); - double *f_umR = (double*) malloc(2 * sizeof(double)); - double *f_uiL = (double*) malloc(2 * sizeof(double)); - double *f_uiR = (double*) malloc(2 * sizeof(double)); - double *f_upL = (double*) malloc(2 * sizeof(double)); - double *f_upR = (double*) malloc(2 * sizeof(double)); - - double *umR_evol = (double*) malloc(2 * sizeof(double)); - double *uiL_evol = (double*) malloc(2 * sizeof(double)); - double *uiR_evol = (double*) malloc(2 * sizeof(double)); - double *upL_evol = (double*) malloc(2 * sizeof(double)); - - double *f_umR_evol = (double*) malloc(2 * sizeof(double)); - double *f_uiL_evol = (double*) malloc(2 * sizeof(double)); - double *f_uiR_evol = (double*) malloc(2 * sizeof(double)); - double *f_upL_evol = (double*) malloc(2 * sizeof(double)); - - double *fluxL = (double*) malloc(2 * sizeof(double)); - double *fluxR = (double*) malloc(2 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - double t = 0.0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 0; j < 2; j++) { - double r = (u[(i * 2) + j] - u[((i - 1) * 2) + j]) / (u[((i + 1) * 2) + j] - u[(i * 2) + j]); - double limiter = ~a; // limiter-r in C. - - slope[(i * 2) + j] = limiter * (0.5 * ((u[(i * 2) + j] - u[((i - 1) * 2) + j]) + (u[((i + 1) * 2) + j] - u[(i * 2) + j]))); - } - } - - // Compute fluxes with Lax-Friedrichs approximation and update the conserved variable vector. - for (int i = 2; i <= nx + 1; i++) { - // Extrapolate boundary states. - for (int j = 0; j < 2; j++) { - umL[j] = u[((i - 1) * 2) + j] - (0.5 * slope[((i - 1) * 2) + j]); - umR[j] = u[((i - 1) * 2) + j] + (0.5 * slope[((i - 1) * 2) + j]); - - uiL[j] = u[(i * 2) + j] - (0.5 * slope[(i * 2) + j]); - uiR[j] = u[(i * 2) + j] + (0.5 * slope[(i * 2) + j]); - - upL[j] = u[((i + 1) * 2) + j] - (0.5 * slope[((i + 1) * 2) + j]); - upR[j] = u[((i + 1) * 2) + j] + (0.5 * slope[((i + 1) * 2) + j]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL[0] = ~a; - f_umL[1] = ~a; - f_umR[0] = ~a; - f_umR[1] = ~a; - - f_uiL[0] = ~a; - f_uiL[1] = ~a; - f_uiR[0] = ~a; - f_uiR[1] = ~a; - - f_upL[0] = ~a; - f_upL[1] = ~a; - f_upR[0] = ~a; - f_upR[1] = ~a; - - // Evolve each extrapolated boundary state. - for (int j = 0; j < 2; j++) { - umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); - - uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - - upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol[0] = ~a; - f_umR_evol[1] = ~a; // F(U_{i - 1, R+}) - f_uiL_evol[0] = ~a; - f_uiL_evol[1] = ~a; // F(U_{i, L+}) - - f_uiR_evol[0] = ~a; - f_uiR_evol[1] = ~a; // F(U_{i, R+}) - f_upL_evol[0] = ~a; - f_upL_evol[1] = ~a; // F(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * alpha * (U_{i, L+} - U_{i - 1, R+}). - for (int j = 0; j < 2; j++) { - fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * alpha * (uiL_evol[j] - umR_evol[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * alpha * (U_{i + 1, L+} - U_{i, R+}). - for (int j = 0; j < 2; j++) { - fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * alpha * (upL_evol[j] - uiR_evol[j]); - } - - // Update the conserved variable vector. - for (int j = 0; j < 2; j++) { - un[(i * 2) + j] = u[(i * 2) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j < 2; j++) { - u[(i * 2) + j] = un[(i * 2) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(2 * 2) + j]; - u[(1 * 2) + j] = u[(2 * 2) + j]; - u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; - u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; - } - - // Increment time. - t += dt; - } - - // Output solution to stdout. - for (int i = 2; i <= nx + 1; i++) { - double x = x0 + (i - 1.5) * dx; - printf(\"%g %g %g\\n\", x, u[(i * 2) + 0], u[(i * 2) + 1]); - } - - free(u); - free(un); - free(slope); - - free(local_alpha); - - free(umL); - free(umR); - free(uiL); - free(uiR); - free(upL); - free(upR); - - free(f_umL); - free(f_umR); - free(f_uiL); - free(f_uiR); - free(f_upL); - free(f_upR); - - free(umR_evol); - free(uiL_evol); - free(uiR_evol); - free(upL_evol); - - free(f_umR_evol); - free(f_uiL_evol); - free(f_uiR_evol); - free(f_upL_evol); - - free(fluxL); - free(fluxR); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; Expression for flux limiter function. - limiter-r - ;; Left negative flux vector F(U_{i - 1, L}). - (list-ref flux-umLs 0) - (list-ref flux-umLs 1) - ;; Right negative flux vector F(U_{i - 1, R}). - (list-ref flux-umRs 0) - (list-ref flux-umRs 1) - ;; Left central flux vector F(U_{i, L}). - (list-ref flux-uiLs 0) - (list-ref flux-uiLs 1) - ;; Right central flux vector F(U_{i, R}). - (list-ref flux-uiRs 0) - (list-ref flux-uiRs 1) - ;; Left positive flux vector F(U_{i + 1, L}). - (list-ref flux-upLs 0) - (list-ref flux-upLs 1) - ;; Right positive flux vector F(U_{i + 1, R}). - (list-ref flux-upRs 0) - (list-ref flux-upRs 1) - ;; Evolved right negative flux vector F(U_{i - 1, R+}). - (list-ref flux-umR-evols 0) - (list-ref flux-umR-evols 1) - ;; Evolved left central flux vector F(U_{i, L+}). - (list-ref flux-uiL-evols 0) - (list-ref flux-uiL-evols 1) - ;; Evolved right central flux vector F(U_{i, R+}). - (list-ref flux-uiR-evols 0) - (list-ref flux-uiR-evols 1) - ;; Evolved left positive flux vector F(U_{i + 1, L+}). - (list-ref flux-upL-evols 0) - (list-ref flux-upL-evols 1) - )) - code) - -;; ------------------------------------------------------------------- -;; Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------- -(define (generate-roe-vector2-1d pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define flux-deriv-codes (map (lambda (flux-deriv-expr) - (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define flux-ums (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "um[0]") - (list-ref cons-codes 1) "um[1]")) flux-codes)) - (define flux-uis (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "ui[0]") - (list-ref cons-codes 1) "ui[1]")) flux-codes)) - (define flux-ups (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "up[0]") - (list-ref cons-codes 1) "up[1]")) flux-codes)) - - (define flux-deriv-ums (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "um[0]") - (list-ref cons-codes 1) "um[1]")) flux-deriv-codes)) - (define flux-deriv-uis (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "ui[0]") - (list-ref cons-codes 1) "ui[1]")) flux-deriv-codes)) - (define flux-deriv-ups (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "up[0]") - (list-ref cons-codes 1) "up[1]")) flux-deriv-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a -// Roe higher-order finite-volume solver for a coupled vector system of 2 PDEs in 1D. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 2) * 2 * sizeof(double)); - double *un = (double*) malloc((nx + 2) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - double *um = (double*) malloc(2 * sizeof(double)); - double *ui = (double*) malloc(2 * sizeof(double)); - double *up = (double*) malloc(2 * sizeof(double)); - - double *f_um = (double*) malloc(2 * sizeof(double)); - double *f_ui = (double*) malloc(2 * sizeof(double)); - double *f_up = (double*) malloc(2 * sizeof(double)); - - double *f_deriv_um = (double*) malloc(2 * sizeof(double)); - double *f_deriv_ui = (double*) malloc(2 * sizeof(double)); - double *f_deriv_up = (double*) malloc(2 * sizeof(double)); - - double *aL_roe = (double*) malloc(2 * sizeof(double)); - double *aR_roe = (double*) malloc(2 * sizeof(double)); - - double *fluxL = (double*) malloc(2 * sizeof(double)); - double *fluxR = (double*) malloc(2 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 1; i++) { - double x = x0 + (i - 0.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - double t = 0.0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 1; i <= nx; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute fluxes with Roe approximation and update the conserved variable vector. - for (int i = 1; i <= nx; i++) { - for (int j = 0; j < 2; j++) { - um[j] = u[((i - 1) * 2) + j]; - ui[j] = u[(i * 2) + j]; - up[j] = u[((i + 1) * 2) + j]; - } - - // Evaluate flux vector for each value of the conserved variable vector. - f_um[0] = ~a; - f_um[1] = ~a; // F(U_{i - 1}). - - f_ui[0] = ~a; - f_ui[1] = ~a; // F(U_i). - - f_up[0] = ~a; - f_up[1] = ~a; // F(U_{i + 1}). - - // Evaluate eigenvalues of the flux Jacobian for each value of the conserved variable vector. - f_deriv_um[0] = ~a; - f_deriv_um[1] = ~a; // Eigenvalues of F'(U_{i - 1}). - - f_deriv_ui[0] = ~a; - f_deriv_ui[1] = ~a; // Eigenvalues of F'(U_i). - - f_deriv_up[0] = ~a; - f_deriv_up[1] = ~a; // Eigenvalues of F'(U_{i + 1}). - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1}) + F(U_i)) - 0.5 * |aL_roe| * (U_i - U_{i - 1}). - for (int j = 0; j < 2; j++) { - aL_roe[j] = 0.5 * (f_deriv_um[j] + f_deriv_ui[j]); - } - for (int j = 0; j < 2; j++) { - fluxL[j] = 0.5 * (f_um[j] + f_ui[j]) - 0.5 * fabs(aL_roe[j]) * (ui[j] - um[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1}) + F(U_i)) - 0.5 * |aR_roe| * (U_{i + 1} - u_i). - for (int j = 0; j < 2; j++) { - aR_roe[j] = 0.5 * (f_deriv_ui[j] + f_deriv_up[j]); - } - for (int j = 0; j < 2; j++) { - fluxR[j] = 0.5 * (f_ui[j] + f_up[j]) - 0.5 * fabs(aR_roe[j]) * (up[j] - ui[j]); - } - - // Update the conserved variable. - for (int j = 0; j < 2; j++) { - un[(i * 2) + j] = ui[j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 1; i++) { - for (int j = 0; j < 2; j++) { - u[(i * 2) + j] = un[(i * 2) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(1 * 2) + j]; - u[((nx + 1) * 2) + j] = u[(nx * 2) + j]; - } - - // Increment time. - t += dt; - } - - // Output solution to stdout. - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - printf(\"%g %g %g\\n\", x, u[(i * 2) + 0], u[(i * 2) + 1]); - } - - free(u); - free(un); - - free(local_alpha); - - free(um); - free(ui); - free(up); - - free(f_um); - free(f_ui); - free(f_up); - - free(f_deriv_um); - free(f_deriv_ui); - free(f_deriv_up); - - free(aL_roe); - free(aR_roe); - - free(fluxL); - free(fluxR); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; Left flux vector F(u_{i - 1}). - (list-ref flux-ums 0) - (list-ref flux-ums 1) - ;; Middle flux vector F(u_i). - (list-ref flux-uis 0) - (list-ref flux-uis 1) - ;; Right flux vector F(u_{i + 1}). - (list-ref flux-ups 0) - (list-ref flux-ups 1) - ;; Eigenvalues of left flux Jacobian F'(u_{i - 1}). - (list-ref flux-deriv-ums 0) - (list-ref flux-deriv-ums 1) - ;; Eigenvalues of middle flux Jacobian F'(u_i). - (list-ref flux-deriv-uis 0) - (list-ref flux-deriv-uis 1) - ;; Eigenvalues of right flux Jacobian F'(u_{i + 1}). - (list-ref flux-deriv-ups 0) - (list-ref flux-deriv-ups 1) - )) - code) - -;; ---------------------------------------------------------------------------------------------------------- -;; Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs with a Second-Order Flux Extrapolation -;; ---------------------------------------------------------------------------------------------------------- -(define (generate-roe-vector2-1d-second-order pde-system limiter - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate C code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method with a - second-order flux extrapolation using flux limiter `limiter`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define flux-deriv-codes (map (lambda (flux-deriv-expr) - (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define flux-umLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umL[0]") - (list-ref cons-codes 1) "umL[1]")) flux-codes)) - (define flux-umRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR[0]") - (list-ref cons-codes 1) "umR[1]")) flux-codes)) - (define flux-uiLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL[0]") - (list-ref cons-codes 1) "uiL[1]")) flux-codes)) - (define flux-uiRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR[0]") - (list-ref cons-codes 1) "uiR[1]")) flux-codes)) - (define flux-upLs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL[0]") - (list-ref cons-codes 1) "upL[1]")) flux-codes)) - (define flux-upRs (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upR[0]") - (list-ref cons-codes 1) "upR[1]")) flux-codes)) - - (define flux-umR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "umR_evol[0]") - (list-ref cons-codes 1) "umR_evol[1]")) flux-codes)) - (define flux-uiL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiL_evol[0]") - (list-ref cons-codes 1) "uiL_evol[1]")) flux-codes)) - (define flux-uiR-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "uiR_evol[0]") - (list-ref cons-codes 1) "uiR_evol[1]")) flux-codes)) - (define flux-upL-evols (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "upL_evol[0]") - (list-ref cons-codes 1) "upL_evol[1]")) flux-codes)) - - (define flux-deriv-umR-evols (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "umR_evol[0]") - (list-ref cons-codes 1) "umR_evol[1]")) flux-deriv-codes)) - (define flux-deriv-uiL-evols (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "uiL_evol[0]") - (list-ref cons-codes 1) "uiL_evol[1]")) flux-deriv-codes)) - (define flux-deriv-uiR-evols (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "uiR_evol[0]") - (list-ref cons-codes 1) "uiR_evol[1]")) flux-deriv-codes)) - (define flux-deriv-upL-evols (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "upL_evol[0]") - (list-ref cons-codes 1) "upL_evol[1]")) flux-deriv-codes)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "u[(i * 2) + 0]") - (list-ref cons-codes 1) "u[(i * 2) + 1]")) max-speed-codes)) - - (define parameter-code (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr parameter) ";")) parameters) "\n")] - [else ""])) - - (define code - (format " -// AUTO-GENERATED CODE FOR COUPLED VECTOR PDE SYSTEM: ~a -// FLUX LIMITER: ~a -// Roe higher-order finite-volume solver for a coupled vector system of 2 PDEs in 1D, with a second-order flux extrapolation. - -#include -#include -#include - -// Additional PDE parameters (if any). -~a - -int main() { - // Spatial domain setup. - const int nx = ~a; - const double x0 = ~a; - const double x1 = ~a; - const double L = (x1 - x0); - const double dx = L / nx; - - // Time-stepper setup. - const double cfl = ~a; - const double t_final = ~a; - - // Array for storing slopes. - double *slope = (double*) malloc((nx + 4) * 2 * sizeof(double)); - - // Arrays for storing solution. - double *u = (double*) malloc((nx + 4) * 2 * sizeof(double)); - double *un = (double*) malloc((nx + 4) * 2 * sizeof(double)); - - // Arrays for storing other intermediate values. - double *local_alpha = (double*) malloc(2 * sizeof(double)); - - double *umL = (double*) malloc(2 * sizeof(double)); - double *umR = (double*) malloc(2 * sizeof(double)); - double *uiL = (double*) malloc(2 * sizeof(double)); - double *uiR = (double*) malloc(2 * sizeof(double)); - double *upL = (double*) malloc(2 * sizeof(double)); - double *upR = (double*) malloc(2 * sizeof(double)); - - double *f_umL = (double*) malloc(2 * sizeof(double)); - double *f_umR = (double*) malloc(2 * sizeof(double)); - double *f_uiL = (double*) malloc(2 * sizeof(double)); - double *f_uiR = (double*) malloc(2 * sizeof(double)); - double *f_upL = (double*) malloc(2 * sizeof(double)); - double *f_upR = (double*) malloc(2 * sizeof(double)); - - double *umR_evol = (double*) malloc(2 * sizeof(double)); - double *uiL_evol = (double*) malloc(2 * sizeof(double)); - double *uiR_evol = (double*) malloc(2 * sizeof(double)); - double *upL_evol = (double*) malloc(2 * sizeof(double)); - - double *f_umR_evol = (double*) malloc(2 * sizeof(double)); - double *f_uiL_evol = (double*) malloc(2 * sizeof(double)); - double *f_uiR_evol = (double*) malloc(2 * sizeof(double)); - double *f_upL_evol = (double*) malloc(2 * sizeof(double)); - - double *f_deriv_umR_evol = (double*) malloc(2 * sizeof(double)); - double *f_deriv_uiL_evol = (double*) malloc(2 * sizeof(double)); - double *f_deriv_uiR_evol = (double*) malloc(2 * sizeof(double)); - double *f_deriv_upL_evol = (double*) malloc(2 * sizeof(double)); - - double *aL_roe = (double*) malloc(2 * sizeof(double)); - double *aR_roe = (double*) malloc(2 * sizeof(double)); - - double *fluxL = (double*) malloc(2 * sizeof(double)); - double *fluxR = (double*) malloc(2 * sizeof(double)); - - // Initialize grid and set initial conditions. - for (int i = 0; i <= nx + 3; i++) { - double x = x0 + (i - 1.5) * dx; - - u[(i * 2) + 0] = ~a; // init-funcs[0] in C. - u[(i * 2) + 1] = ~a; // init-funcs[1] in C. - } - - double t = 0.0; - while (t < t_final) { - // Determine global maximum wave-speed alpha (for stable dt). - // Simplistic approach: we compute the local alpha for each cell and take the maximum over the entire domain. - double alpha = 0.0; - - for (int i = 2; i <= nx + 1; i++) { - local_alpha[0] = ~a; // max-speed-exprs[0] in C. - local_alpha[1] = ~a; // max-speed-exprs[1] in C. - - for (int j = 0; j < 2; j++) { - if (local_alpha[j] > alpha) { - alpha = local_alpha[j]; - } - } - } - - // Avoid division by zero. - if (alpha < 1e-14) { - alpha = 1e-14; - } - - // Compute stable time step from alpha. - double dt = cfl * dx / alpha; - - // If stepping beyond t_final, adjust dt accordingly. - if (t + dt > t_final) { - dt = t_final - t; - } - - // Compute appropriately flux-limited slopes within each cell. - for (int i = 1; i <= nx + 2; i++) { - for (int j = 0; j < 2; j++) { - double r = (u[(i * 2) + j] - u[((i - 1) * 2) + j]) / (u[((i + 1) * 2) + j] - u[(i * 2) + j]); - double limiter = ~a; // limiter-r in C. - - slope[(i * 2) + j] = limiter * (0.5 * ((u[(i * 2) + j] - u[((i - 1) * 2) + j]) + (u[((i + 1) * 2) + j] - u[(i * 2) + j]))); - } - } - - // Compute fluxes with Roe approximation and update the conserved variable vector. - for (int i = 2; i <= nx + 1; i++) { - // Extrapolate boundary states. - for (int j = 0; j < 2; j++) { - umL[j] = u[((i - 1) * 2) + j] - (0.5 * slope[((i - 1) * 2) + j]); - umR[j] = u[((i - 1) * 2) + j] + (0.5 * slope[((i - 1) * 2) + j]); - - uiL[j] = u[(i * 2) + j] - (0.5 * slope[(i * 2) + j]); - uiR[j] = u[(i * 2) + j] + (0.5 * slope[(i * 2) + j]); - - upL[j] = u[((i + 1) * 2) + j] - (0.5 * slope[((i + 1) * 2) + j]); - upR[j] = u[((i + 1) * 2) + j] + (0.5 * slope[((i + 1) * 2) + j]); - } - - // Evaluate flux vector for each extrapolated boundary state. - f_umL[0] = ~a; - f_umL[1] = ~a; - f_umR[0] = ~a; - f_umR[1] = ~a; - - f_uiL[0] = ~a; - f_uiL[1] = ~a; - f_uiR[0] = ~a; - f_uiR[1] = ~a; - - f_upL[0] = ~a; - f_upL[1] = ~a; - f_upR[0] = ~a; - f_upR[1] = ~a; - - // Evolve each extrapolated boundary state. - for (int j = 0; j < 2; j++) { - umR_evol[j] = umR[j] + ((dt / (2.0 * dx)) * (f_umL[j] - f_umR[j])); - - uiL_evol[j] = uiL[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - uiR_evol[j] = uiR[j] + ((dt / (2.0 * dx)) * (f_uiL[j] - f_uiR[j])); - - upL_evol[j] = upL[j] + ((dt / (2.0 * dx)) * (f_upL[j] - f_upR[j])); - } - - // Evaluate flux vector for each value of the (evolved) conserved variable vector. - f_umR_evol[0] = ~a; - f_umR_evol[1] = ~a; // F(U_{i - 1, R+}) - f_uiL_evol[0] = ~a; - f_uiL_evol[1] = ~a; // F(U_{i, L+}) - - f_uiR_evol[0] = ~a; - f_uiR_evol[1] = ~a; // F(U_{i, R+}) - f_upL_evol[0] = ~a; - f_upL_evol[1] = ~a; // F(U_{i + 1, L+}) - - // Evaluate eigenvalues of the flux Jacobian for each value of the (evolved) conserved variable vector. - f_deriv_umR_evol[0] = ~a; - f_deriv_umR_evol[1] = ~a; // F'(U_{i - 1, R+}) - f_deriv_uiL_evol[0] = ~a; - f_deriv_uiL_evol[1] = ~a; // F'(U_{i, L+}) - - f_deriv_uiR_evol[0] = ~a; - f_deriv_uiR_evol[1] = ~a; // F'(U_{i, R+}) - f_deriv_upL_evol[0] = ~a; - f_deriv_upL_evol[1] = ~a; // F'(U_{i + 1, L+}) - - // Left interface flux: F_{i - 1/2} = 0.5 * (F(U_{i - 1, R+}) + F(U_{i, L+})) - 0.5 * |aL_roe| * (U_{i, L+} - U_{i - 1, R+}). - for (int j = 0; j < 2; j++) { - aL_roe[j] = 0.5 * (f_deriv_umR_evol[j] + f_deriv_uiL_evol[j]); - } - for (int j = 0; j < 2; j++) { - fluxL[j] = 0.5 * (f_umR_evol[j] + f_uiL_evol[j]) - 0.5 * fabs(aL_roe[j]) * (uiL_evol[j] - umR_evol[j]); - } - - // Right interface flux: F_{i + 1/2} = 0.5 * (F(U_{i + 1, L+}) + F(U_{i, R+})) - 0.5 * |aR_roe| * (U_{i + 1, L+} - u_{i, R+}). - for (int j = 0; j < 2; j++) { - aR_roe[j] = 0.5 * (f_deriv_uiR_evol[j] + f_deriv_upL_evol[j]); - } - for (int j = 0; j < 2; j++) { - fluxR[j] = 0.5 * (f_uiR_evol[j] + f_upL_evol[j]) - 0.5 * fabs(aR_roe[j]) * (upL_evol[j] - uiR_evol[j]); - } - - // Update the conserved variable. - for (int j = 0; j < 2; j++) { - un[(i * 2) + j] = u[(i * 2) + j] - (dt / dx) * (fluxR[j] - fluxL[j]); - } - } - - // Copy un -> u (updated conserved variable vector to new conserved variable vector). - for (int i = 0; i <= nx + 3; i++) { - for (int j = 0; j < 2; j++) { - u[(i * 2) + j] = un[(i * 2) + j]; - } - } - - // Apply simple boundary conditions (transmissive). - for (int j = 0; j < 2; j++) { - u[(0 * 2) + j] = u[(2 * 2) + j]; - u[(1 * 2) + j] = u[(2 * 2) + j]; - u[((nx + 2) * 2) + j] = u[((nx + 1) * 2) + j]; - u[((nx + 3) * 2) + j] = u[((nx + 1) * 2) + j]; - } - - // Increment time. - t += dt; - } - - // Output solution to stdout. - for (int i = 1; i <= nx; i++) { - double x = x0 + (i - 0.5) * dx; - printf(\"%g %g %g\\n\", x, u[(i * 2) + 0], u[(i * 2) + 1]); - } - - free(u); - free(un); - free(slope); - - free(local_alpha); - - free(umL); - free(umR); - free(uiL); - free(uiR); - free(upL); - free(upR); - - free(f_umL); - free(f_umR); - free(f_uiL); - free(f_uiR); - free(f_upL); - free(f_upR); - - free(umR_evol); - free(uiL_evol); - free(uiR_evol); - free(upL_evol); - - free(f_umR_evol); - free(f_uiL_evol); - free(f_uiR_evol); - free(f_upL_evol); - - free(f_deriv_umR_evol); - free(f_deriv_uiL_evol); - free(f_deriv_uiR_evol); - free(f_deriv_upL_evol); - - free(fluxL); - free(fluxR); - - return 0; -} -" - ;; PDE name for code comments. - name - ;; Flux limiter name for code comments. - limiter-name - ;; Additional PDE parameters (e.g. a = 1.0 for linear advection). - parameter-code - ;; Number of cells. - nx - ;; Left boundary. - x0 - ;; Right boundary. - x1 - ;; CFL coefficient. - cfl - ;; Final time. - t-final - ;; Initial condition expressions (e.g. (x < 1.0) ? 1.0 : 0.0)). - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - ;; Expressions for local wave-speed estimates. - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - ;; Expression for flux limiter function. - limiter-r - ;; Left negative flux vector F(U_{i - 1, L}). - (list-ref flux-umLs 0) - (list-ref flux-umLs 1) - ;; Right negative flux vector F(U_{i - 1, R}). - (list-ref flux-umRs 0) - (list-ref flux-umRs 1) - ;; Left central flux vector F(U_{i, L}). - (list-ref flux-uiLs 0) - (list-ref flux-uiLs 1) - ;; Right central flux vector F(U_{i, R}). - (list-ref flux-uiRs 0) - (list-ref flux-uiRs 1) - ;; Left positive flux vector F(U_{i + 1, L}). - (list-ref flux-upLs 0) - (list-ref flux-upLs 1) - ;; Right positive flux vector F(U_{i + 1, R}). - (list-ref flux-upRs 0) - (list-ref flux-upRs 1) - ;; Evolved right negative flux vector F(U_{i - 1, R+}). - (list-ref flux-umR-evols 0) - (list-ref flux-umR-evols 1) - ;; Evolved left central flux vector F(U_{i, L+}). - (list-ref flux-uiL-evols 0) - (list-ref flux-uiL-evols 1) - ;; Evolved right central flux vector F(U_{i, R+}). - (list-ref flux-uiR-evols 0) - (list-ref flux-uiR-evols 1) - ;; Evolved left positive flux vector F(U_{i + 1, L+}). - (list-ref flux-upL-evols 0) - (list-ref flux-upL-evols 1) - ;; Eigenvalues of evolved right negative flux Jacobian F'(U_{i - 1, R+}). - (list-ref flux-deriv-umR-evols 0) - (list-ref flux-deriv-umR-evols 1) - ;; Eigenvalues of evolved left central flux Jacobian F'(U_{i, L+}). - (list-ref flux-deriv-uiL-evols 0) - (list-ref flux-deriv-uiL-evols 1) - ;; Eigenvalues of evolved right central flux Jacobian F'(U_{i, R+}). - (list-ref flux-deriv-uiR-evols 0) - (list-ref flux-deriv-uiR-evols 1) - ;; Eigenvalues of evolved left positive flux Jacobian F'(U_{i + 1, L+}). - (list-ref flux-deriv-upL-evols 0) - (list-ref flux-deriv-upL-evols 1) - )) - code) \ No newline at end of file diff --git a/provable-algorithms/gkyl_code_generator_lax.rkt b/provable-algorithms/gkyl_code_generator_lax.rkt deleted file mode 100644 index e328eee8..00000000 --- a/provable-algorithms/gkyl_code_generator_lax.rkt +++ /dev/null @@ -1,1282 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(provide remove-bracketed-expressions - remove-bracketed-expressions-from-file - gkyl-generate-lax-friedrichs-scalar-1d-header - gkyl-generate-lax-friedrichs-scalar-1d-priv-header - gkyl-generate-lax-friedrichs-scalar-1d-source - gkyl-generate-lax-friedrichs-scalar-1d-regression - gkyl-generate-flux-limiter) - -;; A simple boilerplate function for removing bracketed expressions from strings. -(define (remove-bracketed-expressions str) - (regexp-replace* #rx"\\[.*?\\]" str "")) - -;; A simple boilerplate function for removing bracketed expressions from files. -(define (remove-bracketed-expressions-from-file output-file) - (define content - (with-input-from-file output-file - (lambda () - (port->string (current-input-port))))) - (define cleaned - (remove-bracketed-expressions content)) - (with-output-to-file output-file #:exists 'replace - (lambda () - (display cleaned)))) - -;; ------------------------------------------------------------------------------- -;; Header for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------------- -(define (gkyl-generate-lax-friedrichs-scalar-1d-header pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate Gkeyll C header code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define parameters (hash-ref pde 'parameters)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-comment (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) - parameters) "\n")] - [else "*"])) - - (define code - (format " -#pragma once - -#include - -// Type of Riemann-solver to use: -enum gkyl_wv_~a_rp { - WV_~a_RP_LAX = 0, // Default (Lax fluxes). -}; - -// Input context, packaged as a struct. -struct gkyl_wv_~a_inp { - ~a - - enum gkyl_wv_~a_rp rp_type; // Type of Riemann-solver to use. - bool use_gpu; // Whether the wave equation object is on the host (false) or the device (true). -}; - -/** -* Create a new ~a equation object. -* -~a -* @param use_gpu Whether the wave equation object is on the host (false) or the device (true). -* @return Pointer to the ~a equation object. -*/ -struct gkyl_wv_eqn* -gkyl_wv_~a_new(~a bool use_gpu); - -/** -* Create a new ~a equation object, from an input context struct. -* -* @param inp Input context struct. -* @return Pointer to the ~a equation object. -*/ -struct gkyl_wv_eqn* -gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp); -" - name - (string-upcase name) - name - parameter-def - name - name - parameter-comment - name - name - parameter-sig - name - name - name - name - )) - code) - -;; --------------------------------------------------------------------------------------- -;; Private Header for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE -;; --------------------------------------------------------------------------------------- -(define (gkyl-generate-lax-friedrichs-scalar-1d-priv-header pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate Gkeyll C private header code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define parameters (hash-ref pde 'parameters)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-comment (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) - parameters) "\n")] - [else "*"])) - - (define code - (format " -#pragma once - -// Private header, not for direct use in user-facing code. - -#include -#include -#include -#include -#include -#include - -struct wv_~a { - struct gkyl_wv_eqn eqn; // Base equation object. - ~a -}; - -/** -* Compute maximum absolute wave speed. -* -~a -* @param q Conserved variable vector. -* @return Maximum absolute wave speed for a given q. -*/ -GKYL_CU_D -static inline double -gkyl_~a_max_abs_speed(~a const double* q); - -/** -* Compute flux vector. Assumes rotation to local coordinate system. -* -~a -* @param q Conserved variable vector. -* @param flux Flux vector in direction 'dir' (output). -*/ -GKYL_CU_D -void -gkyl_~a_flux(~a const double* q, double* flux); - -/** -* Compute Riemann variables given the conserved variables. -* -* @param eqn Base equation object. -* @param qstate Current state vector. -* @param qin Conserved variable vector (input). -* @param wout Riemann variable vector (output). -*/ -GKYL_CU_D -static inline void -cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout); - -/** -* Compute conserved variables given the Riemann variables. -* -* @param eqn Base equation object. -* @param qstate Current state vector. -* @param win Riemann variable vector (input). -* @param qout Conserved variable vector (output). -*/ -GKYL_CU_D -static inline void -riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double *qout); - -/** -* Boundary condition function for applying wall boundary conditions for the ~a equation. -* -* @param eqn Base equation object. -* @param t Current simulation time. -* @param nc Number of boundary cells to which to apply wall boundary conditions. -* @param skin Skin cells in boundary region (from which values are copied). -* @param ghost Ghost cells in boundary region (to which values are copied). -* @param ctx Context to pass to the function. -*/ -GKYL_CU_D -static void -~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); - -/** -* Boundary condition function for applying no-slip boundary conditions for the ~a equation. -* -* @param eqn Base equation object. -* @param t Current simulation time. -* @param nc Number of boundary cells to which to apply no-slip boundary conditions. -* @param skin Skin cells in boundary region (from which values are copied). -* @param ghost Ghost cells in boundary region (to which values are copied). -* @param ctx Context to pass to the function. -*/ -GKYL_CU_D -static void -~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); - -/** -* Rotate state vector from global to local coordinate frame. -* -* @param eqn Base equation object. -* @param tau1 First tangent vector of the coordinate frame. -* @param tau2 Second tangent vector of the coordinate frame. -* @param norm Normal vector of the coordinate frame. -* @param qglobal State vector in global coordinate frame (input). -* @param qlocal State vector in local coordinate frame (output). -*/ -GKYL_CU_D -static inline void -rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, - double* GKYL_RESTRICT qlocal); - -/** -* Rotate state vector from local to global coordinate frame. -* -* @param eqn Base equation object. -* @param tau1 First tangent vector of the coordinate frame. -* @param tau2 Second tangent vector of the coordinate frame. -* @param norm Normal vector of the coordinate frame. -* @param qlocal State vector in local coordinate frame (input). -* @param qglobal State vector in global coordinate frame (output). -*/ -GKYL_CU_D -static inline void -rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, - double* GKYL_RESTRICT qglobal); - -/** -* Compute waves and speeds using Lax fluxes. -* -* @param eqn Base equation object. -* @param delta Jump across interface to split. -* @param ql Conserved variables on the left of the interface. -* @param qr Conserved variables on the right of the interface. -* @param waves Waves (output). -* @param s Wave speeds (output). -* @return Maximum wave speed. -*/ -GKYL_CU_D -static double -wave_lax(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s); - -/** -* Compute fluctuations using Lax fluxes. -* -* @param eqn Base equation object. -* @param ql Conserved variable vector on the left of the interface. -* @param qr Conserved variable vector on the right of the interface. -* @param waves Waves (input). -* @param s Wave speeds (input). -* @param amdq Left-moving fluctuations (output). -* @param apdq Right-moving fluctuations (output). -*/ -GKYL_CU_D -static void -qfluct_lax(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq); - -/** -* Compute waves and speeds using Lax fluxes (with potential fallback). -* -* @param eqn Base equation object. -* @param type Type of Riemann-solver flux to use. -* @param delta Jump across interface to split. -* @param ql Conserved variables on the left of the interface. -* @param qr Conserved variables on the right of the interface. -* @param waves Waves (output). -* @param s Wave speeds (output). -* @return Maximum wave speed. -*/ -GKYL_CU_D -static double -wave_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s); - -/** -* Compute fluctuations using Lax fluxes (with potential fallback), -* -* @param eqn Base equation object. -* @param type Type of Riemann-solver flux to use. -* @param ql Conserved variable vector on the left of the interface. -* @param qr Conserved variable vector on the right of the interface. -* @param waves Waves (input). -* @param s Wave speeds (input). -* @param amdq Left-moving fluctuations (output). -* @param apdq Right-moving fluctuations (output). -*/ -GKYL_CU_D -static void -qfluct_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, - double* amdq, double* apdq); - -/** -* Compute jump in flux given two conserved variable states. -* -* @param eqn Base equation object. -* @param ql Conserved variable vector on the left of the interface (input). -* @param qr Conserved variable vector on the right of the interface (input). -* @param flux_jump Jump in flux vector (output). -* @return Maximum wave speeds for states ql and qr. -*/ -GKYL_CU_D -static double -flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump); - -/** -* Determine whether invariant domain of the ~a equation is satisfied. -* -* @param eqn Base equation object. -* @param q Conserved variable vector. -* @return Whether the invariant domain is satisfied. -*/ -GKYL_CU_D -static bool -check_inv(const struct gkyl_wv_eqn* eqn, const double* q); - -/** -* Compute maximum wave speed from a conserved variable vector. -* -* @param eqn Base equation object. -* @param q Conserved variable vector. -* @return Maximum absolute wave speed. -*/ -GKYL_CU_D -static double -max_speed(const struct gkyl_wv_eqn* eqn, const double* q); - -/** -* Convert conserved variables to diagnostic variables. -* -* @param eqn Base equation object. -* @param qin Conserved variable vector (input). -* @param diag Diagnostic variable vector (output). -*/ -GKYL_CU_D -static inline void -~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag); - -/** -* Compute forcing/source term vector from conserved variable vector. -* -* @param eqn Base equation object. -* @param qin Conserved variable vector (input). -* @param sout Forcing/source term vector (output). -*/ -GKYL_CU_DH -static inline void -~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout); - -/** -* Free ~a equation object. -* -* @param ref Reference counter for ~a equation. -*/ -void -gkyl_~a_free(const struct gkyl_ref_count* ref); -" - name - parameter-def - parameter-comment - name - parameter-sig - parameter-comment - name - parameter-sig - name - name - name - name - name - name - name - name - name - name - )) - code) - -;; ------------------------------------------------------------------------------- -;; Source for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------------- -(define (gkyl-generate-lax-friedrichs-scalar-1d-source pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate Gkeyll C source code that solves the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define max-speed-local (flux-substitute max-speed-code cons-code "q[0]")) - (define flux-ui (flux-substitute flux-code cons-code "q[0]")) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) " = " - name "->" (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-name (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-field (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - (define parameter-field-set (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append name "->" (convert-expr (list-ref parameter 1)) - " = inp->" (convert-expr (list-ref parameter 1)) ";")) - parameters) "\n")] - [else ""])) - - (define code - (format " -#include -#include - -#include -#include -#include -#include - -static inline double -gkyl_~a_max_abs_speed(~a const double* q) -{ - return ~a; -} - -void -gkyl_~a_flux(~a const double* q, double* flux) -{ - flux[0] = ~a; -} - -static inline void -cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout) -{ - // TODO: This should use a proper L matrix. - wout[0] = qin[0]; -} - -static inline void -riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double* qout) -{ - // TODO: This should use a proper L matrix. - qout[0] = win[0]; -} - -static void -~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) -{ - ghost[0] = skin[0]; -} - -static void -~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) -{ - ghost[0] = skin[0]; -} - -static inline void -rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, - double* GKYL_RESTRICT qlocal) -{ - qlocal[0] = qglobal[0]; -} - -static inline void -rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, - double* GKYL_RESTRICT qglobal) -{ - qglobal[0] = qlocal[0]; -} - -static double -wave_lax(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - double sl = gkyl_~a_max_abs_speed(~a ql); - double sr = gkyl_~a_max_abs_speed(~a qr); - double amax = fmax(sl, sr); - - double *fl = gkyl_malloc(sizeof(double)); - double *fr = gkyl_malloc(sizeof(double)); - gkyl_~a_flux(~a ql, fl); - gkyl_~a_flux(~a qr, fr); - - double *w0 = &waves[0], *w1 = &waves[1]; - w0[0] = 0.5 * ((qr[0] - ql[0]) - (fr[0] - fl[0]) / amax); - w1[0] = 0.5 * ((qr[0] - ql[0]) + (fr[0] - fl[0]) / amax); - - s[0] = -amax; - s[1] = amax; - - gkyl_free(fl); - gkyl_free(fr); - - return s[1]; -} - -static void -qfluct_lax(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq) -{ - const double *w0 = &waves[0], *w1 = &waves[1]; - double s0m = fmin(0.0, s[0]), s1m = fmin(0.0, s[1]); - double s0p = fmax(0.0, s[0]), s1p = fmax(0.0, s[1]); - - amdq[0] = (s0m * w0[0]) + (s1m * w1[0]); - apdq[0] = (s0p * w0[0]) + (s1p * w1[0]); -} - -static double -wave_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s) -{ - return wave_lax(eqn, delta, ql, qr, waves, s); -} - -static void -qfluct_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, - double* amdq, double* apdq) -{ - return qfluct_lax(eqn, ql, qr, waves, s, amdq, apdq); -} - -static double -flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - double *fr = gkyl_malloc(sizeof(double)); - double *fl = gkyl_malloc(sizeof(double)); - gkyl_~a_flux(~a ql, fl); - gkyl_~a_flux(~a qr, fr); - - flux_jump[0] = fr[0] - fl[0]; - - double amaxl = gkyl_~a_max_abs_speed(~a ql); - double amaxr = gkyl_~a_max_abs_speed(~a qr); - - gkyl_free(fr); - gkyl_free(fl); - - return fmax(amaxl, amaxr); -} - -static bool -check_inv(const struct gkyl_wv_eqn* eqn, const double* q) -{ - return true; // All states are assumed to be valid. -} - -static double -max_speed(const struct gkyl_wv_eqn* eqn, const double* q) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - return gkyl_~a_max_abs_speed(~a q); -} - -static inline void -~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag) -{ - diag[0] = qin[0]; -} - -static inline void -~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout) -{ - sout[0] = 0.0; -} - -void -gkyl_~a_free(const struct gkyl_ref_count* ref) -{ - struct gkyl_wv_eqn* base = container_of(ref, struct gkyl_wv_eqn, ref_count); - - if (gkyl_wv_eqn_is_cu_dev(base)) { - // Free inner on_dev object. - struct wv_~a *~a = container_of(base->on_dev, struct wv_~a, eqn); - gkyl_cu_free(~a); - } - - struct wv_~a *~a = container_of(base, struct wv_~a, eqn); - gkyl_free(~a); -} - -struct gkyl_wv_eqn* -gkyl_wv_~a_new(~a bool use_gpu) -{ - return gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { - ~a - .rp_type = WV_~a_RP_LAX, - .use_gpu = use_gpu, - } - ); -} - -struct gkyl_wv_eqn* -gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp) -{ - struct wv_~a *~a = gkyl_malloc(sizeof(struct wv_~a)); - - ~a->eqn.type = GKYL_EQN_~a; - ~a->eqn.num_equations = 1; - ~a->eqn.num_diag = 1; - - ~a - - if (inp->rp_type == WV_~a_RP_LAX) { - ~a->eqn.num_waves = 2; - ~a->eqn.waves_func = wave_lax_l; - ~a->eqn.qfluct_func = qfluct_lax_l; - } - - ~a->eqn.flux_jump = flux_jump; - ~a->eqn.check_inv_func = check_inv; - ~a->eqn.max_speed_func = max_speed; - ~a->eqn.rotate_to_local_func = rot_to_local; - ~a->eqn.rotate_to_global_func = rot_to_global; - - ~a->eqn.wall_bc_func = ~a_wall; - ~a->eqn.no_slip_bc_func = ~a_no_slip; - - ~a->eqn.cons_to_riem = cons_to_riem; - ~a->eqn.riem_to_cons = riem_to_cons; - - ~a->eqn.cons_to_diag = ~a_cons_to_diag; - - ~a->eqn.source_func = ~a_source; - - ~a->eqn.flags = 0; - GKYL_CLEAR_CU_ALLOC(~a->eqn.flags); - ~a->eqn.ref_count = gkyl_ref_count_init(gkyl_~a_free); - ~a->eqn.on_dev = &~a->eqn; // On the CPU, the equation object points to itself. - - return &~a->eqn; -} -" - name - name - name - parameter-sig - max-speed-local - name - parameter-sig - flux-ui - name - name - name - name - name - parameter-def - name - parameter-name - name - parameter-name - name - parameter-name - name - parameter-name - name - name - name - parameter-def - name - parameter-name - name - parameter-name - name - parameter-name - name - parameter-name - name - name - name - parameter-def - name - parameter-name - name - name - name - name - name - name - name - name - name - name - name - name - parameter-sig - name - name - parameter-field - (string-upcase name) - name - name - name - name - name - name - (string-upcase name) - name - name - parameter-field-set - (string-upcase name) - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------ -;; C Regression Test for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------------------------ -(define (gkyl-generate-lax-friedrichs-scalar-1d-regression pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate a Gkeyll C regression test for the 1D scalar PDE specified by `pde` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define parameters (hash-ref pde 'parameters)) - - (define init-func-code (convert-expr init-func)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-assign (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 2))"; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-ctx-set (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - (define parameter-ctx (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = ctx." - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - - (define code - (format " -#include -#include -#include -#include - -#include -#include -#include -#include - -#include - -#ifdef GKYL_HAVE_MPI -#include -#include -#endif - -#include - -struct ~a_lax_ctx -{ - // Simulation parameters. - int Nx; // Cell count (x-direction). - double Lx; // Domain size (x-direction). - ~a - double cfl_frac; // CFL coefficient. - - double t_end; // Final simulation time. - int num_frames; // Number of output frames. - int field_energy_calcs; // Number of times to calculate field energy. - int integrated_mom_calcs; // Number of times to calculate integrated moments. - double dt_failure_tol; // Minimum allowable fraction of initial time-step. - int num_failures_max; // Maximum allowable number of consecutive small time-steps. -}; - -struct ~a_lax_ctx -create_ctx(void) -{ - // Simulation parameters. - int Nx = ~a; // Cell count (x-direction). - double Lx = ~a; // Domain size (x-direction). - ~a - double cfl_frac = ~a; // CFL coefficient. - - double t_end = ~a; // Final simulation time. - int num_frames = 1; // Number of output frames. - int field_energy_calcs = INT_MAX; // Number of times to calculate field energy. - int integrated_mom_calcs = INT_MAX; // Number of times to calculate integrated moments. - double dt_failure_tol = 1.0e-4; // Minimum allowable fraction of initial time-step. - int num_failures_max = 20; // Maximum allowable number of consecutive small time-steps. - - struct ~a_lax_ctx ctx = { - .Nx = Nx, - .Lx = Lx, - ~a - .cfl_frac = cfl_frac, - .t_end = t_end, - .num_frames = num_frames, - .field_energy_calcs = field_energy_calcs, - .integrated_mom_calcs = integrated_mom_calcs, - .dt_failure_tol = dt_failure_tol, - .num_failures_max = num_failures_max, - }; - - return ctx; -} - -void -eval~aInit(double t, const double* GKYL_RESTRICT xn, double* GKYL_RESTRICT fout, void* ctx) -{ - double x = xn[0]; - - // Set conserved quantity. - fout[0] = ~a; -} - -void -write_data(struct gkyl_tm_trigger* iot, gkyl_moment_app* app, double t_curr, bool force_write) -{ - if (gkyl_tm_trigger_check_and_bump(iot, t_curr) || force_write) { - int frame = iot->curr - 1; - if (force_write) { - frame = iot->curr; - } - - gkyl_moment_app_write(app, t_curr, frame); - gkyl_moment_app_write_field_energy(app); - gkyl_moment_app_write_integrated_mom(app); - } -} - -void -calc_field_energy(struct gkyl_tm_trigger* fet, gkyl_moment_app* app, double t_curr, bool force_calc) -{ - if (gkyl_tm_trigger_check_and_bump(fet, t_curr) || force_calc) { - gkyl_moment_app_calc_field_energy(app, t_curr); - } -} - -void -calc_integrated_mom(struct gkyl_tm_trigger* imt, gkyl_moment_app* app, double t_curr, bool force_calc) -{ - if (gkyl_tm_trigger_check_and_bump(imt, t_curr) || force_calc) { - gkyl_moment_app_calc_integrated_mom(app, t_curr); - } -} - -int -main(int argc, char **argv) -{ - struct gkyl_app_args app_args = parse_app_args(argc, argv); - -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Init(&argc, &argv); - } -#endif - - if (app_args.trace_mem) { - gkyl_cu_dev_mem_debug_set(true); - gkyl_mem_debug_set(true); - } - - struct ~a_lax_ctx ctx = create_ctx(); // Context for initialization functions. - - int NX = APP_ARGS_CHOOSE(app_args.xcells[0], ctx.Nx); - - // ~a equation. - struct gkyl_wv_eqn *~a = gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { - ~a - .rp_type = WV_~a_RP_LAX, - .use_gpu = app_args.use_gpu, - } - ); - - struct gkyl_moment_species fluid = { - .name = \"~a\", - .equation = ~a, - .evolve = true, - .init = eval~aInit, - .ctx = &ctx, - }; - - int nrank = 1; // Number of processes in simulation. -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Comm_size(MPI_COMM_WORLD, &nrank); - } -#endif - - // Create global range. - int cells[] = { NX }; - int dim = sizeof(cells) / sizeof(cells[0]); - - int cuts[dim]; -#ifdef GKYL_HAVE_MPI - for (int d = 0; d < dim; d++) { - if (app_args.use_mpi) { - cuts[d] = app_args.cuts[d]; - } - else { - cuts[d] = 1; - } - } -#else - for (int d = 0; d < dim; d++) { - cuts[d] = 1; - } -#endif - - // Construct communicator for use in app. - struct gkyl_comm *comm; -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - comm = gkyl_mpi_comm_new( &(struct gkyl_mpi_comm_inp) { - .mpi_comm = MPI_COMM_WORLD, - } - ); - } - else { - comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { - .use_gpu = app_args.use_gpu - } - ); - } -#else - comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { - .use_gpu = app_args.use_gpu - } - ); -#endif - - int my_rank; - gkyl_comm_get_rank(comm, &my_rank); - int comm_size; - gkyl_comm_get_size(comm, &comm_size); - - int ncuts = 1; - for (int d = 0; d < dim; d++) { - ncuts *= cuts[d]; - } - - if (ncuts != comm_size) { - if (my_rank == 0) { - fprintf(stderr, \"*** Number of ranks, %d, does not match total cuts, %d!\\n\", comm_size, ncuts); - } - goto mpifinalize; - } - - // Moment app. - struct gkyl_moment app_inp = { - .name = \"~a_lax\", - - .ndim = 1, - .lower = { ~a }, - .upper = { ~a + ctx.Lx }, - .cells = { NX }, - - .num_periodic_dir = 0, - .periodic_dirs = { }, - .cfl_frac = ctx.cfl_frac, - - .num_species = 1, - .species = { fluid }, - - .parallelism = { - .use_gpu = app_args.use_gpu, - .cuts = { app_args.cuts[0] }, - .comm = comm, - }, - }; - - // Create app object. - gkyl_moment_app *app = gkyl_moment_app_new(&app_inp); - - // Initial and final simulation times. - double t_curr = 0.0, t_end = ctx.t_end; - - // Initialize simulation. - int frame_curr = 0; - if (app_args.is_restart) { - struct gkyl_app_restart_status status = gkyl_moment_app_read_from_frame(app, app_args.restart_frame); - - if (status.io_status != GKYL_ARRAY_RIO_SUCCESS) { - gkyl_moment_app_cout(app, stderr, \"*** Failed to read restart file! (%s)\\n\", gkyl_array_rio_status_msg(status.io_status)); - goto freeresources; - } - - frame_curr = status.frame; - t_curr = status.stime; - - gkyl_moment_app_cout(app, stdout, \"Restarting from frame %d\", frame_curr); - gkyl_moment_app_cout(app, stdout, \" at time = %g\\n\", t_curr); - } - else { - gkyl_moment_app_apply_ic(app, t_curr); - } - - // Create trigger for field energy. - int field_energy_calcs = ctx.field_energy_calcs; - struct gkyl_tm_trigger fe_trig = { .dt = t_end / field_energy_calcs, .tcurr = t_curr, .curr = frame_curr }; - - calc_field_energy(&fe_trig, app, t_curr, false); - - // Create trigger for integrated moments. - int integrated_mom_calcs = ctx.integrated_mom_calcs; - struct gkyl_tm_trigger im_trig = { .dt = t_end / integrated_mom_calcs, .tcurr = t_curr, .curr = frame_curr }; - - calc_integrated_mom(&im_trig, app, t_curr, false); - - // Create trigger for IO. - int num_frames = ctx.num_frames; - struct gkyl_tm_trigger io_trig = { .dt = t_end / num_frames, .tcurr = t_curr, .curr = frame_curr }; - - write_data(&io_trig, app, t_curr, false); - - // Compute initial guess of maximum stable time-step. - double dt = t_end - t_curr; - - // Initialize small time-step check. - double dt_init = -1.0, dt_failure_tol = ctx.dt_failure_tol; - int num_failures = 0, num_failures_max = ctx.num_failures_max; - - long step = 1; - while ((t_curr < t_end) && (step <= app_args.num_steps)) { - gkyl_moment_app_cout(app, stdout, \"Taking time-step %ld at t = %g ...\", step, t_curr); - struct gkyl_update_status status = gkyl_moment_update(app, dt); - gkyl_moment_app_cout(app, stdout, \" dt = %g\\n\", status.dt_actual); - - if (!status.success) { - gkyl_moment_app_cout(app, stdout, \"** Update method failed! Aborting simulation ....\\n\"); - break; - } - - t_curr += status.dt_actual; - dt = status.dt_suggested; - - calc_field_energy(&fe_trig, app, t_curr, false); - calc_integrated_mom(&im_trig, app, t_curr, false); - write_data(&io_trig, app, t_curr, false); - - if (dt_init < 0.0) { - dt_init = status.dt_actual; - } - else if (status.dt_actual < dt_failure_tol * dt_init) { - num_failures += 1; - - gkyl_moment_app_cout(app, stdout, \"WARNING: Time-step dt = %g\", status.dt_actual); - gkyl_moment_app_cout(app, stdout, \" is below %g*dt_init ...\", dt_failure_tol); - gkyl_moment_app_cout(app, stdout, \" num_failures = %d\\n\", num_failures); - if (num_failures >= num_failures_max) { - gkyl_moment_app_cout(app, stdout, \"ERROR: Time-step was below %g*dt_init \", dt_failure_tol); - gkyl_moment_app_cout(app, stdout, \"%d consecutive times. Aborting simulation ....\\n\", num_failures_max); - - calc_field_energy(&fe_trig, app, t_curr, true); - calc_integrated_mom(&im_trig, app, t_curr, true); - write_data(&io_trig, app, t_curr, true); - - break; - } - } - else { - num_failures = 0; - } - - step += 1; - } - - calc_field_energy(&fe_trig, app, t_curr, false); - calc_integrated_mom(&im_trig, app, t_curr, false); - write_data(&io_trig, app, t_curr, false); - gkyl_moment_app_stat_write(app); - - struct gkyl_moment_stat stat = gkyl_moment_app_stat(app); - - gkyl_moment_app_cout(app, stdout, \"\\n\"); - gkyl_moment_app_cout(app, stdout, \"Number of update calls %ld\\n\", stat.nup); - gkyl_moment_app_cout(app, stdout, \"Number of failed time-steps %ld\\n\", stat.nfail); - gkyl_moment_app_cout(app, stdout, \"Species updates took %g secs\\n\", stat.species_tm); - gkyl_moment_app_cout(app, stdout, \"Field updates took %g secs\\n\", stat.field_tm); - gkyl_moment_app_cout(app, stdout, \"Source updates took %g secs\\n\", stat.sources_tm); - gkyl_moment_app_cout(app, stdout, \"Total updates took %g secs\\n\", stat.total_tm); - -freeresources: - // Free resources after simulation completion. - gkyl_wv_eqn_release(~a); - gkyl_comm_release(comm); - gkyl_moment_app_release(app); - -mpifinalize: -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Finalize(); - } -#endif - - return 0; -} - -" - name - name - parameter-def - name - nx - (- x1 x0) - parameter-assign - cfl - t-final - name - parameter-ctx-set - (string-titlecase name) - init-func-code - name - name - name - name - name - parameter-ctx - (string-upcase name) - name - name - (string-titlecase name) - name - x0 - x0 - name - )) - code) - -;; ------------------------------------------------------------- -;; Code for Gkeyll flux limiter (to be plugged into wave_prop.c) -;; ------------------------------------------------------------- -(define (gkyl-generate-flux-limiter limiter) - "Generate Gkeyll C code (to be inserted into wave_prop.c) for flux limiter `limiter`, to be used for second-order flux extrapolation." - - (define limiter-name (hash-ref limiter 'name)) - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (define limiter-code (convert-expr limiter-expr)) - (define limiter-ratio-code (convert-expr limiter-ratio)) - - (define limiter-r (flux-substitute limiter-code limiter-ratio-code "r")) - - (define code - (format " - case GKYL_~a: - theta = ~a; - break; -" - (string-upcase limiter-name) - limiter-r - )) - code) \ No newline at end of file diff --git a/provable-algorithms/gkyl_code_generator_lax_vector.rkt b/provable-algorithms/gkyl_code_generator_lax_vector.rkt deleted file mode 100644 index e2d35da0..00000000 --- a/provable-algorithms/gkyl_code_generator_lax_vector.rkt +++ /dev/null @@ -1,1305 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(provide remove-bracketed-expressions - remove-bracketed-expressions-from-file - gkyl-generate-lax-friedrichs-vector2-1d-header - gkyl-generate-lax-friedrichs-vector2-1d-priv-header - gkyl-generate-lax-friedrichs-vector2-1d-source - gkyl-generate-lax-friedrichs-vector2-1d-regression) - -;; A simple boilerplate function for removing bracketed expressions from strings. -(define (remove-bracketed-expressions str) - (regexp-replace* #rx"\\[.*?\\]" str "")) - -;; A simple boilerplate function for removing bracketed expressions from files. -(define (remove-bracketed-expressions-from-file output-file) - (define content - (with-input-from-file output-file - (lambda () - (port->string (current-input-port))))) - (define cleaned - (remove-bracketed-expressions content)) - (with-output-to-file output-file #:exists 'replace - (lambda () - (display cleaned)))) - -;; ---------------------------------------------------------------------------------------------------- -;; Header for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; ---------------------------------------------------------------------------------------------------- -(define (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate Gkeyll C header code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define parameters (hash-ref pde-system 'parameters)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-comment (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) - parameters) "\n")] - [else "*"])) - - (define code - (format " -#pragma once - -#include - -// Type of Riemann-solver to use: -enum gkyl_wv_~a_rp { - WV_~a_RP_LAX = 0, // Default (Lax fluxes). -}; - -// Input context, packaged as a struct. -struct gkyl_wv_~a_inp { - ~a - - enum gkyl_wv_~a_rp rp_type; // Type of Riemann-solver to use. - bool use_gpu; // Whether the wave equation object is on the host (false) or the device (true). -}; - -/** -* Create a new ~a equations object. -* -~a -* @param use_gpu Whether the wave equation object is on the host (false) or the device (true). -* @return Pointer to the ~a equations object. -*/ -struct gkyl_wv_eqn* -gkyl_wv_~a_new(~a bool use_gpu); - -/** -* Create a new ~a equations object, from an input context struct. -* -* @param inp Input context struct. -* @return Pointer to the ~a equations object. -*/ -struct gkyl_wv_eqn* -gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp); -" - name - (string-upcase name) - name - parameter-def - name - name - parameter-comment - name - name - parameter-sig - name - name - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------------------------ -;; Private Header for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------------------------------------------------ -(define (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate Gkeyll C private header code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define parameters (hash-ref pde-system 'parameters)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-comment (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) - parameters) "\n")] - [else "*"])) - - (define code - (format " -#pragma once - -// Private header, not for direct use in user-facing code. - -#include -#include -#include -#include -#include -#include - -struct wv_~a { - struct gkyl_wv_eqn eqn; // Base equation object. - ~a -}; - -/** -* Compute maximum absolute wave speed. -* -~a -* @param q Conserved variable vector. -* @return Maximum absolute wave speed for a given q. -*/ -GKYL_CU_D -static inline double -gkyl_~a_max_abs_speed(~a const double* q); - -/** -* Compute flux vector. Assumes rotation to local coordinate system. -* -~a -* @param q Conserved variable vector. -* @param flux Flux vector in direction 'dir' (output). -*/ -GKYL_CU_D -void -gkyl_~a_flux(~a const double* q, double* flux); - -/** -* Compute Riemann variables given the conserved variables. -* -* @param eqn Base equation object. -* @param qstate Current state vector. -* @param qin Conserved variable vector (input). -* @param wout Riemann variable vector (output). -*/ -GKYL_CU_D -static inline void -cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout); - -/** -* Compute conserved variables given the Riemann variables. -* -* @param eqn Base equation object. -* @param qstate Current state vector. -* @param win Riemann variable vector (input). -* @param qout Conserved variable vector (output). -*/ -GKYL_CU_D -static inline void -riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double *qout); - -/** -* Boundary condition function for applying wall boundary conditions for the ~a equations. -* -* @param eqn Base equation object. -* @param t Current simulation time. -* @param nc Number of boundary cells to which to apply wall boundary conditions. -* @param skin Skin cells in boundary region (from which values are copied). -* @param ghost Ghost cells in boundary region (to which values are copied). -* @param ctx Context to pass to the function. -*/ -GKYL_CU_D -static void -~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); - -/** -* Boundary condition function for applying no-slip boundary conditions for the ~a equations. -* -* @param eqn Base equation object. -* @param t Current simulation time. -* @param nc Number of boundary cells to which to apply no-slip boundary conditions. -* @param skin Skin cells in boundary region (from which values are copied). -* @param ghost Ghost cells in boundary region (to which values are copied). -* @param ctx Context to pass to the function. -*/ -GKYL_CU_D -static void -~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); - -/** -* Rotate state vector from global to local coordinate frame. -* -* @param eqn Base equation object. -* @param tau1 First tangent vector of the coordinate frame. -* @param tau2 Second tangent vector of the coordinate frame. -* @param norm Normal vector of the coordinate frame. -* @param qglobal State vector in global coordinate frame (input). -* @param qlocal State vector in local coordinate frame (output). -*/ -GKYL_CU_D -static inline void -rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, - double* GKYL_RESTRICT qlocal); - -/** -* Rotate state vector from local to global coordinate frame. -* -* @param eqn Base equation object. -* @param tau1 First tangent vector of the coordinate frame. -* @param tau2 Second tangent vector of the coordinate frame. -* @param norm Normal vector of the coordinate frame. -* @param qlocal State vector in local coordinate frame (input). -* @param qglobal State vector in global coordinate frame (output). -*/ -GKYL_CU_D -static inline void -rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, - double* GKYL_RESTRICT qglobal); - -/** -* Compute waves and speeds using Lax fluxes. -* -* @param eqn Base equation object. -* @param delta Jump across interface to split. -* @param ql Conserved variables on the left of the interface. -* @param qr Conserved variables on the right of the interface. -* @param waves Waves (output). -* @param s Wave speeds (output). -* @return Maximum wave speed. -*/ -GKYL_CU_D -static double -wave_lax(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s); - -/** -* Compute fluctuations using Lax fluxes. -* -* @param eqn Base equation object. -* @param ql Conserved variable vector on the left of the interface. -* @param qr Conserved variable vector on the right of the interface. -* @param waves Waves (input). -* @param s Wave speeds (input). -* @param amdq Left-moving fluctuations (output). -* @param apdq Right-moving fluctuations (output). -*/ -GKYL_CU_D -static void -qfluct_lax(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq); - -/** -* Compute waves and speeds using Lax fluxes (with potential fallback). -* -* @param eqn Base equation object. -* @param type Type of Riemann-solver flux to use. -* @param delta Jump across interface to split. -* @param ql Conserved variables on the left of the interface. -* @param qr Conserved variables on the right of the interface. -* @param waves Waves (output). -* @param s Wave speeds (output). -* @return Maximum wave speed. -*/ -GKYL_CU_D -static double -wave_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s); - -/** -* Compute fluctuations using Lax fluxes (with potential fallback), -* -* @param eqn Base equation object. -* @param type Type of Riemann-solver flux to use. -* @param ql Conserved variable vector on the left of the interface. -* @param qr Conserved variable vector on the right of the interface. -* @param waves Waves (input). -* @param s Wave speeds (input). -* @param amdq Left-moving fluctuations (output). -* @param apdq Right-moving fluctuations (output). -*/ -GKYL_CU_D -static void -qfluct_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, - double* amdq, double* apdq); - -/** -* Compute jump in flux given two conserved variable states. -* -* @param eqn Base equation object. -* @param ql Conserved variable vector on the left of the interface (input). -* @param qr Conserved variable vector on the right of the interface (input). -* @param flux_jump Jump in flux vector (output). -* @return Maximum wave speeds for states ql and qr. -*/ -GKYL_CU_D -static double -flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump); - -/** -* Determine whether invariant domain of the ~a equations is satisfied. -* -* @param eqn Base equation object. -* @param q Conserved variable vector. -* @return Whether the invariant domain is satisfied. -*/ -GKYL_CU_D -static bool -check_inv(const struct gkyl_wv_eqn* eqn, const double* q); - -/** -* Compute maximum wave speed from a conserved variable vector. -* -* @param eqn Base equation object. -* @param q Conserved variable vector. -* @return Maximum absolute wave speed. -*/ -GKYL_CU_D -static double -max_speed(const struct gkyl_wv_eqn* eqn, const double* q); - -/** -* Convert conserved variables to diagnostic variables. -* -* @param eqn Base equation object. -* @param qin Conserved variable vector (input). -* @param diag Diagnostic variable vector (output). -*/ -GKYL_CU_D -static inline void -~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag); - -/** -* Compute forcing/source term vector from conserved variable vector. -* -* @param eqn Base equation object. -* @param qin Conserved variable vector (input). -* @param sout Forcing/source term vector (output). -*/ -GKYL_CU_DH -static inline void -~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout); - -/** -* Free ~a equations object. -* -* @param ref Reference counter for ~a equations. -*/ -void -gkyl_~a_free(const struct gkyl_ref_count* ref); -" - name - parameter-def - parameter-comment - name - parameter-sig - parameter-comment - name - parameter-sig - name - name - name - name - name - name - name - name - name - name - )) - code) - -;; ---------------------------------------------------------------------------------------------------- -;; Source for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; ---------------------------------------------------------------------------------------------------- -(define (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate Gkeyll C source code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "q[0]") - (list-ref cons-codes 1) "q[1]")) max-speed-codes)) - (define flux-uis (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "q[0]") - (list-ref cons-codes 1) "q[1]")) flux-codes)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) " = " - name "->" (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-name (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-field (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - (define parameter-field-set (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append name "->" (convert-expr (list-ref parameter 1)) - " = inp->" (convert-expr (list-ref parameter 1)) ";")) - parameters) "\n")] - [else ""])) - - (define code - (format " -#include -#include - -#include -#include -#include -#include - -static inline double -gkyl_~a_max_abs_speed(~a const double* q) -{ - return fmax(~a, ~a); -} - -void -gkyl_~a_flux(~a const double* q, double* flux) -{ - flux[0] = ~a; - flux[1] = ~a; -} - -static inline void -cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout) -{ - // TODO: This should use a proper L matrix. - for (int i = 0; i < 2; i++) { - wout[i] = qin[i]; - } -} - -static inline void -riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double* qout) -{ - // TODO: This should use a proper L matrix. - for (int i = 0; i < 2; i++) { - qout[i] = win[i]; - } -} - -static void -~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) -{ - for (int i = 0; i < 2; i++) { - ghost[i] = skin[i]; - } -} - -static void -~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) -{ - for (int i = 0; i < 2; i++) { - ghost[i] = skin[i]; - } -} - -static inline void -rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, - double* GKYL_RESTRICT qlocal) -{ - for (int i = 0; i < 2; i++) { - qlocal[i] = qglobal[i]; - } -} - -static inline void -rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, - double* GKYL_RESTRICT qglobal) -{ - for (int i = 0; i < 2; i++) { - qglobal[i] = qlocal[i]; - } -} - -static double -wave_lax(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - double sl = gkyl_~a_max_abs_speed(~a ql); - double sr = gkyl_~a_max_abs_speed(~a qr); - double amax = fmax(sl, sr); - - double *fl = gkyl_malloc(sizeof(double) * 2); - double *fr = gkyl_malloc(sizeof(double) * 2); - gkyl_~a_flux(~a ql, fl); - gkyl_~a_flux(~a qr, fr); - - double *w0 = &waves[0], *w1 = &waves[2]; - for (int i = 0; i < 2; i++) { - w0[i] = 0.5 * ((qr[i] - ql[i]) - (fr[i] - fl[i]) / amax); - w1[i] = 0.5 * ((qr[i] - ql[i]) + (fr[i] - fl[i]) / amax); - } - - s[0] = -amax; - s[1] = amax; - - gkyl_free(fl); - gkyl_free(fr); - - return s[1]; -} - -static void -qfluct_lax(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq) -{ - const double *w0 = &waves[0], *w1 = &waves[2]; - double s0m = fmin(0.0, s[0]), s1m = fmin(0.0, s[1]); - double s0p = fmax(0.0, s[0]), s1p = fmax(0.0, s[1]); - - for (int i = 0; i < 2; i++) { - amdq[i] = (s0m * w0[i]) + (s1m * w1[i]); - apdq[i] = (s0p * w0[i]) + (s1p * w1[i]); - } -} - -static double -wave_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s) -{ - return wave_lax(eqn, delta, ql, qr, waves, s); -} - -static void -qfluct_lax_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, - double* amdq, double* apdq) -{ - return qfluct_lax(eqn, ql, qr, waves, s, amdq, apdq); -} - -static double -flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - double *fr = gkyl_malloc(sizeof(double) * 2); - double *fl = gkyl_malloc(sizeof(double) * 2); - gkyl_~a_flux(~a ql, fl); - gkyl_~a_flux(~a qr, fr); - - for (int i = 0; i < 2; i++) { - flux_jump[i] = fr[i] - fl[i]; - } - - double amaxl = gkyl_~a_max_abs_speed(~a ql); - double amaxr = gkyl_~a_max_abs_speed(~a qr); - - gkyl_free(fr); - gkyl_free(fl); - - return fmax(amaxl, amaxr); -} - -static bool -check_inv(const struct gkyl_wv_eqn* eqn, const double* q) -{ - return true; // All states are assumed to be valid. -} - -static double -max_speed(const struct gkyl_wv_eqn* eqn, const double* q) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - return gkyl_~a_max_abs_speed(~a q); -} - -static inline void -~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag) -{ - for (int i = 0; i < 2; i++) { - diag[i] = qin[i]; - } -} - -static inline void -~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout) -{ - for (int i = 0; i < 2; i++) { - sout[i] = 0.0; - } -} - -void -gkyl_~a_free(const struct gkyl_ref_count* ref) -{ - struct gkyl_wv_eqn* base = container_of(ref, struct gkyl_wv_eqn, ref_count); - - if (gkyl_wv_eqn_is_cu_dev(base)) { - // Free inner on_dev object. - struct wv_~a *~a = container_of(base->on_dev, struct wv_~a, eqn); - gkyl_cu_free(~a); - } - - struct wv_~a *~a = container_of(base, struct wv_~a, eqn); - gkyl_free(~a); -} - -struct gkyl_wv_eqn* -gkyl_wv_~a_new(~a bool use_gpu) -{ - return gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { - ~a - .rp_type = WV_~a_RP_LAX, - .use_gpu = use_gpu, - } - ); -} - -struct gkyl_wv_eqn* -gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp) -{ - struct wv_~a *~a = gkyl_malloc(sizeof(struct wv_~a)); - - ~a->eqn.type = GKYL_EQN_~a; - ~a->eqn.num_equations = 2; - ~a->eqn.num_diag = 2; - - ~a - - if (inp->rp_type == WV_~a_RP_LAX) { - ~a->eqn.num_waves = 2; - ~a->eqn.waves_func = wave_lax_l; - ~a->eqn.qfluct_func = qfluct_lax_l; - } - - ~a->eqn.flux_jump = flux_jump; - ~a->eqn.check_inv_func = check_inv; - ~a->eqn.max_speed_func = max_speed; - ~a->eqn.rotate_to_local_func = rot_to_local; - ~a->eqn.rotate_to_global_func = rot_to_global; - - ~a->eqn.wall_bc_func = ~a_wall; - ~a->eqn.no_slip_bc_func = ~a_no_slip; - - ~a->eqn.cons_to_riem = cons_to_riem; - ~a->eqn.riem_to_cons = riem_to_cons; - - ~a->eqn.cons_to_diag = ~a_cons_to_diag; - - ~a->eqn.source_func = ~a_source; - - ~a->eqn.flags = 0; - GKYL_CLEAR_CU_ALLOC(~a->eqn.flags); - ~a->eqn.ref_count = gkyl_ref_count_init(gkyl_~a_free); - ~a->eqn.on_dev = &~a->eqn; // On the CPU, the equation object points to itself. - - return &~a->eqn; -} -" - name - name - name - parameter-sig - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - name - parameter-sig - (list-ref flux-uis 0) - (list-ref flux-uis 1) - name - name - name - name - name - parameter-def - name - parameter-name - name - parameter-name - name - parameter-name - name - parameter-name - name - name - name - parameter-def - name - parameter-name - name - parameter-name - name - parameter-name - name - parameter-name - name - name - name - parameter-def - name - parameter-name - name - name - name - name - name - name - name - name - name - name - name - name - parameter-sig - name - name - parameter-field - (string-upcase name) - name - name - name - name - name - name - (string-upcase name) - name - name - parameter-field-set - (string-upcase name) - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - )) - code) - -;; --------------------------------------------------------------------------------------------------------------- -;; C Regression Test for Gkeyll Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; --------------------------------------------------------------------------------------------------------------- -(define (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate a Gkeyll C regression test for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Lax-Friedrichs finite-difference method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define parameters (hash-ref pde-system 'parameters)) - - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-assign (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 2))"; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-ctx-set (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - (define parameter-ctx (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = ctx." - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - - (define code - (format " -#include -#include -#include -#include - -#include -#include -#include -#include - -#include - -#ifdef GKYL_HAVE_MPI -#include -#include -#endif - -#include - -struct ~a_lax_ctx -{ - // Simulation parameters. - int Nx; // Cell count (x-direction). - double Lx; // Domain size (x-direction). - ~a - double cfl_frac; // CFL coefficient. - - double t_end; // Final simulation time. - int num_frames; // Number of output frames. - int field_energy_calcs; // Number of times to calculate field energy. - int integrated_mom_calcs; // Number of times to calculate integrated moments. - double dt_failure_tol; // Minimum allowable fraction of initial time-step. - int num_failures_max; // Maximum allowable number of consecutive small time-steps. -}; - -struct ~a_lax_ctx -create_ctx(void) -{ - // Simulation parameters. - int Nx = ~a; // Cell count (x-direction). - double Lx = ~a; // Domain size (x-direction). - ~a - double cfl_frac = ~a; // CFL coefficient. - - double t_end = ~a; // Final simulation time. - int num_frames = 1; // Number of output frames. - int field_energy_calcs = INT_MAX; // Number of times to calculate field energy. - int integrated_mom_calcs = INT_MAX; // Number of times to calculate integrated moments. - double dt_failure_tol = 1.0e-4; // Minimum allowable fraction of initial time-step. - int num_failures_max = 20; // Maximum allowable number of consecutive small time-steps. - - struct ~a_lax_ctx ctx = { - .Nx = Nx, - .Lx = Lx, - ~a - .cfl_frac = cfl_frac, - .t_end = t_end, - .num_frames = num_frames, - .field_energy_calcs = field_energy_calcs, - .integrated_mom_calcs = integrated_mom_calcs, - .dt_failure_tol = dt_failure_tol, - .num_failures_max = num_failures_max, - }; - - return ctx; -} - -void -eval~aInit(double t, const double* GKYL_RESTRICT xn, double* GKYL_RESTRICT fout, void* ctx) -{ - double x = xn[0]; - - // Set conserved quantities. - fout[0] = ~a; - fout[1] = ~a; -} - -void -write_data(struct gkyl_tm_trigger* iot, gkyl_moment_app* app, double t_curr, bool force_write) -{ - if (gkyl_tm_trigger_check_and_bump(iot, t_curr) || force_write) { - int frame = iot->curr - 1; - if (force_write) { - frame = iot->curr; - } - - gkyl_moment_app_write(app, t_curr, frame); - gkyl_moment_app_write_field_energy(app); - gkyl_moment_app_write_integrated_mom(app); - } -} - -void -calc_field_energy(struct gkyl_tm_trigger* fet, gkyl_moment_app* app, double t_curr, bool force_calc) -{ - if (gkyl_tm_trigger_check_and_bump(fet, t_curr) || force_calc) { - gkyl_moment_app_calc_field_energy(app, t_curr); - } -} - -void -calc_integrated_mom(struct gkyl_tm_trigger* imt, gkyl_moment_app* app, double t_curr, bool force_calc) -{ - if (gkyl_tm_trigger_check_and_bump(imt, t_curr) || force_calc) { - gkyl_moment_app_calc_integrated_mom(app, t_curr); - } -} - -int -main(int argc, char **argv) -{ - struct gkyl_app_args app_args = parse_app_args(argc, argv); - -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Init(&argc, &argv); - } -#endif - - if (app_args.trace_mem) { - gkyl_cu_dev_mem_debug_set(true); - gkyl_mem_debug_set(true); - } - - struct ~a_lax_ctx ctx = create_ctx(); // Context for initialization functions. - - int NX = APP_ARGS_CHOOSE(app_args.xcells[0], ctx.Nx); - - // ~a equation. - struct gkyl_wv_eqn *~a = gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { - ~a - .rp_type = WV_~a_RP_LAX, - .use_gpu = app_args.use_gpu, - } - ); - - struct gkyl_moment_species fluid = { - .name = \"~a\", - .equation = ~a, - .evolve = true, - .init = eval~aInit, - .ctx = &ctx, - }; - - int nrank = 1; // Number of processes in simulation. -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Comm_size(MPI_COMM_WORLD, &nrank); - } -#endif - - // Create global range. - int cells[] = { NX }; - int dim = sizeof(cells) / sizeof(cells[0]); - - int cuts[dim]; -#ifdef GKYL_HAVE_MPI - for (int d = 0; d < dim; d++) { - if (app_args.use_mpi) { - cuts[d] = app_args.cuts[d]; - } - else { - cuts[d] = 1; - } - } -#else - for (int d = 0; d < dim; d++) { - cuts[d] = 1; - } -#endif - - // Construct communicator for use in app. - struct gkyl_comm *comm; -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - comm = gkyl_mpi_comm_new( &(struct gkyl_mpi_comm_inp) { - .mpi_comm = MPI_COMM_WORLD, - } - ); - } - else { - comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { - .use_gpu = app_args.use_gpu - } - ); - } -#else - comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { - .use_gpu = app_args.use_gpu - } - ); -#endif - - int my_rank; - gkyl_comm_get_rank(comm, &my_rank); - int comm_size; - gkyl_comm_get_size(comm, &comm_size); - - int ncuts = 1; - for (int d = 0; d < dim; d++) { - ncuts *= cuts[d]; - } - - if (ncuts != comm_size) { - if (my_rank == 0) { - fprintf(stderr, \"*** Number of ranks, %d, does not match total cuts, %d!\\n\", comm_size, ncuts); - } - goto mpifinalize; - } - - // Moment app. - struct gkyl_moment app_inp = { - .name = \"~a_lax\", - - .ndim = 1, - .lower = { ~a }, - .upper = { ~a + ctx.Lx }, - .cells = { NX }, - - .num_periodic_dir = 0, - .periodic_dirs = { }, - .cfl_frac = ctx.cfl_frac, - - .num_species = 1, - .species = { fluid }, - - .parallelism = { - .use_gpu = app_args.use_gpu, - .cuts = { app_args.cuts[0] }, - .comm = comm, - }, - }; - - // Create app object. - gkyl_moment_app *app = gkyl_moment_app_new(&app_inp); - - // Initial and final simulation times. - double t_curr = 0.0, t_end = ctx.t_end; - - // Initialize simulation. - int frame_curr = 0; - if (app_args.is_restart) { - struct gkyl_app_restart_status status = gkyl_moment_app_read_from_frame(app, app_args.restart_frame); - - if (status.io_status != GKYL_ARRAY_RIO_SUCCESS) { - gkyl_moment_app_cout(app, stderr, \"*** Failed to read restart file! (%s)\\n\", gkyl_array_rio_status_msg(status.io_status)); - goto freeresources; - } - - frame_curr = status.frame; - t_curr = status.stime; - - gkyl_moment_app_cout(app, stdout, \"Restarting from frame %d\", frame_curr); - gkyl_moment_app_cout(app, stdout, \" at time = %g\\n\", t_curr); - } - else { - gkyl_moment_app_apply_ic(app, t_curr); - } - - // Create trigger for field energy. - int field_energy_calcs = ctx.field_energy_calcs; - struct gkyl_tm_trigger fe_trig = { .dt = t_end / field_energy_calcs, .tcurr = t_curr, .curr = frame_curr }; - - calc_field_energy(&fe_trig, app, t_curr, false); - - // Create trigger for integrated moments. - int integrated_mom_calcs = ctx.integrated_mom_calcs; - struct gkyl_tm_trigger im_trig = { .dt = t_end / integrated_mom_calcs, .tcurr = t_curr, .curr = frame_curr }; - - calc_integrated_mom(&im_trig, app, t_curr, false); - - // Create trigger for IO. - int num_frames = ctx.num_frames; - struct gkyl_tm_trigger io_trig = { .dt = t_end / num_frames, .tcurr = t_curr, .curr = frame_curr }; - - write_data(&io_trig, app, t_curr, false); - - // Compute initial guess of maximum stable time-step. - double dt = t_end - t_curr; - - // Initialize small time-step check. - double dt_init = -1.0, dt_failure_tol = ctx.dt_failure_tol; - int num_failures = 0, num_failures_max = ctx.num_failures_max; - - long step = 1; - while ((t_curr < t_end) && (step <= app_args.num_steps)) { - gkyl_moment_app_cout(app, stdout, \"Taking time-step %ld at t = %g ...\", step, t_curr); - struct gkyl_update_status status = gkyl_moment_update(app, dt); - gkyl_moment_app_cout(app, stdout, \" dt = %g\\n\", status.dt_actual); - - if (!status.success) { - gkyl_moment_app_cout(app, stdout, \"** Update method failed! Aborting simulation ....\\n\"); - break; - } - - t_curr += status.dt_actual; - dt = status.dt_suggested; - - calc_field_energy(&fe_trig, app, t_curr, false); - calc_integrated_mom(&im_trig, app, t_curr, false); - write_data(&io_trig, app, t_curr, false); - - if (dt_init < 0.0) { - dt_init = status.dt_actual; - } - else if (status.dt_actual < dt_failure_tol * dt_init) { - num_failures += 1; - - gkyl_moment_app_cout(app, stdout, \"WARNING: Time-step dt = %g\", status.dt_actual); - gkyl_moment_app_cout(app, stdout, \" is below %g*dt_init ...\", dt_failure_tol); - gkyl_moment_app_cout(app, stdout, \" num_failures = %d\\n\", num_failures); - if (num_failures >= num_failures_max) { - gkyl_moment_app_cout(app, stdout, \"ERROR: Time-step was below %g*dt_init \", dt_failure_tol); - gkyl_moment_app_cout(app, stdout, \"%d consecutive times. Aborting simulation ....\\n\", num_failures_max); - - calc_field_energy(&fe_trig, app, t_curr, true); - calc_integrated_mom(&im_trig, app, t_curr, true); - write_data(&io_trig, app, t_curr, true); - - break; - } - } - else { - num_failures = 0; - } - - step += 1; - } - - calc_field_energy(&fe_trig, app, t_curr, false); - calc_integrated_mom(&im_trig, app, t_curr, false); - write_data(&io_trig, app, t_curr, false); - gkyl_moment_app_stat_write(app); - - struct gkyl_moment_stat stat = gkyl_moment_app_stat(app); - - gkyl_moment_app_cout(app, stdout, \"\\n\"); - gkyl_moment_app_cout(app, stdout, \"Number of update calls %ld\\n\", stat.nup); - gkyl_moment_app_cout(app, stdout, \"Number of failed time-steps %ld\\n\", stat.nfail); - gkyl_moment_app_cout(app, stdout, \"Species updates took %g secs\\n\", stat.species_tm); - gkyl_moment_app_cout(app, stdout, \"Field updates took %g secs\\n\", stat.field_tm); - gkyl_moment_app_cout(app, stdout, \"Source updates took %g secs\\n\", stat.sources_tm); - gkyl_moment_app_cout(app, stdout, \"Total updates took %g secs\\n\", stat.total_tm); - -freeresources: - // Free resources after simulation completion. - gkyl_wv_eqn_release(~a); - gkyl_comm_release(comm); - gkyl_moment_app_release(app); - -mpifinalize: -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Finalize(); - } -#endif - - return 0; -} - -" - name - name - parameter-def - name - nx - (- x1 x0) - parameter-assign - cfl - t-final - name - parameter-ctx-set - (string-titlecase name) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - name - name - name - name - name - parameter-ctx - (string-upcase name) - name - name - (string-titlecase name) - name - x0 - x0 - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/gkyl_code_generator_roe.rkt b/provable-algorithms/gkyl_code_generator_roe.rkt deleted file mode 100644 index fcb7d2d5..00000000 --- a/provable-algorithms/gkyl_code_generator_roe.rkt +++ /dev/null @@ -1,1261 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "prover_core.rkt") -(provide gkyl-generate-roe-scalar-1d-header - gkyl-generate-roe-scalar-1d-priv-header - gkyl-generate-roe-scalar-1d-source - gkyl-generate-roe-scalar-1d-regression) - -;; ---------------------------------------------------------------- -;; Header for Gkeyll Roe (Finite-Volume) Solver for a 1D Scalar PDE -;; ---------------------------------------------------------------- -(define (gkyl-generate-roe-scalar-1d-header pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate Gkeyll C header code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define parameters (hash-ref pde 'parameters)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-comment (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) - parameters) "\n")] - [else "*"])) - - (define code - (format " -#pragma once - -#include - -// Type of Riemann-solver to use: -enum gkyl_wv_~a_rp { - WV_~a_RP_ROE = 0, // Default (Roe fluxes). -}; - -// Input context, packaged as a struct. -struct gkyl_wv_~a_inp { - ~a - - enum gkyl_wv_~a_rp rp_type; // Type of Riemann-solver to use. - bool use_gpu; // Whether the wave equation object is on the host (false) or the device (true). -}; - -/** -* Create a new ~a equations object. -* -~a -* @param use_gpu Whether the wave equation object is on the host (false) or the device (true). -* @return Pointer to the ~a equations object. -*/ -struct gkyl_wv_eqn* -gkyl_wv_~a_new(~a bool use_gpu); - -/** -* Create a new ~a equations object, from an input context struct. -* -* @param inp Input context struct. -* @return Pointer to the ~a equations object. -*/ -struct gkyl_wv_eqn* -gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp); -" - name - (string-upcase name) - name - parameter-def - name - name - parameter-comment - name - name - parameter-sig - name - name - name - name - )) - code) - -;; ------------------------------------------------------------------------ -;; Private Header for Gkeyll Roe (Finite-Volume) Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------ -(define (gkyl-generate-roe-scalar-1d-priv-header pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate Gkeyll C private header code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define parameters (hash-ref pde 'parameters)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-comment (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) - parameters) "\n")] - [else "*"])) - - (define code - (format " -#pragma once - -// Private header, not for direct use in user-facing code. - -#include -#include -#include -#include -#include -#include - -struct wv_~a { - struct gkyl_wv_eqn eqn; // Base equation object. - ~a -}; - -/** -* Compute maximum absolute wave speed. -* -~a -* @param q Conserved variable vector. -* @return Maximum absolute wave speed for a given q. -*/ -GKYL_CU_D -static inline double -gkyl_~a_max_abs_speed(~a const double* q); - -/** -* Compute flux vector. Assumes rotation to local coordinate system. -* -~a -* @param q Conserved variable vector. -* @param flux Flux vector in direction 'dir' (output). -*/ -GKYL_CU_D -void -gkyl_~a_flux(~a const double* q, double* flux); - -/** -* Compute eigenvalues of the flux Jacobian. Assumes rotation to local coordinate system. -* -~a -* @param q Conserved variable vector. -* @param flux_deriv Flux Jacobian eigenvalues in direction 'dir' (output). -*/ -GKYL_CU_D -void -gkyl_~a_flux_deriv(~a const double* q, double* flux_deriv); - -/** -* Compute Riemann variables given the conserved variables. -* -* @param eqn Base equation object. -* @param qstate Current state vector. -* @param qin Conserved variable vector (input). -* @param wout Riemann variable vector (output). -*/ -GKYL_CU_D -static inline void -cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout); - -/** -* Compute conserved variables given the Riemann variables. -* -* @param eqn Base equation object. -* @param qstate Current state vector. -* @param win Riemann variable vector (input). -* @param qout Conserved variable vector (output). -*/ -GKYL_CU_D -static inline void -riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double *qout); - -/** -* Boundary condition function for applying wall boundary conditions for the ~a equations. -* -* @param eqn Base equation object. -* @param t Current simulation time. -* @param nc Number of boundary cells to which to apply wall boundary conditions. -* @param skin Skin cells in boundary region (from which values are copied). -* @param ghost Ghost cells in boundary region (to which values are copied). -* @param ctx Context to pass to the function. -*/ -GKYL_CU_D -static void -~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); - -/** -* Boundary condition function for applying no-slip boundary conditions for the ~a equations. -* -* @param eqn Base equation object. -* @param t Current simulation time. -* @param nc Number of boundary cells to which to apply no-slip boundary conditions. -* @param skin Skin cells in boundary region (from which values are copied). -* @param ghost Ghost cells in boundary region (to which values are copied). -* @param ctx Context to pass to the function. -*/ -GKYL_CU_D -static void -~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); - -/** -* Rotate state vector from global to local coordinate frame. -* -* @param eqn Base equation object. -* @param tau1 First tangent vector of the coordinate frame. -* @param tau2 Second tangent vector of the coordinate frame. -* @param norm Normal vector of the coordinate frame. -* @param qglobal State vector in global coordinate frame (input). -* @param qlocal State vector in local coordinate frame (output). -*/ -GKYL_CU_D -static inline void -rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, - double* GKYL_RESTRICT qlocal); - -/** -* Rotate state vector from local to global coordinate frame. -* -* @param eqn Base equation object. -* @param tau1 First tangent vector of the coordinate frame. -* @param tau2 Second tangent vector of the coordinate frame. -* @param norm Normal vector of the coordinate frame. -* @param qlocal State vector in local coordinate frame (input). -* @param qglobal State vector in global coordinate frame (output). -*/ -GKYL_CU_D -static inline void -rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, - double* GKYL_RESTRICT qglobal); - -/** -* Compute waves and speeds using Roe fluxes. -* -* @param eqn Base equation object. -* @param delta Jump across interface to split. -* @param ql Conserved variables on the left of the interface. -* @param qr Conserved variables on the right of the interface. -* @param waves Waves (output). -* @param s Wave speeds (output). -* @return Maximum wave speed. -*/ -GKYL_CU_D -static double -wave_roe(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s); - -/** -* Compute fluctuations using Roe fluxes. -* -* @param eqn Base equation object. -* @param ql Conserved variable vector on the left of the interface. -* @param qr Conserved variable vector on the right of the interface. -* @param waves Waves (input). -* @param s Wave speeds (input). -* @param amdq Left-moving fluctuations (output). -* @param apdq Right-moving fluctuations (output). -*/ -GKYL_CU_D -static void -qfluct_roe(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq); - -/** -* Compute waves and speeds using Roe fluxes (with potential fallback). -* -* @param eqn Base equation object. -* @param type Type of Riemann-solver flux to use. -* @param delta Jump across interface to split. -* @param ql Conserved variables on the left of the interface. -* @param qr Conserved variables on the right of the interface. -* @param waves Waves (output). -* @param s Wave speeds (output). -* @return Maximum wave speed. -*/ -GKYL_CU_D -static double -wave_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s); - -/** -* Compute fluctuations using Roe fluxes (with potential fallback), -* -* @param eqn Base equation object. -* @param type Type of Riemann-solver flux to use. -* @param ql Conserved variable vector on the left of the interface. -* @param qr Conserved variable vector on the right of the interface. -* @param waves Waves (input). -* @param s Wave speeds (input). -* @param amdq Left-moving fluctuations (output). -* @param apdq Right-moving fluctuations (output). -*/ -GKYL_CU_D -static void -qfluct_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, - double* amdq, double* apdq); - -/** -* Compute jump in flux given two conserved variable states. -* -* @param eqn Base equation object. -* @param ql Conserved variable vector on the left of the interface (input). -* @param qr Conserved variable vector on the right of the interface (input). -* @param flux_jump Jump in flux vector (output). -* @return Maximum wave speeds for states ql and qr. -*/ -GKYL_CU_D -static double -flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump); - -/** -* Determine whether invariant domain of the ~a equations is satisfied. -* -* @param eqn Base equation object. -* @param q Conserved variable vector. -* @return Whether the invariant domain is satisfied. -*/ -GKYL_CU_D -static bool -check_inv(const struct gkyl_wv_eqn* eqn, const double* q); - -/** -* Compute maximum wave speed from a conserved variable vector. -* -* @param eqn Base equation object. -* @param q Conserved variable vector. -* @return Maximum absolute wave speed. -*/ -GKYL_CU_D -static double -max_speed(const struct gkyl_wv_eqn* eqn, const double* q); - -/** -* Convert conserved variables to diagnostic variables. -* -* @param eqn Base equation object. -* @param qin Conserved variable vector (input). -* @param diag Diagnostic variable vector (output). -*/ -GKYL_CU_D -static inline void -~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag); - -/** -* Compute forcing/source term vector from conserved variable vector. -* -* @param eqn Base equation object. -* @param qin Conserved variable vector (input). -* @param sout Forcing/source term vector (output). -*/ -GKYL_CU_DH -static inline void -~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout); - -/** -* Free ~a equations object. -* -* @param ref Reference counter for ~a equations. -*/ -void -gkyl_~a_free(const struct gkyl_ref_count* ref); -" - name - parameter-def - parameter-comment - name - parameter-sig - parameter-comment - name - parameter-sig - parameter-comment - name - parameter-sig - name - name - name - name - name - name - name - name - name - name - )) - code) - -;; ---------------------------------------------------------------- -;; Source for Gkeyll Roe (Finite-Volume) Solver for a 1D Scalar PDE -;; ---------------------------------------------------------------- -(define (gkyl-generate-roe-scalar-1d-source pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate Gkeyll C source code that solves the 1D scalar PDE specified by `pde` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) - - (define cons-code (convert-expr cons-expr)) - (define flux-code (convert-expr flux-expr)) - (define flux-deriv-code (convert-expr flux-deriv)) - (define max-speed-code (convert-expr max-speed-expr)) - (define init-func-code (convert-expr init-func)) - - (define max-speed-local (flux-substitute max-speed-code cons-code "q[0]")) - (define flux-ui (flux-substitute flux-code cons-code "q[0]")) - (define flux-deriv-ui (flux-substitute flux-deriv-code cons-code "q[0]")) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) " = " - name "->" (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-name (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-field (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - (define parameter-field-set (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append name "->" (convert-expr (list-ref parameter 1)) - " = inp->" (convert-expr (list-ref parameter 1)) ";")) - parameters) "\n")] - [else ""])) - - (define code - (format " -#include -#include - -#include -#include -#include -#include - -static inline double -gkyl_~a_max_abs_speed(~a const double* q) -{ - return ~a; -} - -void -gkyl_~a_flux(~a const double* q, double* flux) -{ - flux[0] = ~a; -} - -void -gkyl_~a_flux_deriv(~a const double* q, double* flux_deriv) -{ - flux_deriv[0] = ~a; -} - -static inline void -cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout) -{ - // TODO: This should use a proper L matrix. - wout[0] = qin[0]; -} - -static inline void -riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double* qout) -{ - // TODO: This should use a proper L matrix. - qout[0] = win[0]; -} - -static void -~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) -{ - ghost[0] = skin[0]; -} - -static void -~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) -{ - ghost[0] = skin[0]; -} - -static inline void -rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, - double* GKYL_RESTRICT qlocal) -{ - qlocal[0] = qglobal[0]; -} - -static inline void -rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, - double* GKYL_RESTRICT qglobal) -{ - qglobal[0] = qlocal[0]; -} - -static double -wave_roe(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - double *fl_deriv = gkyl_malloc(sizeof(double)); - double *fr_deriv = gkyl_malloc(sizeof(double)); - gkyl_~a_flux_deriv(~a ql, fl_deriv); - gkyl_~a_flux_deriv(~a qr, fr_deriv); - - double a_roe = 0.5 * (fl_deriv[0] + fr_deriv[0]); - - double *w0 = &waves[0]; - w0[0] = delta[0]; - - s[0] = a_roe; - - gkyl_free(fl_deriv); - gkyl_free(fr_deriv); - - return s[0]; -} - -static void -qfluct_roe(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq) -{ - const double *w0 = &waves[0]; - - if (s[0] < 0.0) { - amdq[0] = s[0] * w0[0]; - apdq[0] = 0.0; - } - else { - amdq[0] = 0.0; - apdq[0] = s[0] * w0[0]; - } -} - -static double -wave_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s) -{ - return wave_roe(eqn, delta, ql, qr, waves, s); -} - -static void -qfluct_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, - double* amdq, double* apdq) -{ - return qfluct_roe(eqn, ql, qr, waves, s, amdq, apdq); -} - -static double -flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - double *fr = gkyl_malloc(sizeof(double)); - double *fl = gkyl_malloc(sizeof(double)); - gkyl_~a_flux(~a ql, fl); - gkyl_~a_flux(~a qr, fr); - - flux_jump[0] = fr[0] - fl[0]; - - double amaxl = gkyl_~a_max_abs_speed(~a ql); - double amaxr = gkyl_~a_max_abs_speed(~a qr); - - gkyl_free(fr); - gkyl_free(fl); - - return fmax(amaxl, amaxr); -} - -static bool -check_inv(const struct gkyl_wv_eqn* eqn, const double* q) -{ - return true; // All states are assumed to be valid. -} - -static double -max_speed(const struct gkyl_wv_eqn* eqn, const double* q) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - return gkyl_~a_max_abs_speed(~a q); -} - -static inline void -~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag) -{ - diag[0] = qin[0]; -} - -static inline void -~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout) -{ - sout[0] = 0.0; -} - -void -gkyl_~a_free(const struct gkyl_ref_count* ref) -{ - struct gkyl_wv_eqn* base = container_of(ref, struct gkyl_wv_eqn, ref_count); - - if (gkyl_wv_eqn_is_cu_dev(base)) { - // Free inner on_dev object. - struct wv_~a *~a = container_of(base->on_dev, struct wv_~a, eqn); - gkyl_cu_free(~a); - } - - struct wv_~a *~a = container_of(base, struct wv_~a, eqn); - gkyl_free(~a); -} - -struct gkyl_wv_eqn* -gkyl_wv_~a_new(~a bool use_gpu) -{ - return gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { - ~a - .rp_type = WV_~a_RP_ROE, - .use_gpu = use_gpu, - } - ); -} - -struct gkyl_wv_eqn* -gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp) -{ - struct wv_~a *~a = gkyl_malloc(sizeof(struct wv_~a)); - - ~a->eqn.type = GKYL_EQN_~a; - ~a->eqn.num_equations = 1; - ~a->eqn.num_diag = 1; - - ~a - - if (inp->rp_type == WV_~a_RP_ROE) { - ~a->eqn.num_waves = 1; - ~a->eqn.waves_func = wave_roe_l; - ~a->eqn.qfluct_func = qfluct_roe_l; - } - - ~a->eqn.flux_jump = flux_jump; - ~a->eqn.check_inv_func = check_inv; - ~a->eqn.max_speed_func = max_speed; - ~a->eqn.rotate_to_local_func = rot_to_local; - ~a->eqn.rotate_to_global_func = rot_to_global; - - ~a->eqn.wall_bc_func = ~a_wall; - ~a->eqn.no_slip_bc_func = ~a_no_slip; - - ~a->eqn.cons_to_riem = cons_to_riem; - ~a->eqn.riem_to_cons = riem_to_cons; - - ~a->eqn.cons_to_diag = ~a_cons_to_diag; - - ~a->eqn.source_func = ~a_source; - - ~a->eqn.flags = 0; - GKYL_CLEAR_CU_ALLOC(~a->eqn.flags); - ~a->eqn.ref_count = gkyl_ref_count_init(gkyl_~a_free); - ~a->eqn.on_dev = &~a->eqn; // On the CPU, the equation object points to itself. - - return &~a->eqn; -} -" - name - name - name - parameter-sig - max-speed-local - name - parameter-sig - flux-ui - name - parameter-sig - flux-deriv-ui - name - name - name - name - name - parameter-def - name - parameter-name - name - parameter-name - name - name - name - parameter-def - name - parameter-name - name - parameter-name - name - parameter-name - name - parameter-name - name - name - name - parameter-def - name - parameter-name - name - name - name - name - name - name - name - name - name - name - name - name - parameter-sig - name - name - parameter-field - (string-upcase name) - name - name - name - name - name - name - (string-upcase name) - name - name - parameter-field-set - (string-upcase name) - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - )) - code) - -;; --------------------------------------------------------------------------- -;; C Regression Test for Gkeyll Roe (Finite-Volume) Solver for a 1D Scalar PDE -;; --------------------------------------------------------------------------- -(define (gkyl-generate-roe-scalar-1d-regression pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Generate a Gkeyll C regression test for the 1D scalar PDE specified by `pde` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define name (hash-ref pde 'name)) - (define parameters (hash-ref pde 'parameters)) - - (define init-func-code (convert-expr init-func)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-assign (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 2))"; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-ctx-set (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - (define parameter-ctx (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = ctx." - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - - (define code - (format " -#include -#include -#include -#include - -#include -#include -#include -#include - -#include - -#ifdef GKYL_HAVE_MPI -#include -#include -#endif - -#include - -struct ~a_roe_ctx -{ - // Simulation parameters. - int Nx; // Cell count (x-direction). - double Lx; // Domain size (x-direction). - ~a - double cfl_frac; // CFL coefficient. - - double t_end; // Final simulation time. - int num_frames; // Number of output frames. - int field_energy_calcs; // Number of times to calculate field energy. - int integrated_mom_calcs; // Number of times to calculate integrated moments. - double dt_failure_tol; // Minimum allowable fraction of initial time-step. - int num_failures_max; // Maximum allowable number of consecutive small time-steps. -}; - -struct ~a_roe_ctx -create_ctx(void) -{ - // Simulation parameters. - int Nx = ~a; // Cell count (x-direction). - double Lx = ~a; // Domain size (x-direction). - ~a - double cfl_frac = ~a; // CFL coefficient. - - double t_end = ~a; // Final simulation time. - int num_frames = 1; // Number of output frames. - int field_energy_calcs = INT_MAX; // Number of times to calculate field energy. - int integrated_mom_calcs = INT_MAX; // Number of times to calculate integrated moments. - double dt_failure_tol = 1.0e-4; // Minimum allowable fraction of initial time-step. - int num_failures_max = 20; // Maximum allowable number of consecutive small time-steps. - - struct ~a_roe_ctx ctx = { - .Nx = Nx, - .Lx = Lx, - ~a - .cfl_frac = cfl_frac, - .t_end = t_end, - .num_frames = num_frames, - .field_energy_calcs = field_energy_calcs, - .integrated_mom_calcs = integrated_mom_calcs, - .dt_failure_tol = dt_failure_tol, - .num_failures_max = num_failures_max, - }; - - return ctx; -} - -void -eval~aInit(double t, const double* GKYL_RESTRICT xn, double* GKYL_RESTRICT fout, void* ctx) -{ - double x = xn[0]; - - // Set conserved quantity. - fout[0] = ~a; -} - -void -write_data(struct gkyl_tm_trigger* iot, gkyl_moment_app* app, double t_curr, bool force_write) -{ - if (gkyl_tm_trigger_check_and_bump(iot, t_curr) || force_write) { - int frame = iot->curr - 1; - if (force_write) { - frame = iot->curr; - } - - gkyl_moment_app_write(app, t_curr, frame); - gkyl_moment_app_write_field_energy(app); - gkyl_moment_app_write_integrated_mom(app); - } -} - -void -calc_field_energy(struct gkyl_tm_trigger* fet, gkyl_moment_app* app, double t_curr, bool force_calc) -{ - if (gkyl_tm_trigger_check_and_bump(fet, t_curr) || force_calc) { - gkyl_moment_app_calc_field_energy(app, t_curr); - } -} - -void -calc_integrated_mom(struct gkyl_tm_trigger* imt, gkyl_moment_app* app, double t_curr, bool force_calc) -{ - if (gkyl_tm_trigger_check_and_bump(imt, t_curr) || force_calc) { - gkyl_moment_app_calc_integrated_mom(app, t_curr); - } -} - -int -main(int argc, char **argv) -{ - struct gkyl_app_args app_args = parse_app_args(argc, argv); - -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Init(&argc, &argv); - } -#endif - - if (app_args.trace_mem) { - gkyl_cu_dev_mem_debug_set(true); - gkyl_mem_debug_set(true); - } - - struct ~a_roe_ctx ctx = create_ctx(); // Context for initialization functions. - - int NX = APP_ARGS_CHOOSE(app_args.xcells[0], ctx.Nx); - - // ~a equation. - struct gkyl_wv_eqn *~a = gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { - ~a - .rp_type = WV_~a_RP_ROE, - .use_gpu = app_args.use_gpu, - } - ); - - struct gkyl_moment_species fluid = { - .name = \"~a\", - .equation = ~a, - .evolve = true, - .init = eval~aInit, - .ctx = &ctx, - }; - - int nrank = 1; // Number of processes in simulation. -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Comm_size(MPI_COMM_WORLD, &nrank); - } -#endif - - // Create global range. - int cells[] = { NX }; - int dim = sizeof(cells) / sizeof(cells[0]); - - int cuts[dim]; -#ifdef GKYL_HAVE_MPI - for (int d = 0; d < dim; d++) { - if (app_args.use_mpi) { - cuts[d] = app_args.cuts[d]; - } - else { - cuts[d] = 1; - } - } -#else - for (int d = 0; d < dim; d++) { - cuts[d] = 1; - } -#endif - - // Construct communicator for use in app. - struct gkyl_comm *comm; -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - comm = gkyl_mpi_comm_new( &(struct gkyl_mpi_comm_inp) { - .mpi_comm = MPI_COMM_WORLD, - } - ); - } - else { - comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { - .use_gpu = app_args.use_gpu - } - ); - } -#else - comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { - .use_gpu = app_args.use_gpu - } - ); -#endif - - int my_rank; - gkyl_comm_get_rank(comm, &my_rank); - int comm_size; - gkyl_comm_get_size(comm, &comm_size); - - int ncuts = 1; - for (int d = 0; d < dim; d++) { - ncuts *= cuts[d]; - } - - if (ncuts != comm_size) { - if (my_rank == 0) { - fprintf(stderr, \"*** Number of ranks, %d, does not match total cuts, %d!\\n\", comm_size, ncuts); - } - goto mpifinalize; - } - - // Moment app. - struct gkyl_moment app_inp = { - .name = \"~a_roe\", - - .ndim = 1, - .lower = { ~a }, - .upper = { ~a + ctx.Lx }, - .cells = { NX }, - - .num_periodic_dir = 0, - .periodic_dirs = { }, - .cfl_frac = ctx.cfl_frac, - - .num_species = 1, - .species = { fluid }, - - .parallelism = { - .use_gpu = app_args.use_gpu, - .cuts = { app_args.cuts[0] }, - .comm = comm, - }, - }; - - // Create app object. - gkyl_moment_app *app = gkyl_moment_app_new(&app_inp); - - // Initial and final simulation times. - double t_curr = 0.0, t_end = ctx.t_end; - - // Initialize simulation. - int frame_curr = 0; - if (app_args.is_restart) { - struct gkyl_app_restart_status status = gkyl_moment_app_read_from_frame(app, app_args.restart_frame); - - if (status.io_status != GKYL_ARRAY_RIO_SUCCESS) { - gkyl_moment_app_cout(app, stderr, \"*** Failed to read restart file! (%s)\\n\", gkyl_array_rio_status_msg(status.io_status)); - goto freeresources; - } - - frame_curr = status.frame; - t_curr = status.stime; - - gkyl_moment_app_cout(app, stdout, \"Restarting from frame %d\", frame_curr); - gkyl_moment_app_cout(app, stdout, \" at time = %g\\n\", t_curr); - } - else { - gkyl_moment_app_apply_ic(app, t_curr); - } - - // Create trigger for field energy. - int field_energy_calcs = ctx.field_energy_calcs; - struct gkyl_tm_trigger fe_trig = { .dt = t_end / field_energy_calcs, .tcurr = t_curr, .curr = frame_curr }; - - calc_field_energy(&fe_trig, app, t_curr, false); - - // Create trigger for integrated moments. - int integrated_mom_calcs = ctx.integrated_mom_calcs; - struct gkyl_tm_trigger im_trig = { .dt = t_end / integrated_mom_calcs, .tcurr = t_curr, .curr = frame_curr }; - - calc_integrated_mom(&im_trig, app, t_curr, false); - - // Create trigger for IO. - int num_frames = ctx.num_frames; - struct gkyl_tm_trigger io_trig = { .dt = t_end / num_frames, .tcurr = t_curr, .curr = frame_curr }; - - write_data(&io_trig, app, t_curr, false); - - // Compute initial guess of maximum stable time-step. - double dt = t_end - t_curr; - - // Initialize small time-step check. - double dt_init = -1.0, dt_failure_tol = ctx.dt_failure_tol; - int num_failures = 0, num_failures_max = ctx.num_failures_max; - - long step = 1; - while ((t_curr < t_end) && (step <= app_args.num_steps)) { - gkyl_moment_app_cout(app, stdout, \"Taking time-step %ld at t = %g ...\", step, t_curr); - struct gkyl_update_status status = gkyl_moment_update(app, dt); - gkyl_moment_app_cout(app, stdout, \" dt = %g\\n\", status.dt_actual); - - if (!status.success) { - gkyl_moment_app_cout(app, stdout, \"** Update method failed! Aborting simulation ....\\n\"); - break; - } - - t_curr += status.dt_actual; - dt = status.dt_suggested; - - calc_field_energy(&fe_trig, app, t_curr, false); - calc_integrated_mom(&im_trig, app, t_curr, false); - write_data(&io_trig, app, t_curr, false); - - if (dt_init < 0.0) { - dt_init = status.dt_actual; - } - else if (status.dt_actual < dt_failure_tol * dt_init) { - num_failures += 1; - - gkyl_moment_app_cout(app, stdout, \"WARNING: Time-step dt = %g\", status.dt_actual); - gkyl_moment_app_cout(app, stdout, \" is below %g*dt_init ...\", dt_failure_tol); - gkyl_moment_app_cout(app, stdout, \" num_failures = %d\\n\", num_failures); - if (num_failures >= num_failures_max) { - gkyl_moment_app_cout(app, stdout, \"ERROR: Time-step was below %g*dt_init \", dt_failure_tol); - gkyl_moment_app_cout(app, stdout, \"%d consecutive times. Aborting simulation ....\\n\", num_failures_max); - - calc_field_energy(&fe_trig, app, t_curr, true); - calc_integrated_mom(&im_trig, app, t_curr, true); - write_data(&io_trig, app, t_curr, true); - - break; - } - } - else { - num_failures = 0; - } - - step += 1; - } - - calc_field_energy(&fe_trig, app, t_curr, false); - calc_integrated_mom(&im_trig, app, t_curr, false); - write_data(&io_trig, app, t_curr, false); - gkyl_moment_app_stat_write(app); - - struct gkyl_moment_stat stat = gkyl_moment_app_stat(app); - - gkyl_moment_app_cout(app, stdout, \"\\n\"); - gkyl_moment_app_cout(app, stdout, \"Number of update calls %ld\\n\", stat.nup); - gkyl_moment_app_cout(app, stdout, \"Number of failed time-steps %ld\\n\", stat.nfail); - gkyl_moment_app_cout(app, stdout, \"Species updates took %g secs\\n\", stat.species_tm); - gkyl_moment_app_cout(app, stdout, \"Field updates took %g secs\\n\", stat.field_tm); - gkyl_moment_app_cout(app, stdout, \"Source updates took %g secs\\n\", stat.sources_tm); - gkyl_moment_app_cout(app, stdout, \"Total updates took %g secs\\n\", stat.total_tm); - -freeresources: - // Free resources after simulation completion. - gkyl_wv_eqn_release(~a); - gkyl_comm_release(comm); - gkyl_moment_app_release(app); - -mpifinalize: -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Finalize(); - } -#endif - - return 0; -} - -" - name - name - parameter-def - name - nx - (- x1 x0) - parameter-assign - cfl - t-final - name - parameter-ctx-set - (string-titlecase name) - init-func-code - name - name - name - name - name - parameter-ctx - (string-upcase name) - name - name - (string-titlecase name) - name - x0 - x0 - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/gkyl_code_generator_roe_vector.rkt b/provable-algorithms/gkyl_code_generator_roe_vector.rkt deleted file mode 100644 index df448586..00000000 --- a/provable-algorithms/gkyl_code_generator_roe_vector.rkt +++ /dev/null @@ -1,1335 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide gkyl-generate-roe-vector2-1d-header - gkyl-generate-roe-vector2-1d-priv-header - gkyl-generate-roe-vector2-1d-source - gkyl-generate-roe-vector2-1d-regression) - -;; ------------------------------------------------------------------------------------- -;; Header for Gkeyll Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------------------------- -(define (gkyl-generate-roe-vector2-1d-header pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate Gkeyll C header code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define parameters (hash-ref pde-system 'parameters)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-comment (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) - parameters) "\n")] - [else "*"])) - - (define code - (format " -#pragma once - -#include - -// Type of Riemann-solver to use: -enum gkyl_wv_~a_rp { - WV_~a_RP_ROE = 0, // Default (Roe fluxes). -}; - -// Input context, packaged as a struct. -struct gkyl_wv_~a_inp { - ~a - - enum gkyl_wv_~a_rp rp_type; // Type of Riemann-solver to use. - bool use_gpu; // Whether the wave equation object is on the host (false) or the device (true). -}; - -/** -* Create a new ~a equations object. -* -~a -* @param use_gpu Whether the wave equation object is on the host (false) or the device (true). -* @return Pointer to the ~a equations object. -*/ -struct gkyl_wv_eqn* -gkyl_wv_~a_new(~a bool use_gpu); - -/** -* Create a new ~a equations object, from an input context struct. -* -* @param inp Input context struct. -* @return Pointer to the ~a equations object. -*/ -struct gkyl_wv_eqn* -gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp); -" - name - (string-upcase name) - name - parameter-def - name - name - parameter-comment - name - name - parameter-sig - name - name - name - name - )) - code) - -;; --------------------------------------------------------------------------------------------- -;; Private Header for Gkeyll Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; --------------------------------------------------------------------------------------------- -(define (gkyl-generate-roe-vector2-1d-priv-header pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate Gkeyll C private header code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define parameters (hash-ref pde-system 'parameters)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-comment (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "* @param " (convert-expr (list-ref parameter 1)) " Additional simulation parameter.")) - parameters) "\n")] - [else "*"])) - - (define code - (format " -#pragma once - -// Private header, not for direct use in user-facing code. - -#include -#include -#include -#include -#include -#include - -struct wv_~a { - struct gkyl_wv_eqn eqn; // Base equation object. - ~a -}; - -/** -* Compute maximum absolute wave speed. -* -~a -* @param q Conserved variable vector. -* @return Maximum absolute wave speed for a given q. -*/ -GKYL_CU_D -static inline double -gkyl_~a_max_abs_speed(~a const double* q); - -/** -* Compute flux vector. Assumes rotation to local coordinate system. -* -~a -* @param q Conserved variable vector. -* @param flux Flux vector in direction 'dir' (output). -*/ -GKYL_CU_D -void -gkyl_~a_flux(~a const double* q, double* flux); - -/** -* Compute eigenvalues of the flux Jacobian. Assumes rotation to local coordinate system. -* -~a -* @param q Conserved variable vector. -* @param flux_deriv Flux Jacobian eigenvalues in direction 'dir' (output). -*/ -GKYL_CU_D -void -gkyl_~a_flux_deriv(~a const double* q, double* flux_deriv); - -/** -* Compute Riemann variables given the conserved variables. -* -* @param eqn Base equation object. -* @param qstate Current state vector. -* @param qin Conserved variable vector (input). -* @param wout Riemann variable vector (output). -*/ -GKYL_CU_D -static inline void -cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout); - -/** -* Compute conserved variables given the Riemann variables. -* -* @param eqn Base equation object. -* @param qstate Current state vector. -* @param win Riemann variable vector (input). -* @param qout Conserved variable vector (output). -*/ -GKYL_CU_D -static inline void -riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double *qout); - -/** -* Boundary condition function for applying wall boundary conditions for the ~a equations. -* -* @param eqn Base equation object. -* @param t Current simulation time. -* @param nc Number of boundary cells to which to apply wall boundary conditions. -* @param skin Skin cells in boundary region (from which values are copied). -* @param ghost Ghost cells in boundary region (to which values are copied). -* @param ctx Context to pass to the function. -*/ -GKYL_CU_D -static void -~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); - -/** -* Boundary condition function for applying no-slip boundary conditions for the ~a equations. -* -* @param eqn Base equation object. -* @param t Current simulation time. -* @param nc Number of boundary cells to which to apply no-slip boundary conditions. -* @param skin Skin cells in boundary region (from which values are copied). -* @param ghost Ghost cells in boundary region (to which values are copied). -* @param ctx Context to pass to the function. -*/ -GKYL_CU_D -static void -~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx); - -/** -* Rotate state vector from global to local coordinate frame. -* -* @param eqn Base equation object. -* @param tau1 First tangent vector of the coordinate frame. -* @param tau2 Second tangent vector of the coordinate frame. -* @param norm Normal vector of the coordinate frame. -* @param qglobal State vector in global coordinate frame (input). -* @param qlocal State vector in local coordinate frame (output). -*/ -GKYL_CU_D -static inline void -rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, - double* GKYL_RESTRICT qlocal); - -/** -* Rotate state vector from local to global coordinate frame. -* -* @param eqn Base equation object. -* @param tau1 First tangent vector of the coordinate frame. -* @param tau2 Second tangent vector of the coordinate frame. -* @param norm Normal vector of the coordinate frame. -* @param qlocal State vector in local coordinate frame (input). -* @param qglobal State vector in global coordinate frame (output). -*/ -GKYL_CU_D -static inline void -rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, - double* GKYL_RESTRICT qglobal); - -/** -* Compute waves and speeds using Roe fluxes. -* -* @param eqn Base equation object. -* @param delta Jump across interface to split. -* @param ql Conserved variables on the left of the interface. -* @param qr Conserved variables on the right of the interface. -* @param waves Waves (output). -* @param s Wave speeds (output). -* @return Maximum wave speed. -*/ -GKYL_CU_D -static double -wave_roe(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s); - -/** -* Compute fluctuations using Roe fluxes. -* -* @param eqn Base equation object. -* @param ql Conserved variable vector on the left of the interface. -* @param qr Conserved variable vector on the right of the interface. -* @param waves Waves (input). -* @param s Wave speeds (input). -* @param amdq Left-moving fluctuations (output). -* @param apdq Right-moving fluctuations (output). -*/ -GKYL_CU_D -static void -qfluct_roe(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq); - -/** -* Compute waves and speeds using Roe fluxes (with potential fallback). -* -* @param eqn Base equation object. -* @param type Type of Riemann-solver flux to use. -* @param delta Jump across interface to split. -* @param ql Conserved variables on the left of the interface. -* @param qr Conserved variables on the right of the interface. -* @param waves Waves (output). -* @param s Wave speeds (output). -* @return Maximum wave speed. -*/ -GKYL_CU_D -static double -wave_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s); - -/** -* Compute fluctuations using Roe fluxes (with potential fallback), -* -* @param eqn Base equation object. -* @param type Type of Riemann-solver flux to use. -* @param ql Conserved variable vector on the left of the interface. -* @param qr Conserved variable vector on the right of the interface. -* @param waves Waves (input). -* @param s Wave speeds (input). -* @param amdq Left-moving fluctuations (output). -* @param apdq Right-moving fluctuations (output). -*/ -GKYL_CU_D -static void -qfluct_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, - double* amdq, double* apdq); - -/** -* Compute jump in flux given two conserved variable states. -* -* @param eqn Base equation object. -* @param ql Conserved variable vector on the left of the interface (input). -* @param qr Conserved variable vector on the right of the interface (input). -* @param flux_jump Jump in flux vector (output). -* @return Maximum wave speeds for states ql and qr. -*/ -GKYL_CU_D -static double -flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump); - -/** -* Determine whether invariant domain of the ~a equations is satisfied. -* -* @param eqn Base equation object. -* @param q Conserved variable vector. -* @return Whether the invariant domain is satisfied. -*/ -GKYL_CU_D -static bool -check_inv(const struct gkyl_wv_eqn* eqn, const double* q); - -/** -* Compute maximum wave speed from a conserved variable vector. -* -* @param eqn Base equation object. -* @param q Conserved variable vector. -* @return Maximum absolute wave speed. -*/ -GKYL_CU_D -static double -max_speed(const struct gkyl_wv_eqn* eqn, const double* q); - -/** -* Convert conserved variables to diagnostic variables. -* -* @param eqn Base equation object. -* @param qin Conserved variable vector (input). -* @param diag Diagnostic variable vector (output). -*/ -GKYL_CU_D -static inline void -~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag); - -/** -* Compute forcing/source term vector from conserved variable vector. -* -* @param eqn Base equation object. -* @param qin Conserved variable vector (input). -* @param sout Forcing/source term vector (output). -*/ -GKYL_CU_DH -static inline void -~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout); - -/** -* Free ~a equations object. -* -* @param ref Reference counter for ~a equations. -*/ -void -gkyl_~a_free(const struct gkyl_ref_count* ref); -" - name - parameter-def - parameter-comment - name - parameter-sig - parameter-comment - name - parameter-sig - parameter-comment - name - parameter-sig - name - name - name - name - name - name - name - name - name - name - )) - code) - -;; ------------------------------------------------------------------------------------- -;; Source for Gkeyll Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------------------------- -(define (gkyl-generate-roe-vector2-1d-source pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate Gkeyll C source code that solves the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (define flux-jacobian-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define flux-jacobian-eigvals-simp (list (symbolic-simp (list-ref flux-jacobian-eigvals 0)) - (symbolic-simp (list-ref flux-jacobian-eigvals 1)))) - - (define cons-codes (map (lambda (cons-expr) - (convert-expr cons-expr)) cons-exprs)) - (define flux-codes (map (lambda (flux-expr) - (convert-expr flux-expr)) flux-exprs)) - (define flux-deriv-codes (map (lambda (flux-deriv-expr) - (convert-expr flux-deriv-expr)) flux-jacobian-eigvals-simp)) - (define max-speed-codes (map (lambda (max-speed-expr) - (convert-expr max-speed-expr)) max-speed-exprs)) - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define max-speed-locals (map (lambda (max-speed-code) - (flux-substitute (flux-substitute max-speed-code (list-ref cons-codes 0) "q[0]") - (list-ref cons-codes 1) "q[1]")) max-speed-codes)) - (define flux-uis (map (lambda (flux-code) - (flux-substitute (flux-substitute flux-code (list-ref cons-codes 0) "q[0]") - (list-ref cons-codes 1) "q[1]")) flux-codes)) - (define flux-deriv-uis (map (lambda (flux-deriv-code) - (flux-substitute (flux-substitute flux-deriv-code (list-ref cons-codes 0) "q[0]") - (list-ref cons-codes 1) "q[1]")) flux-deriv-codes)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) " = " - name "->" (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-sig (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-name (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append (convert-expr (list-ref parameter 1)) ",")) - parameters))] - [else ""])) - (define parameter-field (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - (define parameter-field-set (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append name "->" (convert-expr (list-ref parameter 1)) - " = inp->" (convert-expr (list-ref parameter 1)) ";")) - parameters) "\n")] - [else ""])) - - (define code - (format " -#include -#include - -#include -#include -#include -#include - -static inline double -gkyl_~a_max_abs_speed(~a const double* q) -{ - return fmax(~a, ~a); -} - -void -gkyl_~a_flux(~a const double* q, double* flux) -{ - flux[0] = ~a; - flux[1] = ~a; -} - -void -gkyl_~a_flux_deriv(~a const double* q, double* flux_deriv) -{ - flux_deriv[0] = ~a; - flux_deriv[1] = ~a; -} - -static inline void -cons_to_riem(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* qin, double* wout) -{ - // TODO: This should use a proper L matrix. - for (int i = 0; i < 2; i++) { - wout[i] = qin[i]; - } -} - -static inline void -riem_to_cons(const struct gkyl_wv_eqn* eqn, const double* qstate, const double* win, double* qout) -{ - // TODO: This should use a proper L matrix. - for (int i = 0; i < 2; i++) { - qout[i] = win[i]; - } -} - -static void -~a_wall(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) -{ - for (int i = 0; i < 2; i++) { - ghost[i] = skin[i]; - } -} - -static void -~a_no_slip(const struct gkyl_wv_eqn* eqn, double t, int nc, const double* skin, double* GKYL_RESTRICT ghost, void* ctx) -{ - for (int i = 0; i < 2; i++) { - ghost[i] = skin[i]; - } -} - -static inline void -rot_to_local(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qglobal, - double* GKYL_RESTRICT qlocal) -{ - for (int i = 0; i < 2; i++) { - qlocal[i] = qglobal[i]; - } -} - -static inline void -rot_to_global(const struct gkyl_wv_eqn* eqn, const double* tau1, const double* tau2, const double* norm, const double* GKYL_RESTRICT qlocal, - double* GKYL_RESTRICT qglobal) -{ - for (int i = 0; i < 2; i++) { - qglobal[i] = qlocal[i]; - } -} - -static double -wave_roe(const struct gkyl_wv_eqn* eqn, const double* delta, const double* ql, const double* qr, double* waves, double* s) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - double *fl = gkyl_malloc(sizeof(double) * 2); - double *fr = gkyl_malloc(sizeof(double) * 2); - gkyl_~a_flux(~a ql, fl); - gkyl_~a_flux(~a qr, fr); - - double *fl_deriv = gkyl_malloc(sizeof(double) * 2); - double *fr_deriv = gkyl_malloc(sizeof(double) * 2); - gkyl_~a_flux_deriv(~a ql, fl_deriv); - gkyl_~a_flux_deriv(~a qr, fr_deriv); - - double *a_roe = gkyl_malloc(sizeof(double) * 2); - for (int i = 0; i < 2; i++) { - a_roe[i] = 0.5 * (fl_deriv[i] + fr_deriv[i]); - } - - double *w0 = &waves[0], *w1 = &waves[2]; - for (int i = 0; i < 2; i++) { - w0[i] = 0.5 * ((qr[i] - ql[i]) - (fr[i] - fl[i]) / fmax(a_roe[0], a_roe[1])); - w1[i] = 0.5 * ((qr[i] - ql[i]) + (fr[i] - fl[i]) / fmax(a_roe[0], a_roe[1])); - } - - for (int i = 0; i < 2; i++) { - s[i] = a_roe[i]; - } - - gkyl_free(fl); - gkyl_free(fr); - - gkyl_free(fl_deriv); - gkyl_free(fr_deriv); - - return fmax(s[0], s[1]); -} - -static void -qfluct_roe(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, const double* waves, const double* s, double* amdq, double* apdq) -{ - const double *w0 = &waves[0], *w1 = &waves[2]; - double s0m = fmin(0.0, s[0]), s1m = fmin(0.0, s[1]); - double s0p = fmax(0.0, s[0]), s1p = fmax(0.0, s[1]); - - for (int i = 0; i < 2; i++) { - amdq[i] = (s0m * w0[i]) + (s1m * w1[i]); - apdq[i] = (s0p * w0[i]) + (s1p * w1[i]); - } -} - -static double -wave_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* delta, const double* ql, const double* qr, double* waves, double* s) -{ - return wave_roe(eqn, delta, ql, qr, waves, s); -} - -static void -qfluct_roe_l(const struct gkyl_wv_eqn* eqn, enum gkyl_wv_flux_type type, const double* ql, const double* qr, const double* waves, const double* s, - double* amdq, double* apdq) -{ - return qfluct_roe(eqn, ql, qr, waves, s, amdq, apdq); -} - -static double -flux_jump(const struct gkyl_wv_eqn* eqn, const double* ql, const double* qr, double* flux_jump) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - double *fr = gkyl_malloc(sizeof(double)); - double *fl = gkyl_malloc(sizeof(double)); - gkyl_~a_flux(~a ql, fl); - gkyl_~a_flux(~a qr, fr); - - for (int i = 0; i < 2; i++) { - flux_jump[i] = fr[i] - fl[i]; - } - - double amaxl = gkyl_~a_max_abs_speed(~a ql); - double amaxr = gkyl_~a_max_abs_speed(~a qr); - - gkyl_free(fr); - gkyl_free(fl); - - return fmax(amaxl, amaxr); -} - -static bool -check_inv(const struct gkyl_wv_eqn* eqn, const double* q) -{ - return true; // All states are assumed to be valid. -} - -static double -max_speed(const struct gkyl_wv_eqn* eqn, const double* q) -{ - const struct wv_~a *~a = container_of(eqn, struct wv_~a, eqn); - ~a - - return gkyl_~a_max_abs_speed(~a q); -} - -static inline void -~a_cons_to_diag(const struct gkyl_wv_eqn* eqn, const double* qin, double* diag) -{ - for (int i = 0; i < 2; i++) { - diag[i] = qin[i]; - } -} - -static inline void -~a_source(const struct gkyl_wv_eqn* eqn, const double* qin, double* sout) -{ - for (int i = 0; i < 2; i++) { - sout[i] = 0.0; - } -} - -void -gkyl_~a_free(const struct gkyl_ref_count* ref) -{ - struct gkyl_wv_eqn* base = container_of(ref, struct gkyl_wv_eqn, ref_count); - - if (gkyl_wv_eqn_is_cu_dev(base)) { - // Free inner on_dev object. - struct wv_~a *~a = container_of(base->on_dev, struct wv_~a, eqn); - gkyl_cu_free(~a); - } - - struct wv_~a *~a = container_of(base, struct wv_~a, eqn); - gkyl_free(~a); -} - -struct gkyl_wv_eqn* -gkyl_wv_~a_new(~a bool use_gpu) -{ - return gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { - ~a - .rp_type = WV_~a_RP_ROE, - .use_gpu = use_gpu, - } - ); -} - -struct gkyl_wv_eqn* -gkyl_wv_~a_inew(const struct gkyl_wv_~a_inp* inp) -{ - struct wv_~a *~a = gkyl_malloc(sizeof(struct wv_~a)); - - ~a->eqn.type = GKYL_EQN_~a; - ~a->eqn.num_equations = 2; - ~a->eqn.num_diag = 2; - - ~a - - if (inp->rp_type == WV_~a_RP_ROE) { - ~a->eqn.num_waves = 2; - ~a->eqn.waves_func = wave_roe_l; - ~a->eqn.qfluct_func = qfluct_roe_l; - } - - ~a->eqn.flux_jump = flux_jump; - ~a->eqn.check_inv_func = check_inv; - ~a->eqn.max_speed_func = max_speed; - ~a->eqn.rotate_to_local_func = rot_to_local; - ~a->eqn.rotate_to_global_func = rot_to_global; - - ~a->eqn.wall_bc_func = ~a_wall; - ~a->eqn.no_slip_bc_func = ~a_no_slip; - - ~a->eqn.cons_to_riem = cons_to_riem; - ~a->eqn.riem_to_cons = riem_to_cons; - - ~a->eqn.cons_to_diag = ~a_cons_to_diag; - - ~a->eqn.source_func = ~a_source; - - ~a->eqn.flags = 0; - GKYL_CLEAR_CU_ALLOC(~a->eqn.flags); - ~a->eqn.ref_count = gkyl_ref_count_init(gkyl_~a_free); - ~a->eqn.on_dev = &~a->eqn; // On the CPU, the equation object points to itself. - - return &~a->eqn; -} -" - name - name - name - parameter-sig - (list-ref max-speed-locals 0) - (list-ref max-speed-locals 1) - name - parameter-sig - (list-ref flux-uis 0) - (list-ref flux-uis 1) - name - parameter-sig - (list-ref flux-deriv-uis 0) - (list-ref flux-deriv-uis 1) - name - name - name - name - name - parameter-def - name - parameter-name - name - parameter-name - name - parameter-name - name - parameter-name - name - name - name - parameter-def - name - parameter-name - name - parameter-name - name - parameter-name - name - parameter-name - name - name - name - parameter-def - name - parameter-name - name - name - name - name - name - name - name - name - name - name - name - name - parameter-sig - name - name - parameter-field - (string-upcase name) - name - name - name - name - name - name - (string-upcase name) - name - name - parameter-field-set - (string-upcase name) - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - name - )) - code) - -;; ------------------------------------------------------------------------------------------------ -;; C Regression Test for Gkeyll Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------------------------------------ -(define (gkyl-generate-roe-vector2-1d-regression pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Generate a Gkeyll C regression test for the 1D coupled vector system of 2 PDEs specified by `pde-system` using the Roe finite-volume method. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expression for the initial conditions, e.g. piecewise constant." - - (define name (hash-ref pde-system 'name)) - (define parameters (hash-ref pde-system 'parameters)) - - (define init-func-codes (map (lambda (init-func-expr) - (convert-expr init-func-expr)) init-funcs)) - - (define parameter-def (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) "; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-assign (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "double " (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 2))"; // Additional simulation parameter.")) - parameters) "\n")] - [else ""])) - (define parameter-ctx-set (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = " - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - (define parameter-ctx (cond - [(not (empty? parameters)) (string-join (map (lambda (parameter) - (string-append "." (convert-expr (list-ref parameter 1)) " = ctx." - (convert-expr (list-ref parameter 1)) ",")) - parameters) "\n")] - [else ""])) - - (define code - (format " -#include -#include -#include -#include - -#include -#include -#include -#include - -#include - -#ifdef GKYL_HAVE_MPI -#include -#include -#endif - -#include - -struct ~a_roe_ctx -{ - // Simulation parameters. - int Nx; // Cell count (x-direction). - double Lx; // Domain size (x-direction). - ~a - double cfl_frac; // CFL coefficient. - - double t_end; // Final simulation time. - int num_frames; // Number of output frames. - int field_energy_calcs; // Number of times to calculate field energy. - int integrated_mom_calcs; // Number of times to calculate integrated moments. - double dt_failure_tol; // Minimum allowable fraction of initial time-step. - int num_failures_max; // Maximum allowable number of consecutive small time-steps. -}; - -struct ~a_roe_ctx -create_ctx(void) -{ - // Simulation parameters. - int Nx = ~a; // Cell count (x-direction). - double Lx = ~a; // Domain size (x-direction). - ~a - double cfl_frac = ~a; // CFL coefficient. - - double t_end = ~a; // Final simulation time. - int num_frames = 1; // Number of output frames. - int field_energy_calcs = INT_MAX; // Number of times to calculate field energy. - int integrated_mom_calcs = INT_MAX; // Number of times to calculate integrated moments. - double dt_failure_tol = 1.0e-4; // Minimum allowable fraction of initial time-step. - int num_failures_max = 20; // Maximum allowable number of consecutive small time-steps. - - struct ~a_roe_ctx ctx = { - .Nx = Nx, - .Lx = Lx, - ~a - .cfl_frac = cfl_frac, - .t_end = t_end, - .num_frames = num_frames, - .field_energy_calcs = field_energy_calcs, - .integrated_mom_calcs = integrated_mom_calcs, - .dt_failure_tol = dt_failure_tol, - .num_failures_max = num_failures_max, - }; - - return ctx; -} - -void -eval~aInit(double t, const double* GKYL_RESTRICT xn, double* GKYL_RESTRICT fout, void* ctx) -{ - double x = xn[0]; - - // Set conserved quantities. - fout[0] = ~a; - fout[1] = ~a; -} - -void -write_data(struct gkyl_tm_trigger* iot, gkyl_moment_app* app, double t_curr, bool force_write) -{ - if (gkyl_tm_trigger_check_and_bump(iot, t_curr) || force_write) { - int frame = iot->curr - 1; - if (force_write) { - frame = iot->curr; - } - - gkyl_moment_app_write(app, t_curr, frame); - gkyl_moment_app_write_field_energy(app); - gkyl_moment_app_write_integrated_mom(app); - } -} - -void -calc_field_energy(struct gkyl_tm_trigger* fet, gkyl_moment_app* app, double t_curr, bool force_calc) -{ - if (gkyl_tm_trigger_check_and_bump(fet, t_curr) || force_calc) { - gkyl_moment_app_calc_field_energy(app, t_curr); - } -} - -void -calc_integrated_mom(struct gkyl_tm_trigger* imt, gkyl_moment_app* app, double t_curr, bool force_calc) -{ - if (gkyl_tm_trigger_check_and_bump(imt, t_curr) || force_calc) { - gkyl_moment_app_calc_integrated_mom(app, t_curr); - } -} - -int -main(int argc, char **argv) -{ - struct gkyl_app_args app_args = parse_app_args(argc, argv); - -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Init(&argc, &argv); - } -#endif - - if (app_args.trace_mem) { - gkyl_cu_dev_mem_debug_set(true); - gkyl_mem_debug_set(true); - } - - struct ~a_roe_ctx ctx = create_ctx(); // Context for initialization functions. - - int NX = APP_ARGS_CHOOSE(app_args.xcells[0], ctx.Nx); - - // ~a equation. - struct gkyl_wv_eqn *~a = gkyl_wv_~a_inew(&(struct gkyl_wv_~a_inp) { - ~a - .rp_type = WV_~a_RP_ROE, - .use_gpu = app_args.use_gpu, - } - ); - - struct gkyl_moment_species fluid = { - .name = \"~a\", - .equation = ~a, - .evolve = true, - .init = eval~aInit, - .ctx = &ctx, - }; - - int nrank = 1; // Number of processes in simulation. -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Comm_size(MPI_COMM_WORLD, &nrank); - } -#endif - - // Create global range. - int cells[] = { NX }; - int dim = sizeof(cells) / sizeof(cells[0]); - - int cuts[dim]; -#ifdef GKYL_HAVE_MPI - for (int d = 0; d < dim; d++) { - if (app_args.use_mpi) { - cuts[d] = app_args.cuts[d]; - } - else { - cuts[d] = 1; - } - } -#else - for (int d = 0; d < dim; d++) { - cuts[d] = 1; - } -#endif - - // Construct communicator for use in app. - struct gkyl_comm *comm; -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - comm = gkyl_mpi_comm_new( &(struct gkyl_mpi_comm_inp) { - .mpi_comm = MPI_COMM_WORLD, - } - ); - } - else { - comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { - .use_gpu = app_args.use_gpu - } - ); - } -#else - comm = gkyl_null_comm_inew( &(struct gkyl_null_comm_inp) { - .use_gpu = app_args.use_gpu - } - ); -#endif - - int my_rank; - gkyl_comm_get_rank(comm, &my_rank); - int comm_size; - gkyl_comm_get_size(comm, &comm_size); - - int ncuts = 1; - for (int d = 0; d < dim; d++) { - ncuts *= cuts[d]; - } - - if (ncuts != comm_size) { - if (my_rank == 0) { - fprintf(stderr, \"*** Number of ranks, %d, does not match total cuts, %d!\\n\", comm_size, ncuts); - } - goto mpifinalize; - } - - // Moment app. - struct gkyl_moment app_inp = { - .name = \"~a_roe\", - - .ndim = 1, - .lower = { ~a }, - .upper = { ~a + ctx.Lx }, - .cells = { NX }, - - .num_periodic_dir = 0, - .periodic_dirs = { }, - .cfl_frac = ctx.cfl_frac, - - .num_species = 1, - .species = { fluid }, - - .parallelism = { - .use_gpu = app_args.use_gpu, - .cuts = { app_args.cuts[0] }, - .comm = comm, - }, - }; - - // Create app object. - gkyl_moment_app *app = gkyl_moment_app_new(&app_inp); - - // Initial and final simulation times. - double t_curr = 0.0, t_end = ctx.t_end; - - // Initialize simulation. - int frame_curr = 0; - if (app_args.is_restart) { - struct gkyl_app_restart_status status = gkyl_moment_app_read_from_frame(app, app_args.restart_frame); - - if (status.io_status != GKYL_ARRAY_RIO_SUCCESS) { - gkyl_moment_app_cout(app, stderr, \"*** Failed to read restart file! (%s)\\n\", gkyl_array_rio_status_msg(status.io_status)); - goto freeresources; - } - - frame_curr = status.frame; - t_curr = status.stime; - - gkyl_moment_app_cout(app, stdout, \"Restarting from frame %d\", frame_curr); - gkyl_moment_app_cout(app, stdout, \" at time = %g\\n\", t_curr); - } - else { - gkyl_moment_app_apply_ic(app, t_curr); - } - - // Create trigger for field energy. - int field_energy_calcs = ctx.field_energy_calcs; - struct gkyl_tm_trigger fe_trig = { .dt = t_end / field_energy_calcs, .tcurr = t_curr, .curr = frame_curr }; - - calc_field_energy(&fe_trig, app, t_curr, false); - - // Create trigger for integrated moments. - int integrated_mom_calcs = ctx.integrated_mom_calcs; - struct gkyl_tm_trigger im_trig = { .dt = t_end / integrated_mom_calcs, .tcurr = t_curr, .curr = frame_curr }; - - calc_integrated_mom(&im_trig, app, t_curr, false); - - // Create trigger for IO. - int num_frames = ctx.num_frames; - struct gkyl_tm_trigger io_trig = { .dt = t_end / num_frames, .tcurr = t_curr, .curr = frame_curr }; - - write_data(&io_trig, app, t_curr, false); - - // Compute initial guess of maximum stable time-step. - double dt = t_end - t_curr; - - // Initialize small time-step check. - double dt_init = -1.0, dt_failure_tol = ctx.dt_failure_tol; - int num_failures = 0, num_failures_max = ctx.num_failures_max; - - long step = 1; - while ((t_curr < t_end) && (step <= app_args.num_steps)) { - gkyl_moment_app_cout(app, stdout, \"Taking time-step %ld at t = %g ...\", step, t_curr); - struct gkyl_update_status status = gkyl_moment_update(app, dt); - gkyl_moment_app_cout(app, stdout, \" dt = %g\\n\", status.dt_actual); - - if (!status.success) { - gkyl_moment_app_cout(app, stdout, \"** Update method failed! Aborting simulation ....\\n\"); - break; - } - - t_curr += status.dt_actual; - dt = status.dt_suggested; - - calc_field_energy(&fe_trig, app, t_curr, false); - calc_integrated_mom(&im_trig, app, t_curr, false); - write_data(&io_trig, app, t_curr, false); - - if (dt_init < 0.0) { - dt_init = status.dt_actual; - } - else if (status.dt_actual < dt_failure_tol * dt_init) { - num_failures += 1; - - gkyl_moment_app_cout(app, stdout, \"WARNING: Time-step dt = %g\", status.dt_actual); - gkyl_moment_app_cout(app, stdout, \" is below %g*dt_init ...\", dt_failure_tol); - gkyl_moment_app_cout(app, stdout, \" num_failures = %d\\n\", num_failures); - if (num_failures >= num_failures_max) { - gkyl_moment_app_cout(app, stdout, \"ERROR: Time-step was below %g*dt_init \", dt_failure_tol); - gkyl_moment_app_cout(app, stdout, \"%d consecutive times. Aborting simulation ....\\n\", num_failures_max); - - calc_field_energy(&fe_trig, app, t_curr, true); - calc_integrated_mom(&im_trig, app, t_curr, true); - write_data(&io_trig, app, t_curr, true); - - break; - } - } - else { - num_failures = 0; - } - - step += 1; - } - - calc_field_energy(&fe_trig, app, t_curr, false); - calc_integrated_mom(&im_trig, app, t_curr, false); - write_data(&io_trig, app, t_curr, false); - gkyl_moment_app_stat_write(app); - - struct gkyl_moment_stat stat = gkyl_moment_app_stat(app); - - gkyl_moment_app_cout(app, stdout, \"\\n\"); - gkyl_moment_app_cout(app, stdout, \"Number of update calls %ld\\n\", stat.nup); - gkyl_moment_app_cout(app, stdout, \"Number of failed time-steps %ld\\n\", stat.nfail); - gkyl_moment_app_cout(app, stdout, \"Species updates took %g secs\\n\", stat.species_tm); - gkyl_moment_app_cout(app, stdout, \"Field updates took %g secs\\n\", stat.field_tm); - gkyl_moment_app_cout(app, stdout, \"Source updates took %g secs\\n\", stat.sources_tm); - gkyl_moment_app_cout(app, stdout, \"Total updates took %g secs\\n\", stat.total_tm); - -freeresources: - // Free resources after simulation completion. - gkyl_wv_eqn_release(~a); - gkyl_comm_release(comm); - gkyl_moment_app_release(app); - -mpifinalize: -#ifdef GKYL_HAVE_MPI - if (app_args.use_mpi) { - MPI_Finalize(); - } -#endif - - return 0; -} - -" - name - name - parameter-def - name - nx - (- x1 x0) - parameter-assign - cfl - t-final - name - parameter-ctx-set - (string-titlecase name) - (list-ref init-func-codes 0) - (list-ref init-func-codes 1) - name - name - name - name - name - parameter-ctx - (string-upcase name) - name - name - (string-titlecase name) - name - x0 - x0 - name - )) - code) \ No newline at end of file diff --git a/provable-algorithms/gkyl_test_inviscid_burgers.rkt b/provable-algorithms/gkyl_test_inviscid_burgers.rkt deleted file mode 100644 index 1e12a917..00000000 --- a/provable-algorithms/gkyl_test_inviscid_burgers.rkt +++ /dev/null @@ -1,275 +0,0 @@ -#lang racket - -(require "gkyl_code_generator_lax.rkt") -(require "gkyl_code_generator_roe.rkt") -(require "prover_core.rkt") -(provide (all-from-out "gkyl_code_generator_lax.rkt")) -(provide (all-from-out "gkyl_code_generator_roe.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D inviscid Burgers' equation: du/dt + u du/dx = 0. -(define pde-inviscid-burgers - (hash - 'name "burgers" - 'cons-expr `u ; conserved variable: u - 'flux-expr `(* 0.5 u u) ; flux function: f(u) = 0.5 * u^2 - 'max-speed-expr `(abs u) ; local wave-speed: alpha = |u| - 'parameters `() - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -3.0) -(define x1 3.0) -(define t-final 0.5) -(define cfl 0.95) -(define init-func `(cond - [(< (abs x) 1.0) 3.0] - [else -1.0])) - -;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-lax-header - (gkyl-generate-lax-friedrichs-scalar-1d-header pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_burgers_lax.h" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-header))) - -;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-lax-priv-header - (gkyl-generate-lax-friedrichs-scalar-1d-priv-header pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_burgers_lax_priv.h" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-priv-header))) - -;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-lax-source - (gkyl-generate-lax-friedrichs-scalar-1d-source pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_burgers_lax.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-source))) - -;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-lax-regression - (gkyl-generate-lax-friedrichs-scalar-1d-regression pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_burgers_lax.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-regression))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-hyperbolicity - (call-with-output-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-inviscid-burgers-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-cfl-stability - (call-with-output-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-cfl-stability pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-inviscid-burgers-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-local-lipschitz - (call-with-output-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-inviscid-burgers-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the Gkeyll header code for a Roe solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-roe-header - (gkyl-generate-roe-scalar-1d-header pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_burgers_roe.h" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-header))) - -;; Synthesize the Gkeyll private header code for a Roe solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-roe-priv-header - (gkyl-generate-roe-scalar-1d-priv-header pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_burgers_roe_priv.h" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-priv-header))) - -;; Synthesize the Gkeyll source code for a Roe solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-roe-source - (gkyl-generate-roe-scalar-1d-source pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_burgers_roe.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-source))) - -;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-roe-regression - (gkyl-generate-roe-scalar-1d-regression pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_burgers_roe.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-regression))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-roe-hyperbolicity - (call-with-output-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-hyperbolicity pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-inviscid-burgers-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-roe-flux-conservation - (call-with-output-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-flux-conservation pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-inviscid-burgers-roe-flux-conservation) -(display "\n") \ No newline at end of file diff --git a/provable-algorithms/gkyl_test_isothermal_euler_mom_x.rkt b/provable-algorithms/gkyl_test_isothermal_euler_mom_x.rkt deleted file mode 100644 index 41641cdb..00000000 --- a/provable-algorithms/gkyl_test_isothermal_euler_mom_x.rkt +++ /dev/null @@ -1,339 +0,0 @@ -#lang racket - -(require "gkyl_code_generator_lax_vector.rkt") -(require "gkyl_code_generator_roe_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) -(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D isothermal Euler equations (density and x-momentum components). -(define pde-system-isothermal-euler-mom-x - (hash - 'name "isothermal_euler_mom_x" - 'cons-exprs (list - `rho - `mom_x) ; conserved variables: density, x-momentum - 'flux-exprs (list - `mom_x - `(+ (/ (* mom_x mom_x) rho) (* rho vt vt))) ; flux vector - 'max-speed-exprs (list - `(abs (- (/ mom_x rho) vt)) - `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds - 'parameters (list - `(define vt 1.0)) ; thermal velocity: vt = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 0.0) -(define x1 1.0) -(define t-final 0.1) -(define cfl 0.95) -(define init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))) - -;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-lax-header - (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_x_lax.h" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-lax-header))) - -;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-lax-priv-header - (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_x_lax_priv.h" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-lax-priv-header))) - -;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-lax-source - (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_isothermal_euler_mom_x_lax.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-lax-source))) - -;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-lax-regression - (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_isothermal_euler_mom_x_lax.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-lax-regression))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-lax-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-x-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-x-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-lax-cfl-stability - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-isothermal-euler-mom-x-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D isothermal Euler equation (density and x-momentum components). -(define proof-isothermal-euler-mom-x-lax-local-lipschitz - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-isothermal-euler-mom-x-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the Gkeyll header code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-roe-header - (gkyl-generate-roe-vector2-1d-header pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_x_roe.h" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-roe-header))) - -;; Synthesize the Gkeyll private header code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-roe-priv-header - (gkyl-generate-roe-vector2-1d-priv-header pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_x_roe_priv.h" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-roe-priv-header))) - -;; Synthesize the Gkeyll source code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-roe-source - (gkyl-generate-roe-vector2-1d-source pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_isothermal_euler_mom_x_roe.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-roe-source))) - -;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-roe-regression - (gkyl-generate-roe-vector2-1d-regression pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_isothermal_euler_mom_x_roe.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-roe-regression))) - - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-roe-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-x-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-x-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-roe-flux-conservation - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-isothermal-euler-mom-x-roe-flux-conservation) -(display "\n") \ No newline at end of file diff --git a/provable-algorithms/gkyl_test_isothermal_euler_mom_yz.rkt b/provable-algorithms/gkyl_test_isothermal_euler_mom_yz.rkt deleted file mode 100644 index 23d8eaf1..00000000 --- a/provable-algorithms/gkyl_test_isothermal_euler_mom_yz.rkt +++ /dev/null @@ -1,333 +0,0 @@ -#lang racket - -(require "gkyl_code_generator_lax_vector.rkt") -(require "gkyl_code_generator_roe_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) -(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D isothermal Euler equations (y- and z-momentum components). -(define pde-system-isothermal-euler-mom-yz - (hash - 'name "isothermal_euler_mom_yz" - 'cons-exprs (list - `mom_y - `mom_z) ; conserved variables: y-momentum, z-momentum - 'flux-exprs (list - `(* mom_y u) - `(* mom_z u)) ; flux vector - 'max-speed-exprs (list - `(abs u) - `(abs u)) ; local wave-speeds - 'parameters (list - `(define u 0.0)) ; advection velocity: 0.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 0.0) -(define x1 1.0) -(define t-final 0.1) -(define cfl 0.95) -(define init-funcs (list 0.0 0.0)) - -;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-lax-header - (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_yz_lax.h" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-lax-header))) - -;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-lax-priv-header - (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_yz_lax_priv.h" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-lax-priv-header))) - -;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-lax-source - (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_isothermal_euler_mom_yz_lax.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-lax-source))) - -;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-lax-regression - (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_isothermal_euler_mom_yz_lax.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-lax-regression))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-lax-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-yz-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-yz-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-lax-cfl-stability - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-isothermal-euler-mom-yz-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D isothermal Euler equation (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-lax-local-lipschitz - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-isothermal-euler-mom-yz-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the Gkeyll header code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-roe-header - (gkyl-generate-roe-vector2-1d-header pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_yz_roe.h" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-roe-header))) - -;; Synthesize the Gkeyll private header code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-roe-priv-header - (gkyl-generate-roe-vector2-1d-priv-header pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_isothermal_euler_mom_yz_roe_priv.h" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-roe-priv-header))) - -;; Synthesize the Gkeyll source code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-roe-source - (gkyl-generate-roe-vector2-1d-source pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_isothermal_euler_mom_yz_roe.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-roe-source))) - -;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-roe-regression - (gkyl-generate-roe-vector2-1d-regression pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_isothermal_euler_mom_yz_roe.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-roe-regression))) - - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-roe-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-yz-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-yz-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-roe-flux-conservation - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-isothermal-euler-mom-yz-roe-flux-conservation) -(display "\n") \ No newline at end of file diff --git a/provable-algorithms/gkyl_test_limiters.rkt b/provable-algorithms/gkyl_test_limiters.rkt deleted file mode 100644 index 16ea8902..00000000 --- a/provable-algorithms/gkyl_test_limiters.rkt +++ /dev/null @@ -1,219 +0,0 @@ -#lang racket - -(require "gkyl_code_generator_lax.rkt") -(require "prover_core.rkt") -(provide (all-from-out "gkyl_code_generator_lax.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "min_mod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize Gkeyll code (to be plugged into wave_prop.c) for the minmod flux limiter. -(define code-limiter-minmod - (gkyl-generate-flux-limiter limiter-minmod)) - -;; Output the flux limiter code to a file. -(with-output-to-file "gkyl_code/minmod_flux_limiter.c" - #:exists 'replace - (lambda () - (display code-limiter-minmod))) - -(display "Minmod flux limiter properties: \n\n") - -;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the minmod flux limiter. -(define proof-limiter-minmod-symmetry - (call-with-output-file "proofs/proof_limiter_minmod_symmetry.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-symmetry limiter-minmod))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_minmod_symmetry.rkt") - -;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. -(display "Symmetric (equivalent action on forward and backward gradients): ") -(display proof-limiter-minmod-symmetry) -(display "\n") - -;; Attempt to prove second-order TVD (total variation diminishing) of the minmod flux limiter. -(define proof-limiter-minmod-tvd - (call-with-output-file "proofs/proof_limiter_minmod_tvd.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-tvd limiter-minmod))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_minmod_tvd.rkt") - -;; Show whether the second-order TVD (total variation diminishing) property is satisfied. -(display "Second-order TVD (total variation diminishing): ") -(display proof-limiter-minmod-tvd) -(display "\n\n\n") - -;; Define the superbee flux limiter. -(define limiter-superbee - (hash - 'name "superbee" - 'limiter-expr `(max 0.0 (min (* 2.0 r) 1.0) (min r 2.0)) - 'limiter-ratio `r - )) - -;; Synthesize Gkeyll code (to be plugged into wave_prop.c) for the superbee flux limiter. -(define code-limiter-superbee - (gkyl-generate-flux-limiter limiter-superbee)) - -;; Output the flux limiter code to a file. -(with-output-to-file "gkyl_code/superbee_flux_limiter.c" - #:exists 'replace - (lambda () - (display code-limiter-superbee))) - -(display "Superbee flux limiter properties: \n\n") - -;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the superbee flux limiter. -(define proof-limiter-superbee-symmetry - (call-with-output-file "proofs/proof_limiter_superbee_symmetry.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-symmetry limiter-superbee))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_superbee_symmetry.rkt") - -;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. -(display "Symmetric (equivalent action on forward and backward gradients): ") -(display proof-limiter-superbee-symmetry) -(display "\n") - -;; Attempt to prove second-order TVD (total variation diminishing) of the superbee flux limiter. -(define proof-limiter-superbee-tvd - (call-with-output-file "proofs/proof_limiter_superbee_tvd.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-tvd limiter-superbee))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_superbee_tvd.rkt") - -;; Show whether the second-order TVD (total variation diminishing) property is satisfied. -(display "Second-order TVD (total variation diminishing): ") -(display proof-limiter-superbee-tvd) -(display "\n\n\n") - -;; Define the monotonized-centered flux limiter. -(define limiter-monotonized-centered - (hash - 'name "monotonized_centered" - 'limiter-expr `(max 0.0 (min (* 2.0 r) (/ (+ 1.0 r) 2.0) 2.0)) - 'limiter-ratio `r - )) - -;; Synthesize Gkeyll code (to be plugged into wave_prop.c) for the monotonized-centered flux limiter. -(define code-limiter-monotonized-centered - (gkyl-generate-flux-limiter limiter-monotonized-centered)) - -;; Output the flux limiter code to a file. -(with-output-to-file "gkyl_code/monotonized_centered_flux_limiter.c" - #:exists 'replace - (lambda () - (display code-limiter-monotonized-centered))) - -(display "Monotonized-centered flux limiter properties: \n\n") - -;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the monotonized-centered flux limiter. -(define proof-limiter-monotonized-centered-symmetry - (call-with-output-file "proofs/proof_limiter_monotonized_centered_symmetry.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-symmetry limiter-monotonized-centered))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_monotonized_centered_symmetry.rkt") - -;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. -(display "Symmetric (equivalent action on forward and backward gradients): ") -(display proof-limiter-monotonized-centered-symmetry) -(display "\n") - -;; Attempt to prove second-order TVD (total variation diminishing) of the monotonized-centered flux limiter. -(define proof-limiter-monotonized-centered-tvd - (call-with-output-file "proofs/proof_limiter_monotonized_centered_tvd.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-tvd limiter-monotonized-centered))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_monotonized_centered_tvd.rkt") - -;; Show whether the second-order TVD (total variation diminishing) property is satisfied. -(display "Second-order TVD (total variation diminishing): ") -(display proof-limiter-monotonized-centered-tvd) -(display "\n\n\n") - -;; Define the van Leer flux limiter. -(define limiter-van-leer - (hash - 'name "van_leer" - 'limiter-expr `(/ (+ r (abs r)) (+ 1.0 (abs r))) - 'limiter-ratio `r - )) - -;; Synthesize Gkeyll code (to be plugged into wave_prop.c) for the van Leer flux limiter. -(define code-limiter-van-leer - (gkyl-generate-flux-limiter limiter-van-leer)) - -;; Output the flux limiter code to a file. -(with-output-to-file "gkyl_code/van_leer_flux_limiter.c" - #:exists 'replace - (lambda () - (display code-limiter-van-leer))) - -(display "Van Leer flux limiter properties: \n\n") - -;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the van Leer flux limiter. -(define proof-limiter-van-leer-symmetry - (call-with-output-file "proofs/proof_limiter_van_leer_symmetry.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-symmetry limiter-van-leer))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_van_leer_symmetry.rkt") - -;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. -(display "Symmetric (equivalent action on forward and backward gradients): ") -(display proof-limiter-van-leer-symmetry) -(display "\n") - -;; Attempt to prove second-order TVD (total variation diminishing) of the van Leer flux limiter. -(define proof-limiter-van-leer-tvd - (call-with-output-file "proofs/proof_limiter_van_leer_tvd.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-tvd limiter-van-leer))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_van_leer_tvd.rkt") - -;; Show whether the second-order TVD (total variation diminishing) property is satisfied. -(display "Second-order TVD (total variation diminishing): ") -(display proof-limiter-van-leer-tvd) -(display "\n\n\n") \ No newline at end of file diff --git a/provable-algorithms/gkyl_test_linear_advection.rkt b/provable-algorithms/gkyl_test_linear_advection.rkt deleted file mode 100644 index 78058245..00000000 --- a/provable-algorithms/gkyl_test_linear_advection.rkt +++ /dev/null @@ -1,276 +0,0 @@ -#lang racket - -(require "gkyl_code_generator_lax.rkt") -(require "gkyl_code_generator_roe.rkt") -(require "prover_core.rkt") -(provide (all-from-out "gkyl_code_generator_lax.rkt")) -(provide (all-from-out "gkyl_code_generator_roe.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D linear advection equation: du/dt + d(au)/dx = 0. -(define pde-linear-advection - (hash - 'name "advect" - 'cons-expr `u ; conserved variable: u - 'flux-expr `(* a u) ; flux function: f(u) = a * u - 'max-speed-expr `(abs a) ; local wave-speed: alpha = |a| - 'parameters (list - `(define a 1.0)) ; advection speed: a = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 0.0) -(define x1 2.0) -(define t-final 0.5) -(define cfl 0.95) -(define init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])) - -;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D linear advection equation. -(define code-linear-advection-lax-header - (gkyl-generate-lax-friedrichs-scalar-1d-header pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_advect_lax.h" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-header))) - -;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D linear advection equation. -(define code-linear-advection-lax-priv-header - (gkyl-generate-lax-friedrichs-scalar-1d-priv-header pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_advect_lax_priv.h" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-priv-header))) - -;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D linear advection equation. -(define code-linear-advection-lax-source - (gkyl-generate-lax-friedrichs-scalar-1d-source pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_advect_lax.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-source))) - -;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D linear advection equation. -(define code-linear-advection-lax-regression - (gkyl-generate-lax-friedrichs-scalar-1d-regression pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_advect_lax.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-regression))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D linear advection equation. -(define proof-linear-advection-lax-hyperbolicity - (call-with-output-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-linear-advection-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D linear advection equation. -(define proof-linear-advection-lax-cfl-stability - (call-with-output-file "proofs/proof_linear_advection_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-cfl-stability pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-linear-advection-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D linear advection equation. -(define proof-linear-advection-lax-local-lipschitz - (call-with-output-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-linear-advection-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the Gkeyll header code for a Roe solver for the 1D linear advection equation. -(define code-linear-advection-roe-header - (gkyl-generate-roe-scalar-1d-header pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_advect_roe.h" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-header))) - -;; Synthesize the Gkeyll private header code for a Roe solver for the 1D linear advection equation. -(define code-linear-advection-roe-priv-header - (gkyl-generate-roe-scalar-1d-priv-header pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_advect_roe_priv.h" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-priv-header))) - -;; Synthesize the Gkeyll source code for a Roe solver for the 1D linear advection equation. -(define code-linear-advection-roe-source - (gkyl-generate-roe-scalar-1d-source pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_advect_roe.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-source))) - -;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D linear advection equation. -(define code-linear-advection-roe-regression - (gkyl-generate-roe-scalar-1d-regression pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_advect_roe.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-regression))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D linear advection equation. -(define proof-linear-advection-roe-hyperbolicity - (call-with-output-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-hyperbolicity pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-linear-advection-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D linear advection equation. -(define proof-linear-advection-roe-flux-conservation - (call-with-output-file "proofs/proof_linear_advection_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-flux-conservation pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-linear-advection-roe-flux-conservation) -(display "\n") \ No newline at end of file diff --git a/provable-algorithms/gkyl_test_maxwell_1d_Bx_psi.rkt b/provable-algorithms/gkyl_test_maxwell_1d_Bx_psi.rkt deleted file mode 100644 index 28f8056f..00000000 --- a/provable-algorithms/gkyl_test_maxwell_1d_Bx_psi.rkt +++ /dev/null @@ -1,339 +0,0 @@ -#lang racket - -(require "gkyl_code_generator_lax_vector.rkt") -(require "gkyl_code_generator_roe_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) -(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D Maxwell equations (Bx and psi components). -(define pde-system-maxwell-1d-Bx-psi - (hash - 'name "maxwell_Bxpsi" - 'cons-exprs (list - `Bx - `psi) ; conserved variables: magnetic field (x-component), magnetic field correction potential (psi). - 'flux-exprs (list - `(* b_fact psi) - `(* b_fact (* (* c c) Bx))) ; flux vector - 'max-speed-exprs (list - `(abs (* b_fact c)) - `(abs (* b_fact c))) ; local wave-speeds - 'parameters (list - `(define c 1.0) ; speed of light: c = 1.0 - `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 - `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.5) -(define x1 1.5) -(define t-final 1.0) -(define cfl 0.95) -(define init-funcs (list - 0.0 - `(cond - [(< x 0.0) 0.5] - [else -0.5]))) - -;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-lax-header - (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Bxpsi_lax.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-lax-header))) - -;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-lax-priv-header - (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Bxpsi_lax_priv.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-lax-priv-header))) - -;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-lax-source - (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_maxwell_Bxpsi_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-lax-source))) - -;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-lax-regression - (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_maxwell_Bxpsi_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-lax-regression))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-lax-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Bx-psi-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Bx-psi-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-lax-cfl-stability - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-maxwell-1d-Bx-psi-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components) -(define proof-maxwell-1d-Bx-psi-lax-local-lipschitz - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-maxwell-1d-Bx-psi-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the Gkeyll header code for a Roe solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-roe-header - (gkyl-generate-roe-vector2-1d-header pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Bxpsi_roe.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-roe-header))) - -;; Synthesize the Gkeyll private header code for a Roe solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-roe-priv-header - (gkyl-generate-roe-vector2-1d-priv-header pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Bxpsi_roe_priv.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-roe-priv-header))) - -;; Synthesize the Gkeyll source code for a Roe solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-roe-source - (gkyl-generate-roe-vector2-1d-source pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_maxwell_Bxpsi_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-roe-source))) - -;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-roe-regression - (gkyl-generate-roe-vector2-1d-regression pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_maxwell_Bxpsi_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-roe-regression))) - - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-roe-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Bx-psi-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Bx-psi-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-roe-flux-conservation - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-maxwell-1d-Bx-psi-roe-flux-conservation) -(display "\n") \ No newline at end of file diff --git a/provable-algorithms/gkyl_test_maxwell_1d_Ex_phi.rkt b/provable-algorithms/gkyl_test_maxwell_1d_Ex_phi.rkt deleted file mode 100644 index 4c18a8b6..00000000 --- a/provable-algorithms/gkyl_test_maxwell_1d_Ex_phi.rkt +++ /dev/null @@ -1,339 +0,0 @@ -#lang racket - -(require "gkyl_code_generator_lax_vector.rkt") -(require "gkyl_code_generator_roe_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) -(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D Maxwell equations (Ex and phi components). -(define pde-system-maxwell-1d-Ex-phi - (hash - 'name "maxwell_Exphi" - 'cons-exprs (list - `Ex - `phi) ; conserved variables: electric field (x-component), electric field correction potential (phi). - 'flux-exprs (list - `(* e_fact (* (* c c) phi)) - `(* e_fact Ex)) ; flux vector - 'max-speed-exprs (list - `(abs (* c e_fact)) - `(abs (* c e_fact))) ; local wave-speeds - 'parameters (list - `(define c 1.0) ; speed of light: c = 1.0 - `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 - `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.5) -(define x1 1.5) -(define t-final 1.0) -(define cfl 0.95) -(define init-funcs (list - 0.0 - `(cond - [(< x 0.0) 0.5] - [else -0.5]))) - -;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-lax-header - (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Exphi_lax.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-lax-header))) - -;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-lax-priv-header - (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Exphi_lax_priv.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-lax-priv-header))) - -;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-lax-source - (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_maxwell_Exphi_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-lax-source))) - -;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-lax-regression - (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_maxwell_Exphi_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-lax-regression))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-lax-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ex-phi-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ex-phi-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-lax-cfl-stability - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-maxwell-1d-Ex-phi-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components) -(define proof-maxwell-1d-Ex-phi-lax-local-lipschitz - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-maxwell-1d-Ex-phi-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the Gkeyll header code for a Roe solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-roe-header - (gkyl-generate-roe-vector2-1d-header pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Exphi_roe.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-roe-header))) - -;; Synthesize the Gkeyll private header code for a Roe solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-roe-priv-header - (gkyl-generate-roe-vector2-1d-priv-header pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_Exphi_roe_priv.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-roe-priv-header))) - -;; Synthesize the Gkeyll source code for a Roe solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-roe-source - (gkyl-generate-roe-vector2-1d-source pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_maxwell_Exphi_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-roe-source))) - -;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-roe-regression - (gkyl-generate-roe-vector2-1d-regression pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_maxwell_Exphi_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-roe-regression))) - - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-roe-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ex-phi-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ex-phi-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-roe-flux-conservation - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-maxwell-1d-Ex-phi-roe-flux-conservation) -(display "\n") \ No newline at end of file diff --git a/provable-algorithms/gkyl_test_maxwell_1d_Ey_Bz.rkt b/provable-algorithms/gkyl_test_maxwell_1d_Ey_Bz.rkt deleted file mode 100644 index 3d0d02e5..00000000 --- a/provable-algorithms/gkyl_test_maxwell_1d_Ey_Bz.rkt +++ /dev/null @@ -1,339 +0,0 @@ -#lang racket - -(require "gkyl_code_generator_lax_vector.rkt") -(require "gkyl_code_generator_roe_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) -(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D Maxwell equations (Ey and Bz components). -(define pde-system-maxwell-1d-Ey-Bz - (hash - 'name "maxwell_EyBz" - 'cons-exprs (list - `Ey - `Bz) ; conserved variables: electric field (y-component), magnetic field (z-component) - 'flux-exprs (list - `(* (* c c) Bz) - `Ey) ; flux vector - 'max-speed-exprs (list - `(abs c) - `(abs c)) ; local wave-speeds - 'parameters (list - `(define c 1.0) ; speed of light: c = 1.0 - `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 - `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.5) -(define x1 1.5) -(define t-final 1.0) -(define cfl 0.95) -(define init-funcs (list - 0.0 - `(cond - [(< x 0.0) 0.5] - [else -0.5]))) - -;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-lax-header - (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EyBz_lax.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-lax-header))) - -;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-lax-priv-header - (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EyBz_lax_priv.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-lax-priv-header))) - -;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-lax-source - (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_maxwell_EyBz_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-lax-source))) - -;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-lax-regression - (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_maxwell_EyBz_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-lax-regression))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-lax-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ey-Bz-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ey-Bz-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-lax-cfl-stability - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-maxwell-1d-Ey-Bz-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components) -(define proof-maxwell-1d-Ey-Bz-lax-local-lipschitz - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-maxwell-1d-Ey-Bz-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the Gkeyll header code for a Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-roe-header - (gkyl-generate-roe-vector2-1d-header pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EyBz_roe.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-roe-header))) - -;; Synthesize the Gkeyll private header code for a Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-roe-priv-header - (gkyl-generate-roe-vector2-1d-priv-header pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EyBz_roe_priv.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-roe-priv-header))) - -;; Synthesize the Gkeyll source code for a Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-roe-source - (gkyl-generate-roe-vector2-1d-source pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_maxwell_EyBz_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-roe-source))) - -;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-roe-regression - (gkyl-generate-roe-vector2-1d-regression pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_maxwell_EyBz_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-roe-regression))) - - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-roe-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ey-Bz-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ey-Bz-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-roe-flux-conservation - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-maxwell-1d-Ey-Bz-roe-flux-conservation) -(display "\n") \ No newline at end of file diff --git a/provable-algorithms/gkyl_test_maxwell_1d_Ez_By.rkt b/provable-algorithms/gkyl_test_maxwell_1d_Ez_By.rkt deleted file mode 100644 index 20ecb1c7..00000000 --- a/provable-algorithms/gkyl_test_maxwell_1d_Ez_By.rkt +++ /dev/null @@ -1,339 +0,0 @@ -#lang racket - -(require "gkyl_code_generator_lax_vector.rkt") -(require "gkyl_code_generator_roe_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "gkyl_code_generator_lax_vector.rkt")) -(provide (all-from-out "gkyl_code_generator_roe_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "gkyl_code")) (make-directory "gkyl_code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D Maxwell equations (Ez and By components). -(define pde-system-maxwell-1d-Ez-By - (hash - 'name "maxwell_EzBy" - 'cons-exprs (list - `Ez - `By) ; conserved variables: electric field (z-component), magnetic field (y-component) - 'flux-exprs (list - `(* -1.0 (* (* c c) By)) - `(* -1.0 Ez)) ; flux vector - 'max-speed-exprs (list - `(abs c) - `(abs c)) ; local wave-speeds - 'parameters (list - `(define c 1.0) ; speed of light: c = 1.0 - `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 - `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.5) -(define x1 1.5) -(define t-final 1.0) -(define cfl 0.95) -(define init-funcs (list - 0.0 - `(cond - [(< x 0.0) 0.5] - [else -0.5]))) - -;; Synthesize the Gkeyll header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-lax-header - (gkyl-generate-lax-friedrichs-vector2-1d-header pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EzBy_lax.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-lax-header))) - -;; Synthesize the Gkeyll private header code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-lax-priv-header - (gkyl-generate-lax-friedrichs-vector2-1d-priv-header pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EzBy_lax_priv.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-lax-priv-header))) - -;; Synthesize the Gkeyll source code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-lax-source - (gkyl-generate-lax-friedrichs-vector2-1d-source pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_maxwell_EzBy_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-lax-source))) - -;; Synthesize a Gkeyll C regression test for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-lax-regression - (gkyl-generate-lax-friedrichs-vector2-1d-regression pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_maxwell_EzBy_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-lax-regression))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-lax-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ez-By-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ez-By-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-lax-cfl-stability - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-maxwell-1d-Ez-By-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components) -(define proof-maxwell-1d-Ez-By-lax-local-lipschitz - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-maxwell-1d-Ez-By-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the Gkeyll header code for a Roe solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-roe-header - (gkyl-generate-roe-vector2-1d-header pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EzBy_roe.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-roe-header))) - -;; Synthesize the Gkeyll private header code for a Roe solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-roe-priv-header - (gkyl-generate-roe-vector2-1d-priv-header pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the private header code to a file. -(with-output-to-file "gkyl_code/gkyl_wv_maxwell_EzBy_roe_priv.h" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-roe-priv-header))) - -;; Synthesize the Gkeyll source code for a Roe solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-roe-source - (gkyl-generate-roe-vector2-1d-source pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the source code to a file. -(with-output-to-file "gkyl_code/wv_maxwell_EzBy_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-roe-source))) - -;; Synthesize a Gkeyll C regression test for a Roe solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-roe-regression - (gkyl-generate-roe-vector2-1d-regression pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the regression test to a file. -(with-output-to-file "gkyl_code/rt_maxwell_EzBy_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-roe-regression))) - - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-roe-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ez-By-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ez-By-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-roe-flux-conservation - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-maxwell-1d-Ez-By-roe-flux-conservation) -(display "\n") \ No newline at end of file diff --git a/provable-algorithms/prover_core.rkt b/provable-algorithms/prover_core.rkt deleted file mode 100644 index a8dd71f9..00000000 --- a/provable-algorithms/prover_core.rkt +++ /dev/null @@ -1,919 +0,0 @@ -#lang racket - -(require racket/trace) -(current-prefix-in " ") -(current-prefix-out " ") - -(provide symbolic-diff - symbolic-simp-rule - symbolic-simp - is-real - flux-deriv-replace - symbolic-roe-function - is-non-negative - variable-transform - symbolic-simp-positive-rule - symbolic-simp-positive - evaluate-limit-rule - evaluate-limit - prove-lax-friedrichs-scalar-1d-hyperbolicity - prove-lax-friedrichs-scalar-1d-cfl-stability - prove-lax-friedrichs-scalar-1d-local-lipschitz - prove-roe-scalar-1d-hyperbolicity - prove-roe-scalar-1d-flux-conservation - prove-flux-limiter-symmetry - prove-flux-limiter-tvd) - -;; Lightweight symbolic differentiator (differentiates expr with respect to var). -(define (symbolic-diff expr var) - (match expr - ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. - [(? symbol? symb) (cond - [(eq? symb var) 1.0] - [else 0.0])] - - ;; If expr is a numerical constant, then it differentiates to 0. - [(? number?) 0.0] - - ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] - ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] - - ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. - [`(* . ,terms) - (define n (length terms)) - (define (mult xs) (cons '* xs)) ; Multiplication helper function. - - ((lambda (sums) (cond - [(null? (cdr sums)) (car sums)] - [else (cons '+ sums)])) - (let loop ([i 0]) - (cond - [(= i n) `()] - [else - ;; Evaluate the derivative of the i-th term in the product. - (let ([di (symbolic-diff (list-ref terms i) var)]) - (cons - (mult (for/list ([j (in-range n)]) - (cond - [(= j i) di] - [else (list-ref terms j)]))) - (loop (add1 i))))])))] - - ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. - [`(/ ,x ,y) - `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] - - ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). - [`(abs ,arg) - `(* (sgn ,arg) ,(symbolic-diff arg var))] - - ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. - [`(sgn ,arg) 0.0] - - ;; Otherwise, return false. - [else #f])) - -;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). -(define (symbolic-simp-rule expr) - (match expr - ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. - [`(+ 0 ,x) `,x] - [`(+ 0.0 ,x) `,x] - [`(+ -0.0 ,x) `,x] - - ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. - [`(* 1 ,x) `,x] - [`(* 1.0 ,x) `,x] - - ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. - [`(* 0 ,x) 0] - [`(* 0.0 ,x) 0.0] - [`(* -0.0 ,x) 0.0] - - ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. - [`(- ,x 0) `,x] - [`(- ,x 0.0) `,x] - [`(- ,x -0.0) `,x] - - ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). - [`(- 0 ,x) `(* -1 ,x)] - [`(- 0.0 ,x) `(* -1.0 ,x)] - [`(- -0.0 ,x) `(* -1.0 ,x)] - - ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. - [`(/ ,x 1) `,x] - [`(/ ,x 1.0) `,x] - - ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). - [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] - [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] - - ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). - [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] - [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] - - ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. - [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] - [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] - - ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients - [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] - [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] - - ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. - [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] - - ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). - [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] - - ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). - [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] - - ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). - [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] - - ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). - [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] - - ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). - [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] - - ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). - [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] - ;; Likewise for differences. - [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] - - ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. - [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] - - ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). - [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] - - ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). - [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] - - ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. - [`(sqrt (* ,x ,x)) `,x] - [`(* (sqrt ,x) (sqrt ,x)) `,x] - - ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). - [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] - ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). - [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] - - ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). - [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] - - ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. - [`(sqrt ,(and x (? number?))) (sqrt x)] - - ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. - [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] - [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] - - ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., - [`(abs ,(and x (? number?))) (abs x)] - - ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). - [`(abs (* -1 ,x)) `(abs ,x)] - [`(abs (* -1.0 ,x)) `(abs ,x)] - - ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). - [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] - [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - - ;; If expr is of the form (x + x), thens implify to (2.0 * x). - [`(+ ,x ,x) `(* 2.0 ,x)] - - ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). - [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] - - ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). - [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] - - ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). - [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] - - ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). - [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] - - ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). - [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] - [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] - - ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). - [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] - - ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). - [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] - - ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). - [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] - [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - - ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). - [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] - - ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). - [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] - - ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. - [`(/ 0 ,x) 0] - [`(/ 0.0 ,x) 0.0] - [`(/ -0.0 ,x) 0.0] - - ;; If expr is of the form (x / x), then simplify to 1.0 - [`(/ ,x ,x) 1.0] - - ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). - [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] - ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). - [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] - - ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). - [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] - - ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). - [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] - [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] - - ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). - [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] - [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] - - ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for differences. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. - [`(* . ,terms) - `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for quotients. - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. - [`(sqrt ,arg) - `(sqrt ,(symbolic-simp-rule arg))] - - ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. - [`(abs ,arg) - `(abs ,(symbolic-simp-rule arg))] - - ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). - [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] - [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] - - ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). - [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). - [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] - - ;; Otherwise, return the expression. - [else expr])) - -;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). -(define (symbolic-simp expr) - (define simp-expr (symbolic-simp-rule expr)) - - (cond - [(equal? simp-expr expr) expr] - [else (symbolic-simp simp-expr)])) - -;; Recursively determine whether an expression corresponds to a real number. -(define (is-real expr cons-vars parameters) - (match expr - ;; Real numbers are trivially real. - [(? real?) #t] - - ;; Conserved variables are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (not (equal? (member arg cons-vars) #f)))) #t] - - ;; Simulation parameters are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (equal? arg (list-ref parameter 1))) parameters)))) #t] - - ;; The outcome of a conditional operation is real if both branches yield real numbers. - [`(cond - [,cond1 ,expr1] - [else ,expr2]) - (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] - - ;; The sum, difference, product, or quotient of two real numbers is always real. - [`(+ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(- . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(* . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(/ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - - ;; Otherwise, assume false. - [else #f])) - -;; Recursively replace conserved variable expressions within the flux derivative expression (for Roe functions). -(define (flux-deriv-replace flux-deriv-expr cons-expr new-cons-expr) - (match flux-deriv-expr - ;; If the flux derivative expression is just the conserved variable expression, then return the new conserved variable expression. - [(? (lambda (arg) - (equal? arg cons-expr))) new-cons-expr] - - ;; If the flux derivative expression consists of a sum, difference, product, or quotient, then recursively apply replacement to each term. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - [`(- . ,terms) - `(- ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - [`(* . ,terms) - `(* ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - - ;; Otherwise, return the flux derivative expression. - [else flux-deriv-expr])) - -;; Compute the symbolic Roe function (averaged flux derivative). -(define (symbolic-roe-function flux-deriv-expr cons-expr) - (symbolic-simp `(+ (* 0.5 ,(flux-deriv-replace flux-deriv-expr cons-expr (string->symbol (string-append (symbol->string cons-expr) "L")))) - (* 0.5 ,(flux-deriv-replace flux-deriv-expr cons-expr (string->symbol (string-append (symbol->string cons-expr) "R"))))))) - -;; Determine whether an expression is non-negative. -(define (is-non-negative expr parameters) - (match expr - ;; A non-negative number is, trivially, non-negative. - [(? (lambda (arg) - (and (number? arg) (or (>= arg 0) (>= arg 0.0))))) #t] - - ;; Simulation parameters that are non-negative are, trivially, non-negative. - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (and (equal? arg (list-ref parameter 1)) - (or (>= (list-ref parameter 2) 0) - (>= (list-ref parameter 2) 0.0)))) parameters)))) #t] - - ;; The sum, product, or quotient of two non-negative numbers is always non-negative. - [`(+ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] - [`(* ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] - [`(/ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] - - ;; Otherwise, assume false. - [else #f])) - -;; Recursively ransform all occurrences of a given variable within an expression to a new variable. -(define (variable-transform expr var new-var) - (cond - ;; Replace any occurrence of var in expr with new-var. - [(symbol? expr) (cond - [(equal? expr var) new-var] - [else expr])] - - ;; Recursively apply variable-transform to all subexpressions. - [(pair? expr) (map (lambda (subexpr) - (variable-transform subexpr var new-var)) expr)] - - ;; Otherwise, return the expression. - [else expr])) - -;; Lightweight symbolic simplification rules, assuming strict positivity of pos-var. -(define (symbolic-simp-positive-rule expr pos-var) - (match expr - ;; If expr is of the form (abs(x) / y), with y strictly positive, then simplify to abs(x / y). - [`(/ (abs ,x) ,pos-var) `(abs (/ ,x ,pos-var))] - - ;; If expr is of the form abs(x), abs(1 / x) or abs(1.0 / x), with x strictly positive, then simplify to x, (1 / x) or (1.0 / x). - [`(abs ,pos-var) pos-var] - [`(abs (/ 1 ,pos-var)) `(/ 1 ,pos-var)] - [`(abs (/ 1.0 ,pos-var)) `(/ 1.0 ,pos-var)] - - ;; If expr is of the form sgn(x), with x strictly positive, then simplify to 1.0. - [`(sgn ,pos-var) 1.0] - - ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. - [`(abs ,x) - `(abs ,(symbolic-simp-positive-rule x pos-var))] - - ;; If expr is of the form (max(x, y) / z) or (min(x, y) / z), with z strictly positive, then simplify to max((x / z), (y / z)) or min((x / z), (y / z)). - [`(/ (max ,x ,y) ,pos-var) `(max (/ ,y ,pos-var) (/ ,x ,pos-var))] - [`(/ (min ,x ,y) ,pos-var) `(min (/ ,y ,pos-var) (/ ,x ,pos-var))] - - ;; If expr is of the form (max(x, y, z) / w) or (min(x, y, z) / w), with w strictly positive, then simplify to max((x / w), (y / w), (z / w)) or min((x / w), (y / w), (z / w)). - [`(/ (max ,x ,y ,z) ,pos-var) `(max (/ ,z ,pos-var) (/ ,y ,pos-var) (/ ,x ,pos-var))] - [`(/ (min ,x ,y, z) ,pos-var) `(min (/ ,z ,pos-var) (/ ,y ,pos-var) (/ ,x ,pos-var))] - - ;; If expr is a max or a min of the form max(x, y, ...) or min(x, y, ...), then apply symbolic simplification to each term x, y, ... in the function. - [`(max . ,terms) - `(max ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] - [`(min . ,terms) - `(min ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] - - ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] - ;; Likewise for differences. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] - - ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. - [`(* . ,terms) - `(* ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] - ;; Likewise for quotients. - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (symbolic-simp-positive-rule term pos-var)) terms))] - - ;; Otherwise, return the expression. - [else expr])) - -;; Recursively apply the symbolic simplification rules (assuming strict positivity of pos-var) until the expression stops changing (fixed point). -(define (symbolic-simp-positive expr pos-var) - (define simp-pos-expr (symbolic-simp-positive-rule expr pos-var)) - - (cond - [(equal? simp-pos-expr expr) expr] - [else (symbolic-simp-positive simp-pos-expr pos-var)])) - -;; Lightweight symbolic limit evaluation rules (computes limit of expr as var approaches lim). -(define (evaluate-limit-rule expr var lim) - (match expr - ;; If expr is of the form max(x, y) for numeric x and y, then just evaluate the maximum of the pair. Likewise for minima. - [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] - [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] - - ;; If expr is of the form max(x, y, z) for numeric x, y and z, then just evaluate the maximum of the triple. Likewise for minima. - [`(max ,(and x (? number?)) ,(and y (? number?)) ,(and z (? number?))) (max x y z)] - [`(min ,(and x (? number?)) ,(and y (? number?)) ,(and z (? number?))) (min x y z)] - - ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value. - [`(abs ,(and x (? number?))) (abs x)] - - ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. - [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] - [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] - - ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients. - [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] - [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] - - ;; If expr is of the form max(expr1, expr2), then evaluate the limits of the interior expr1 and expr2. Likewise for minima. - [`(max ,x ,y) `(max ,(evaluate-limit-rule x var lim) ,(evaluate-limit-rule y var lim))] - [`(min ,x ,y) `(min ,(evaluate-limit-rule x var lim) ,(evaluate-limit-rule y var lim))] - - ;; If expr is of the form max(expr1, expr2, expr3), then evaluate the limits of the interior expr1, expr2 and expr3. Likewise for minima. - [`(max ,x ,y ,z) `(max ,(evaluate-limit-rule x var lim) ,(evaluate-limit-rule y var lim) ,(evaluate-limit-rule z var lim))] - [`(min ,x ,y ,z) `(min ,(evaluate-limit-rule x var lim) ,(evaluate-limit-rule y var lim) ,(evaluate-limit-rule z var lim))] - - ;; If expr is of the form abs(expr1), then evaluate the limit of the interior expr1. - [`(abs ,x) `(abs ,(evaluate-limit-rule x var lim))] - - ;; If expr is a sum of the form (x + y + ...), then evaluate the limits each term x, y, ... in the sum. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (evaluate-limit-rule term var lim)) terms))] - ;; Likewise for differences. - [`(- . ,terms) - `(- ,@(map (lambda (term) (evaluate-limit-rule term var lim)) terms))] - - ;; If expr is a product of the form (x * y * ...), then evaluate the limits each term x, y, ... in the product. - [`(* . ,terms) - `(* ,@(map (lambda (term) (evaluate-limit-rule term var lim)) terms))] - ;; Likewise for quotients. - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (evaluate-limit-rule term var lim)) terms))] - - ;; Otherwise, return the expression. - [else expr])) - -;; Recursively apply the limit evaluation rules until the expression stops changing (fixed point). -(define (evaluate-limit expr var limit) - (define limit-val (variable-transform expr var limit)) - (define limit-expr (evaluate-limit-rule limit-val var limit)) - - (cond - [(equal? limit-expr expr) expr] - [else (evaluate-limit limit-expr var limit)])) - -;; ---------------------------------------------------------------------------------------- -;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE -;; ---------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-scalar-1d-hyperbolicity pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 1D scalar PDE specified by `pde`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the derivative of the flux function is real (otherwise, return false). - [(not (is-real (symbolic-simp (symbolic-diff flux-expr cons-expr)) (list cons-expr) parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - - out) -(trace prove-lax-friedrichs-scalar-1d-hyperbolicity) - -;; ---------------------------------------------------------------------------------------- -;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE -;; ---------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-scalar-1d-cfl-stability pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 1D scalar PDE specified by `pde`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define max-speed-expr (hash-ref pde 'max-speed-expr)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the absolute value of the derivative of the flux function is symbolically equivalent to the maximum wave-speed estimate (otherwise, return false). - [(not (equal? (symbolic-simp `(abs ,(symbolic-diff flux-expr cons-expr))) - (symbolic-simp max-speed-expr))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - - out) -(trace prove-lax-friedrichs-scalar-1d-cfl-stability) - -;; ------------------------------------------------------------------------------------------------------------------------------------ -;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------------------------------------------------------------------ -(define (prove-lax-friedrichs-scalar-1d-local-lipschitz pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 1D scalar PDE specified by `pde`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace is-non-negative) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the flux function is convex, i.e. that the second derivative of the flux function is strictly non-negative (otherwise, return false). - [(let ([deriv (symbolic-simp (symbolic-diff (symbolic-simp (symbolic-diff flux-expr cons-expr)) cons-expr))]) - (not (is-non-negative deriv parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace is-non-negative) - - out) -(trace prove-lax-friedrichs-scalar-1d-local-lipschitz) - -;; ------------------------------------------------------------------------- -;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Scalar PDE -;; ------------------------------------------------------------------------- -(define (prove-roe-scalar-1d-hyperbolicity pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Prove that the Roe finite-volume method preserves hyperbolicity for the 1D scalar PDE specified by `pde`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-roe-function) - (trace flux-deriv-replace) - - (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the Roe function is real (otherwise, return false). - [(not (is-real (symbolic-roe-function flux-deriv cons-expr) (list - (string->symbol (string-append (symbol->string cons-expr) "L")) - (string->symbol (string-append (symbol->string cons-expr) "R"))) parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-roe-function) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-scalar-1d-hyperbolicity) - -;; ----------------------------------------------------------------------------------------------- -;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 1D Scalar PDE -;; ----------------------------------------------------------------------------------------------- -(define (prove-roe-scalar-1d-flux-conservation pde - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-func [init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])]) - "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 1D scalar PDE specified by `pde`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-func`: Racket expression for the initial condition, e.g. piecewise constant." - - (define cons-expr (hash-ref pde 'cons-expr)) - (define flux-expr (hash-ref pde 'flux-expr)) - (define parameters (hash-ref pde 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-roe-function) - (trace flux-deriv-replace) - - (define flux-deriv (symbolic-simp (symbolic-diff flux-expr cons-expr))) - - (define roe-jump (symbolic-simp `(* ,(symbolic-roe-function flux-deriv cons-expr) (- ,(string->symbol (string-append (symbol->string cons-expr) "L")) - ,(string->symbol (string-append (symbol->string cons-expr) "R")))))) - (define flux-jump (symbolic-simp `(- ,(flux-deriv-replace flux-expr cons-expr (string->symbol (string-append (symbol->string cons-expr) "L"))) - ,(flux-deriv-replace flux-expr cons-expr (string->symbol (string-append (symbol->string cons-expr) "R")))))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) (list cons-expr) parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(not (is-real init-func (list cons-expr) parameters)) #f] - - ;; Check whether the jump in the flux function is equal to the product of the Roe function and the jump in the conserved variable (otherwise, return false). - [(not (equal? roe-jump flux-jump)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-roe-function) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-scalar-1d-flux-conservation) - -;; ------------------------------------------------- -;; Prove symmetry for a High-Resolution Flux Limiter -;; ------------------------------------------------- -(define (prove-flux-limiter-symmetry limiter) - "Prove that the high-resolution flux limiter specified by `limiter-code` acts symmetrically on forward and backward gradients." - - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (trace variable-transform) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-simp-positive) - (trace symbolic-simp-positive-rule) - - (define out (cond - ;; Check whether the symmetry property phi(r) / r = phi(1 / r) holds (otherwise, return false). - [(not (equal? (symbolic-simp - (symbolic-simp-positive (symbolic-simp (symbolic-simp-positive `(/ ,limiter-expr ,limiter-ratio) limiter-ratio)) limiter-ratio)) - (symbolic-simp - (symbolic-simp-positive (symbolic-simp (symbolic-simp-positive (variable-transform limiter-expr limiter-ratio `(/ 1.0 ,limiter-ratio)) - limiter-ratio)) limiter-ratio)))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace variable-transform) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-simp-positive) - (untrace symbolic-simp-positive-rule) - - out) -(trace prove-flux-limiter-symmetry) - -;; --------------------------------------------------------------------------------------- -;; Prove second-order TVD (total variation diminishing) for a High-Resolution Flux Limiter -;; --------------------------------------------------------------------------------------- -(define (prove-flux-limiter-tvd limiter) - "Prove that the high-resolution flux limiter specified by `limiter-code` is second-order TVD (total variation diminishing)." - - (define limiter-expr (hash-ref limiter 'limiter-expr)) - (define limiter-ratio (hash-ref limiter 'limiter-ratio)) - - (trace variable-transform) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-simp-positive) - (trace symbolic-simp-positive-rule) - (trace evaluate-limit) - (trace evaluate-limit-rule) - - (define limiter-convexity (symbolic-simp (symbolic-diff (symbolic-simp-positive (symbolic-simp (symbolic-diff - (symbolic-simp-positive - (symbolic-simp limiter-expr) limiter-ratio) limiter-ratio)) - limiter-ratio) limiter-ratio))) - (define limiter-mid (evaluate-limit limiter-expr limiter-ratio 1.0)) - (define limiter-boundary-left (evaluate-limit limiter-expr limiter-ratio 0.0)) - (define limiter-boundary-right (evaluate-limit limiter-expr limiter-ratio 2.0)) - (define limiter-infinity (evaluate-limit limiter-expr limiter-ratio +inf.0)) - - (define out (cond - ;; Check whether the limiter function is concave, i.e. that the second derivative of the limiter function is negative (otherwise, return false). - [(or (not (number? limiter-convexity)) (> limiter-convexity 0.0)) #f] - - ;; Check whether the limiter function limits to 1.0 at the midpoint r = 1.0 (otherwise, return false). - [(or (not (number? limiter-mid)) (not (equal? limiter-mid 1.0))) #f] - - ;; Check whether the limiter function limits to between 0.0 and 1.0 inclusive at the left (r = 0.0) boundary (otherwise, return false). - [(or (not (number? limiter-boundary-left)) (> limiter-boundary-left 1.0) (< limiter-boundary-left 0.0)) #f] - - ;; Check whether the limiter function limits to between 1.0 and 2.0 inclusive at the right (r = 2.0) boundary (otherwise, return false). - [(or (not (number? limiter-boundary-right)) (> limiter-boundary-right 2.0) (< limiter-boundary-right 1.0)) #f] - - ;; Check whether the limiter function limits to less than 2.0 inclusive as r approaches +infinity (otherwise, return false). - [(or (not (number? limiter-infinity)) (> limiter-infinity 2.0)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace variable-transform) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-simp-positive) - (untrace symbolic-simp-positive-rule) - (untrace evaluate-limit) - (untrace evaluate-limit-rule) - - out) -(trace prove-flux-limiter-tvd) \ No newline at end of file diff --git a/provable-algorithms/prover_vector.rkt b/provable-algorithms/prover_vector.rkt deleted file mode 100644 index 1b0006a6..00000000 --- a/provable-algorithms/prover_vector.rkt +++ /dev/null @@ -1,1052 +0,0 @@ -#lang racket - -(require racket/trace) -(current-prefix-in " ") -(current-prefix-out " ") - -(provide symbolic-jacobian - symbolic-gradient - symbolic-hessian - symbolic-eigvals2 - is-non-zero - are-distinct - symbolic-roe-matrix - prove-lax-friedrichs-vector2-1d-hyperbolicity - prove-lax-friedrichs-vector2-1d-strict-hyperbolicity - prove-lax-friedrichs-vector2-1d-cfl-stability - prove-lax-friedrichs-vector2-1d-local-lipschitz - prove-roe-vector2-1d-hyperbolicity - prove-roe-vector2-1d-strict-hyperbolicity - prove-roe-vector2-1d-flux-conservation) - -;; Lightweight symbolic differentiator (differentiates expr with respect to var). -(define (symbolic-diff expr var) - (match expr - ;; If expr is a symbol, then it either differentiates to 1 (if it's equal to var), or 0 otherwise. - [(? symbol? symb) (cond - [(eq? symb var) 1.0] - [else 0.0])] - - ;; If expr is a numerical constant, then it differentiates to 0. - [(? number?) 0.0] - - ;; If expr is a sum of the form (+ expr1 expr2 ...), then it differentiates to a sum of derivatives (+ expr1' expr2' ...), by linearity. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-diff term var)) terms))] - ;; Likewise for differences of the form (- expr1 expr2 ...), which differentiate to (- expr1' expr2' ...), by linearity. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-diff term var)) terms))] - - ;; If expr is a product of the form (* expr1 expr2 ...), then it differentiates to (+ (* expr1' expr2 ...) (* expr1 expr2' ...) ...), by the product rule. - [`(* . ,terms) - (define n (length terms)) - (define (mult xs) (cons '* xs)) ; Multiplication helper function. - - ((lambda (sums) (cond - [(null? (cdr sums)) (car sums)] - [else (cons '+ sums)])) - (let loop ([i 0]) - (cond - [(= i n) `()] - [else - ;; Evaluate the derivative of the i-th term in the product. - (let ([di (symbolic-diff (list-ref terms i) var)]) - (cons - (mult (for/list ([j (in-range n)]) - (cond - [(= j i) di] - [else (list-ref terms j)]))) - (loop (add1 i))))])))] - - ;; If expr is a quotient of the form (/ expr1 expr2), then it differentiates to (/ (- (* expr2 expr1') (expr1 expr2') (* expr2 expr2)), by the quotient rule. - [`(/ ,x ,y) - `(/ (- (* ,y ,(symbolic-diff x var)) (* ,x ,(symbolic-diff y var))) (* ,y ,y))] - - ;; If expr is an absolute value of the form (abs expr1), then it differentiates to (sgn expr1'). - [`(abs ,arg) - `(* (sgn ,arg) ,(symbolic-diff arg var))] - - ;; If expr is a sign function of the form (sgn expr1), then it differentiates to 0.0. - [`(sgn ,arg) 0.0] - - ;; Otherwise, return false. - [else #f])) - -;; Lightweight symbolic simplification rules (simplifies expr using only correctness-preserving algebraic transformations). -(define (symbolic-simp-rule expr) - (match expr - ;; If expr is of the form (0 + x) or (0.0 + x), then simplify to x. - [`(+ 0 ,x) `,x] - [`(+ 0.0 ,x) `,x] - [`(+ -0.0 ,x) `,x] - - ;; If expr is of the form (1 * x) or (1.0 * x), then simplify to x. - [`(* 1 ,x) `,x] - [`(* 1.0 ,x) `,x] - - ;; If expr is of the form (0 * x) or (0.0 * x), then simplify to 0 or 0.0. - [`(* 0 ,x) 0] - [`(* 0.0 ,x) 0.0] - [`(* -0.0 ,x) 0.0] - - ;; If expr is of the form (x - 0) or (x - 0.0), then simplify to x. - [`(- ,x 0) `,x] - [`(- ,x 0.0) `,x] - [`(- ,x -0.0) `,x] - - ;; If expr is of the form (0 - x) or (0.0 - x), then simplify to (-1 * x) or (-1.0 * x). - [`(- 0 ,x) `(* -1 ,x)] - [`(- 0.0 ,x) `(* -1.0 ,x)] - [`(- -0.0 ,x) `(* -1.0 ,x)] - - ;; If expr is of the form (x / 1) or (x / 1.0), then simplify to x. - [`(/ ,x 1) `,x] - [`(/ ,x 1.0) `,x] - - ;; Enforce right associativity of addition: if expr is of the form ((x + y) + z) or (x + y + z), then simplify to (x + (y + z)). - [`(+ (+ ,x ,y) ,z) `(+ ,x (+ ,y ,z))] - [`(+ ,x ,y ,z) `(+ (+ ,x ,y) ,z)] - - ;; Enforce right associativity of multiplication: if expr is of the form ((x * y) * z) or (x * y * z), then simplify to (x * (y * z)). - [`(* (* ,x ,y) ,z) `(* ,x (* ,y ,z))] - [`(* ,x ,y ,z) `(* (* ,x ,y) ,z)] - - ;; If expr is of the form (x + y) for numeric x and y, then just evaluate the sum. Likewise for differences. - [`(+ ,(and x (? number?)) ,(and y (? number?))) (+ x y)] - [`(- ,(and x (? number?)) ,(and y (? number?))) (- x y)] - - ;; If expr is of the form (x * y) for numeric x and y, then just evaluate the product. Likewise for quotients - [`(* ,(and x (? number?)) ,(and y (? number?))) (* x y)] - [`(/ ,(and x (? number?)) ,(and y (? number?))) (/ x y)] - - ;; If expr is of the form (x * (y + z)) for numeric x, y and z, then just evaluate the product and sum. - [`(* ,(and x (? number?)) (+ ,(and y (? number?)) ,(and z (? number?)))) (* x (+ y z))] - - ;; If expr is of the form ((x - y) * (x - y)), then simplify to (((x * x) + (y * y)) - (2 * (x * y))). - [`(* (- ,x ,y) (- ,x ,y)) `(- (+ (* ,x ,x) (* ,y ,y)) (* 2.0 (* ,x ,y)))] - - ;; If expr is of the form ((a / b) * (c / d)), then simplify to ((a * c) / (b * d)). - [`(* (/ ,a ,b) (/ ,c ,d)) `(/ (* ,a ,c) (* ,b ,d))] - - ;; If expr is of the form ((a * (b * c)) / (c * d)), then simplify to ((a * b) / d). - [`(/ (* ,a (* ,b ,c)) (* ,c ,d)) `(/ (* ,a ,b) ,d)] - - ;; If expr is of the form ((a * b) + (c - (d * b))), then simplify to (((a - d) * b) + c). - [`(+ (* ,a ,b) (- ,c (* ,d ,b))) `(+ (* (- ,a ,d) ,b) ,c)] - - ;; If expr is of the form ((a - b) * x) for symbolic x, then simplify to (x * (a - b)). - [`(* (- ,a ,b) ,(and x (? symbol?))) `(* ,x (- ,a ,b))] - - ;; Enforce (reverse) distributive property: if expr is a sum of the form ((a * x) + (b * x)), then simplify to ((a + b) * x). - [`(+ (* ,a, x) (* ,b ,x)) `(* (+ ,a ,b) ,x)] - ;; Likewise for differences. - [`(- (* ,a, x) (* ,b ,x)) `(* (- ,a ,b) ,x)] - - ;; If expr is of the form (x * (y * z)) for numeric numeric x and y, then evaluate the product of x and y. - [`(* ,(and x (? number?)) (* ,(and y (? number?)) ,z)) `(* ,(* x y) ,z)] - - ;; Move numbers to the left: if expr is of the form (x + y) for non-numeric x but numeric y, then simplify to (y + x). - [`(+ ,(and x (not (? number?))) ,(and y (? number?))) `(+ ,y ,x)] - - ;; Move numbers to the left: if expr is of the form (x * y) for non-numeric x but numeric y, then simplify to (y * x). - [`(* ,(and x (not (? number?))) ,(and y (? number?))) `(* ,y ,x)] - - ;; If expr is of the form sqrt(x * x) or (sqrt(x) * sqrt(x)), then simplify to x. - [`(sqrt (* ,x ,x)) `,x] - [`(* (sqrt ,x) (sqrt ,x)) `,x] - - ;; If expr is of the form (sqrt(x) * (y * sqrt(x))), then simplify to (y * x). - [`(* (sqrt,x) (* ,y (sqrt ,x))) `(* ,y ,x)] - ;; Likewise, if expr is of the form (sqrt(x) * (sqrt(x) * y)), then simplify to (x * y). - [`(* (sqrt,x) (* (sqrt ,x) ,y)) `(* ,x ,y)] - - ;; If expr is of the form sqrt(x * y), then simplify to (sqrt(x) * sqrt(y)). - [`(sqrt (* ,x ,y)) `(* (sqrt ,x) (sqrt ,y))] - - ;; If expr if of the form sqrt(x) for numeric x, then just evaluate the square root. - [`(sqrt ,(and x (? number?))) (sqrt x)] - - ;; If expr is of the form max(x, y) or min(x, y) for numeric x and y, then just evaluate the maximum/minimum. - [`(max ,(and x (? number?)) ,(and y (? number?))) (max x y)] - [`(min ,(and x (? number?)) ,(and y (? number?))) (min x y)] - - ;; If expr is of the form abs(x) for numeric x, then just evaluate the absolute value., - [`(abs ,(and x (? number?))) (abs x)] - - ;; If expr is of the form abs(-1 * x) or abs(-1.0 * x), then simplify to abs(x). - [`(abs (* -1 ,x)) `(abs ,x)] - [`(abs (* -1.0 ,x)) `(abs ,x)] - - ;; If expr is of the form (0 - (x * y)) or (0.0 - (x * y)), then simplify to ((0 - x) * y) or ((0.0 - x) * y). - [`(- 0 (* ,x ,y)) `(* (- 0 ,x) ,y)] - [`(- 0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - [`(- -0.0 (* ,x ,y)) `(* (- 0.0 ,x) ,y)] - - ;; If expr is of the form (x + x), thens implify to (2.0 * x). - [`(+ ,x ,x) `(* 2.0 ,x)] - - ;; If expr is of the form ((x * y) / (x * z)), then simplify to (y / z). - [`(/ (* ,x ,y) (* ,x ,z)) `(/ ,y ,z)] - - ;; If expr is of the form ((x / y) * (x / y)), then simplify to ((x * x) / (y * y)). - [`(* (/ ,x ,y) (/ ,x ,y)) `(/ (* ,x ,x) (* ,y ,y))] - - ;; If expr is of the form (x * (y * z)) for numeric y and non-numeric x and z, then simplify to (y * (x * z)). - [`(* ,(and x (not (? number?))) (* ,(and y (? number?)) ,(and z (not (? number?))))) `(* ,y (* ,x ,z))] - - ;; Enforce distributive property: if expr is of the form (x * (a + b)), then simplify to ((x * a) + (x * b)). - [`(* ,x (+ ,a ,b)) `(+ (* ,x ,a) (* ,x ,b))] - - ;; If expr is of the form (x * (-y / z)), then simplify to (-x * (y / z)). - [`(* ,x (/ (* -1 ,y) ,z)) `(* (* -1 ,x) (/ ,y ,z))] - [`(* ,x (/ (* -1.0 ,y) ,z)) `(* (* -1.0 ,x ) (/ ,y ,z))] - - ;; If expr is of the form ((x * y) / z) for numeric x, then simplify to (x * (y / z)). - [`(/ (* ,(and x (? number?)) ,y) ,z) `(* ,x (/ ,y ,z))] - - ;; If expr is of the form ((a * x) + (y + (b * x))) for numeric a and b, then simplify to (((a + b) * x) + y). - [`(+ (* ,(and a (? number?)) ,x) (+ ,y (* ,(and b (? number?)) ,x))) `(+ (* (+ ,a ,b) ,x) ,y)] - - ;; If expr is of the form (a + (x / y)) or (-a + (x / y)) for symbolic a, then simplify to ((x / y) + a) or ((x / y) - a). - [`(+ ,(and a (? symbol?)) (/ ,x ,y)) `(+ (/ ,x ,y) ,a)] - [`(+ (* -1 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - [`(+ (* -1.0 ,(and a (? symbol?))) (/ ,x ,y)) `(- (/ ,x ,y) ,a)] - - ;; Enforce (reverse) distributive property: if expr is of the form ((a * x) - (a * y)), then simplify to (a * (x - y)). - [`(- (* ,a ,x) (* ,a ,y)) `(* ,a (- ,x ,y))] - - ;; If expr is of the form (((a * x) + (a * y)) * (x - y)), then simplify to ((a * (x * x)) - (a * (y * y))). - [`(* (+ (* ,a ,x) (* ,a ,y)) (- ,x ,y)) `(- (* ,a (* ,x ,x)) (* ,a (* ,y ,y)))] - - ;; If expr is of the form (0 / x) or (0.0 / x), then simplify to 0 or 0.0. - [`(/ 0 ,x) 0] - [`(/ 0.0 ,x) 0.0] - [`(/ -0.0 ,x) 0.0] - - ;; If expr is of the form (x / x), then simplify to 1.0 - [`(/ ,x ,x) 1.0] - - ;; If expr is of the form (x * (y / z)) for numeric x and y, then evaluate the product to yield ((x * y) / z). - [`(* ,(and x (? number?)) (/ ,(and y (? number?)) ,z)) `(/ ,(* x y) ,z)] - ;; Likewise, if expr is of the form ((x / y) / z) for numeric x and z, then evaluate the quotient to yield ((x / z) / y). - [`(/ (/ ,(and x (? number?)) ,y) ,(and z (? number?))) `(/ ,(/ x z) ,y)] - - ;; If expr is of the form ((x / y) / x), then simplify to (1.0 / y). - [`(/ (/ ,x ,y) ,x) `(/ 1.0 ,y)] - - ;; If expr is of the form ((x / y) / (z + (x / y))), or ((x / y) / ((x / y) + z), then simplify to (x / ((z * y) + x)) or (x / (x + (z * y))). - [`(/ (/ ,x ,y) (+ ,z (/ ,x ,y))) `(/ ,x (+ (* ,z ,y) ,x))] - [`(/ (/ ,x ,y) (+ (/ ,x ,y) ,z)) `(/ ,x (+ ,x (* ,z ,y)))] - - ;; If expr is of the form ((x + y) / z) or ((x - y) / z), then simplify to ((x / z) + (y / z)) or ((x / z) - (y / z)). - [`(/ (+ ,x ,y) ,z) `(+ (/ ,x ,z) (/ ,y ,z))] - [`(/ (- ,x ,y) ,z) `(- (/ ,x ,z) (/ ,y ,z))] - - ;; If expr is a sum of the form (x + y + ...), then apply symbolic simplification to each term x, y, ... in the sum. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for differences. - [`(- . ,terms) - `(- ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is a product of the form (x * y * ...), then apply symbolic simplification to each term x, y, ... in the product. - [`(* . ,terms) - `(* ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - ;; Likewise for quotients. - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (symbolic-simp-rule term)) terms))] - - ;; If expr is of the form sqrt(expr1), then apply symbolic simplification to the interior expr1. - [`(sqrt ,arg) - `(sqrt ,(symbolic-simp-rule arg))] - - ;; If expr is of the form abs(expr1), then apply symbolic simplification to the interior expr1. - [`(abs ,arg) - `(abs ,(symbolic-simp-rule arg))] - - ;; If expr is of the form max(x, y, z) or min(x, y, z), then simplify to max(max(x, y), z) or min(min(x, y), z). - [`(max ,x ,y ,z) `(max (max ,x ,y) ,z)] - [`(min ,x ,y ,z) `(min (min ,x ,y) ,z)] - - ;; If expr is of the form max(x, y), then simplify to ((0.5 * (x + y)) + (0.5 * abs(x - y))). - [`(max ,x ,y) `(+ (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is of the form min(x, y), then simplify to ((0.5 * (x + y)) - (0.5 * abs(x - y))). - [`(min ,x ,y) `(- (* 0.5 (+ ,x ,y)) (* 0.5 (abs (- ,x ,y))))] - - ;; If expr is a complex number whose imaginary part is equal to 0.0 or -0.0, then simplify to Re(expr). - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) 0.0)))) (real-part expr)] - [(? (lambda (arg) - (and (number? arg) (not (real? arg )) (equal? (imag-part arg) -0.0)))) (real-part expr)] - - ;; Otherwise, return the expression. - [else expr])) - -;; Recursively apply the symbolic simplification rules until the expression stops changing (fixed point). -(define (symbolic-simp expr) - (define simp-expr (symbolic-simp-rule expr)) - - (cond - [(equal? simp-expr expr) expr] - [else (symbolic-simp simp-expr)])) - -;; Recursively determine whether an expression corresponds to a real number. -(define (is-real expr cons-vars parameters) - (match expr - ;; Real numbers are trivially real. - [(? real?) #t] - - ;; Conserved variables are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (not (equal? (member arg cons-vars) #f)))) #t] - - ;; Simulation parameters are assumed to be real (this is enforced elsewhere). - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (equal? arg (list-ref parameter 1))) parameters)))) #t] - - ;; The outcome of a conditional operation is real if both branches yield real numbers. - [`(cond - [,cond1 ,expr1] - [else ,expr2]) - (and (is-real expr1 cons-vars parameters) (is-real expr2 cons-vars parameters))] - - ;; The sum, difference, product, or quotient of two real numbers is always real. - [`(+ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(- . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(* . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - [`(/ . ,terms) - (andmap (lambda (term) (is-real term cons-vars parameters)) terms)] - - ;; Otherwise, assume false. - [else #f])) - -;; Recursively replace conserved variable expressions within the flux derivative expression (for Roe functions). -(define (flux-deriv-replace flux-deriv-expr cons-expr new-cons-expr) - (match flux-deriv-expr - ;; If the flux derivative expression is just the conserved variable expression, then return the new conserved variable expression. - [(? (lambda (arg) - (equal? arg cons-expr))) new-cons-expr] - - ;; If the flux derivative expression consists of a sum, difference, product, or quotient, then recursively apply replacement to each term. - [`(+ . ,terms) - `(+ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - [`(- . ,terms) - `(- ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - [`(* . ,terms) - `(* ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - [`(/ . ,terms) - `(/ ,@(map (lambda (term) (flux-deriv-replace term cons-expr new-cons-expr)) terms))] - - ;; Otherwise, return the flux derivative expression. - [else flux-deriv-expr])) - -;; Compute symbolic Jacobian matrix by mapping symbolic differentiation over exprs with respect to vars. -(define (symbolic-jacobian exprs vars) - (map (lambda (expr) - (map (lambda (var) - (symbolic-simp (symbolic-diff expr var))) - vars)) - exprs)) - -;; Compute symbolic gradient vector by applying symbolic differentiation to expr, mapped over vars. -(define (symbolic-gradient expr vars) - (map (lambda (var) - (symbolic-simp (symbolic-diff expr var))) - vars)) - -;; Compute symbolic Hessian matrix by computing the symbolic Jacobian matrix of the symbolic gradient vector of expr with respect to vars. -(define (symbolic-hessian expr vars) - (symbolic-jacobian (symbolic-gradient expr vars) vars)) - -;; Compute symbolic eigenvalues of a 2x2 symbolic matrix via explicit solution of the characteristic polynomial. -(define (symbolic-eigvals2 matrix) - (let ([a (list-ref (list-ref matrix 0) 0)] - [b (list-ref (list-ref matrix 0) 1)] - [c (list-ref (list-ref matrix 1) 0)] - [d (list-ref (list-ref matrix 1) 1)]) - (cond - ;; Optimization to shorten certain proofs: if the matrix consists solely of zeroes, then just output a pair of zeroes. - [(and (equal? a 0.0) (equal? b 0.0) (equal? c 0.0) (equal? d 0.0)) (list 0.0 0.0)] - - ;; Otherwise, calculate the eigenvalues explicitly. - [else (list `(* 0.5 (+ (- ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)) - `(* 0.5 (+ (+ ,a (sqrt (+ (* 4.0 ,b ,c) (* (- ,a ,d) (- ,a ,d))))) ,d)))]))) - -;; Determine whether an expression is non-zero. -(define (is-non-zero expr parameters) - (match expr - ;; A non-zero number is, trivially, non-zero. - [(? (lambda (arg) - (and (number? arg) (not (equal? arg 0)) (not (equal? arg 0.0))))) #t] - - ;; Simulation parameters that are non-zero are, trivially, non-zero. - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (and (equal? arg (list-ref parameter 1)) - (or (not (equal? (list-ref parameter 2) 0)) - (not (equal? (list-ref parameter 2) 0.0))))) parameters)))) #t] - - ;; The product of two non-zero numbers is always non-zero. - [`(* ,x ,y) (and (is-non-zero x parameters) (is-non-zero y parameters))] - - ;; Otherwise, assume false. - [else #f])) - -;; Recursively determine whether two expressions are distinct. -(define (are-distinct expr parameters) - (match expr - ;; Two numbers that are unequal are, trivially, distinct. - [(? (lambda (arg) - (and (number? (list-ref arg 0)) (number? (list-ref arg 1)) (not (equal? (list-ref arg 0) (list-ref arg 1)))))) #t] - - ;; Expressions of the form (expr, -expr) or (-expr, expr) are distinct, so long as expr is non-zero. - [`(,x (* -1 ,x)) (is-non-zero x parameters)] - [`(,x (* -1.0 ,x)) (is-non-zero x parameters)] - [`((* -1 ,x) ,x) (is-non-zero x parameters)] - [`((* -1.0 ,x) ,x) (is-non-zero x parameters)] - - ;; Expressions of the form ((x + y), (x - y)) or ((x - y), (x + y)) are distinct, so long as y is non-zero. - [`((+ ,x ,y) (- ,x ,y)) (is-non-zero y parameters)] - [`((- ,x ,y) (+ ,x ,y)) (is-non-zero y parameters)] - - ;; Otherwise, assume false. - [else #f])) - -;; Compute the symbolic Roe matrix (averaged flux Jacobian). -(define (symbolic-roe-matrix flux-jacobian cons-exprs) - (map (lambda (row) - (map (lambda (column) - (symbolic-simp `(+ (* 0.5 ,(flux-deriv-replace (flux-deriv-replace column (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")))) - (* 0.5 ,(flux-deriv-replace (flux-deriv-replace column (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))))) - row)) - flux-jacobian)) - -;; Determine whether an expression is non-negative. -(define (is-non-negative expr parameters) - (match expr - ;; A non-negative number is, trivially, non-negative. - [(? (lambda (arg) - (and (number? arg) (or (>= arg 0) (>= arg 0.0))))) #t] - - ;; Simulation parameters that are non-negative are, trivially, non-negative. - [(? (lambda (arg) - (and (not (empty? parameters)) (ormap (lambda (parameter) - (and (equal? arg (list-ref parameter 1)) - (or (>= (list-ref parameter 2) 0) - (>= (list-ref parameter 2) 0.0)))) parameters)))) #t] - - ;; The sum, product, or quotient of two non-negative numbers is always non-negative. - [`(+ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] - [`(* ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] - [`(/ ,x ,y) (and (is-non-negative x parameters) (is-non-negative y parameters))] - - ;; Otherwise, assume false. - [else #f])) - -;; ------------------------------------------------------------------------------------------------------------- -;; Prove hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Lax-Friedrichs finite-difference method preserves hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - - (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define flux-eigvals-simp (list - (symbolic-simp (list-ref flux-eigvals 0)) - (symbolic-simp (list-ref flux-eigvals 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the flux Jacobian are all real (otherwise, return false). - [(or (not (is-real (list-ref flux-eigvals-simp 0) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp 1) cons-exprs parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - - out) -(trace prove-lax-friedrichs-vector2-1d-hyperbolicity) - -;; -------------------------------------------------------------------------------------------------------------------- -;; Prove strict hyperbolicity of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; -------------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Lax-Friedrichs finite-difference method preserves strict hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - (trace is-non-zero) - (trace are-distinct) - - (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define flux-eigvals-simp (list - (symbolic-simp (list-ref flux-eigvals 0)) - (symbolic-simp (list-ref flux-eigvals 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the flux Jacobian are all real (otherwise, return false). - [(or (not (is-real (list-ref flux-eigvals-simp 0) cons-exprs parameters)) - (not (is-real (list-ref flux-eigvals-simp 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the flux Jacobian are all distinct (otherwise, return false). - [(not (are-distinct flux-eigvals-simp parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - (untrace is-non-zero) - (untrace are-distinct) - - out) -(trace prove-lax-friedrichs-vector2-1d-strict-hyperbolicity) - -;; ------------------------------------------------------------------------------------------------------------- -;; Prove CFL stability of the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; ------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Lax-Friedrichs finite-difference method is CFL stable for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define max-speed-exprs (hash-ref pde-system 'max-speed-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - - (define flux-eigvals (symbolic-eigvals2 (symbolic-jacobian flux-exprs cons-exprs))) - (define max-speed-exprs-simp (list - (symbolic-simp (list-ref max-speed-exprs 0)) - (symbolic-simp (list-ref max-speed-exprs 1)))) - (define flux-eigvals-simp (list - (symbolic-simp `(abs ,(list-ref flux-eigvals 0))) - (symbolic-simp `(abs ,(list-ref flux-eigvals 1))))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the absolute eigenvalues of the flux Jacobian are symbolically equivalent to the maximum wave-speed estimates (otherwise, return false). - [(or (equal? (member (list-ref flux-eigvals-simp 0) max-speed-exprs-simp) #f) - (equal? (member (list-ref flux-eigvals-simp 1) max-speed-exprs-simp) #f)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - - out) -(trace prove-lax-friedrichs-vector2-1d-cfl-stability) - -;; --------------------------------------------------------------------------------------------------------------------------------------------------------- -;; Prove local Lipschitz continuity of the discrete flux function for the Lax–Friedrichs (Finite-Difference) Solver for a 1D Coupled Vector System of 2 PDEs -;; --------------------------------------------------------------------------------------------------------------------------------------------------------- -(define (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Lax-Friedrichs finite-difference method has a discrete flux function that satisfies local Lipschitz continuity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - (trace symbolic-gradient) - (trace symbolic-hessian) - (trace is-non-negative) - - (define hessian-mats (list - (symbolic-hessian (list-ref flux-exprs 0) cons-exprs) - (symbolic-hessian (list-ref flux-exprs 1) cons-exprs))) - (define hessian-eigvals (list - (symbolic-eigvals2 (list-ref hessian-mats 0)) - (symbolic-eigvals2 (list-ref hessian-mats 1)))) - (define hessian-eigvals-simp (list - (symbolic-simp (list-ref (list-ref hessian-eigvals 0) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals 0) 1)) - (symbolic-simp (list-ref (list-ref hessian-eigvals 1) 0)) - (symbolic-simp (list-ref (list-ref hessian-eigvals 1) 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the flux function is convex, i.e. that the Hessian matrix for each flux component is positive semidefinite (otherwise, return false). - [(or (not (is-non-negative (list-ref hessian-eigvals-simp 0) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp 1) parameters)) - (not (is-non-negative (list-ref hessian-eigvals-simp 2) parameters)) (not (is-non-negative (list-ref hessian-eigvals-simp 3) parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - (untrace symbolic-gradient) - (untrace symbolic-hessian) - (untrace is-non-negative) - - out) -(trace prove-lax-friedrichs-vector2-1d-local-lipschitz) - -;; ---------------------------------------------------------------------------------------------- -;; Prove hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; ---------------------------------------------------------------------------------------------- -(define (prove-roe-vector2-1d-hyperbolicity pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Roe finite-volume method preserves hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - (trace symbolic-roe-matrix) - (trace flux-deriv-replace) - - (define roe-matrix-eigvals (symbolic-eigvals2 (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs))) - (define roe-matrix-eigvals-simp (list - (symbolic-simp (list-ref roe-matrix-eigvals 0)) - (symbolic-simp (list-ref roe-matrix-eigvals 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the Roe matrix are all real (otherwise, return false). - [(or (not (is-real (list-ref roe-matrix-eigvals-simp 0) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters)) - (not (is-real (list-ref roe-matrix-eigvals-simp 1) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - (untrace symbolic-roe-matrix) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-vector2-1d-hyperbolicity) - -;; ----------------------------------------------------------------------------------------------------- -;; Prove strict hyperbolicity of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; ----------------------------------------------------------------------------------------------------- -(define (prove-roe-vector2-1d-strict-hyperbolicity pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Roe finite-volume method preserves strict hyperbolicity for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-eigvals2) - (trace symbolic-roe-matrix) - (trace flux-deriv-replace) - (trace is-non-zero) - (trace are-distinct) - - (define roe-matrix-eigvals (symbolic-eigvals2 (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs))) - (define roe-matrix-eigvals-simp (list - (symbolic-simp (list-ref roe-matrix-eigvals 0)) - (symbolic-simp (list-ref roe-matrix-eigvals 1)))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the eigenvalues of the Roe matrix are all real (otherwise, return false). - [(or (not (is-real (list-ref roe-matrix-eigvals-simp 0) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters)) - (not (is-real (list-ref roe-matrix-eigvals-simp 1) (list - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))) parameters))) #f] - - ;; Check whether the eigenvalues of the Roe matrix are all distinct (otherwise, return false). - [(not (are-distinct roe-matrix-eigvals-simp parameters)) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-eigvals2) - (untrace symbolic-roe-matrix) - (untrace flux-deriv-replace) - (untrace is-non-zero) - (untrace are-distinct) - - out) -(trace prove-roe-vector2-1d-strict-hyperbolicity) - -;; -------------------------------------------------------------------------------------------------------------------- -;; Prove flux conservation (jump continuity) of the Roe (Finite-Volume) Solver for a 1D Coupled Vector System of 2 PDEs -;; -------------------------------------------------------------------------------------------------------------------- -(define (prove-roe-vector2-1d-flux-conservation pde-system - #:nx [nx 200] - #:x0 [x0 0.0] - #:x1 [x1 2.0] - #:t-final [t-final 1.0] - #:cfl [cfl 0.95] - #:init-funcs [init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))]) - "Prove that the Roe finite-volume method preserves flux conservation (jump continuity) for the 1D coupled vector system of 2 PDEs specified by `pde-system`. - - `nx` : Number of spatial cells. - - `x0`, `x1` : Domain boundaries. - - `t-final`: Final time. - - `cfl`: CFL coefficient. - - `init-funcs`: Racket expressions for the initial conditions, e.g. piecewise constant." - - (define cons-exprs (hash-ref pde-system 'cons-exprs)) - (define flux-exprs (hash-ref pde-system 'flux-exprs)) - (define parameters (hash-ref pde-system 'parameters)) - - (trace is-real) - (trace symbolic-simp) - (trace symbolic-simp-rule) - (trace symbolic-diff) - (trace symbolic-jacobian) - (trace symbolic-roe-matrix) - (trace flux-deriv-replace) - - (define roe-matrix (symbolic-roe-matrix (symbolic-jacobian flux-exprs cons-exprs) cons-exprs)) - (define cons-jump (list (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L")) - ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R")))) - (symbolic-simp `(- ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L")) - ,(string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R")))))) - - (define roe-jump (list (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix 0) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix 0) 1) ,(list-ref cons-jump 1)))) - (symbolic-simp `(+ (* ,(list-ref (list-ref roe-matrix 1) 0) ,(list-ref cons-jump 0)) - (* ,(list-ref (list-ref roe-matrix 1) 1) ,(list-ref cons-jump 1)))))) - (define flux-jump (list (symbolic-simp `(- ,(flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs 0) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - ,(flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs 0) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))) - (symbolic-simp `(- ,(flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs 1) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "L"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "L"))) - ,(flux-deriv-replace - (flux-deriv-replace (list-ref flux-exprs 1) (list-ref cons-exprs 0) - (string->symbol (string-append (symbol->string (list-ref cons-exprs 0)) "R"))) - (list-ref cons-exprs 1) (string->symbol (string-append (symbol->string (list-ref cons-exprs 1)) "R"))))))) - - (define out (cond - ;; Check whether the CFL coefficient is greater than 0 and less than or equal to 1 (otherwise, return false). - [(or (<= cfl 0) (> cfl 1)) #f] - - ;; Check whether the number of spatial cells is at least 1 and the right domain boundary is set to the right of the left boundary (otherwise, return false) - [(or (< nx 1) (>= x0 x1)) #f] - - ;; Check whether the final simulation time is non-negative (otherwise, return false). - [(< t-final 0) #f] - - ;; Check whether the simulation parameter(s) correspond to real numbers (otherwise, return false). - [(not (or (empty? parameters) (andmap (lambda (parameter) - (is-real (list-ref parameter 2) cons-exprs parameters)) parameters))) #f] - - ;; Check whether the initial condition(s) correspond to real numbers (otherwise, return false). - [(or (not (is-real (list-ref init-funcs 0) cons-exprs parameters)) - (not (is-real (list-ref init-funcs 1) cons-exprs parameters))) #f] - - ;; Check whether the jump in the flux vector is equal to the product of the Roe matrix and the jump in the conserved variable vector (otherwise, return false). - [(or (not (equal? (list-ref roe-jump 0) (list-ref flux-jump 0))) - (not (equal? (list-ref roe-jump 1) (list-ref flux-jump 1)))) #f] - - ;; Otherwise, return true. - [else #t])) - - (untrace is-real) - (untrace symbolic-simp) - (untrace symbolic-simp-rule) - (untrace symbolic-diff) - (untrace symbolic-jacobian) - (untrace symbolic-roe-matrix) - (untrace flux-deriv-replace) - - out) -(trace prove-roe-vector2-1d-flux-conservation) \ No newline at end of file diff --git a/provable-algorithms/test_inviscid_burgers.rkt b/provable-algorithms/test_inviscid_burgers.rkt deleted file mode 100644 index b2400d51..00000000 --- a/provable-algorithms/test_inviscid_burgers.rkt +++ /dev/null @@ -1,217 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "prover_core.rkt") -(provide (all-from-out "code_generator_core.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D inviscid Burgers' equation: du/dt + u du/dx = 0. -(define pde-inviscid-burgers - (hash - 'name "inviscid-burgers" - 'cons-expr `u ; conserved variable: u - 'flux-expr `(* 0.5 u u) ; flux function: f(u) = 0.5 * u^2 - 'max-speed-expr `(abs u) ; local wave-speed: alpha = |u| - 'parameters `() - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.0) -(define x1 1.0) -(define t-final 0.5) -(define cfl 0.95) -(define init-func `(cond - [(< x 0.0) 1.0] - [else 0.0])) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-lax - (generate-lax-friedrichs-scalar-1d pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-hyperbolicity - (call-with-output-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-inviscid-burgers-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-cfl-stability - (call-with-output-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-cfl-stability pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-inviscid-burgers-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-lax-local-lipschitz - (call-with-output-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-inviscid-burgers-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D inviscid Burgers' equation. -(define code-inviscid-burgers-roe - (generate-roe-scalar-1d pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-roe-hyperbolicity - (call-with-output-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-hyperbolicity pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-inviscid-burgers-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D inviscid Burgers' equation. -(define proof-inviscid-burgers-roe-flux-conservation - (call-with-output-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-flux-conservation pde-inviscid-burgers - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_inviscid_burgers_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-inviscid-burgers-roe-flux-conservation) -(display "\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-inviscid-burgers-lax-minmod - (generate-lax-friedrichs-scalar-1d-second-order pde-inviscid-burgers limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D inviscid Burgers' equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-inviscid-burgers-roe-minmod - (generate-roe-scalar-1d-second-order pde-inviscid-burgers limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/inviscid_burgers_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-inviscid-burgers-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/test_isothermal_euler_mom_x.rkt b/provable-algorithms/test_isothermal_euler_mom_x.rkt deleted file mode 100644 index 86ba4a90..00000000 --- a/provable-algorithms/test_isothermal_euler_mom_x.rkt +++ /dev/null @@ -1,282 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "code_generator_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "code_generator_core.rkt")) -(provide (all-from-out "code_generator_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D isothermal Euler equations (density and x-momentum components). -(define pde-system-isothermal-euler-mom-x - (hash - 'name "isothermal-euler-mom-x" - 'cons-exprs (list - `rho - `mom_x) ; conserved variables: density, x-momentum - 'flux-exprs (list - `mom_x - `(+ (/ (* mom_x mom_x) rho) (* rho vt vt))) ; flux vector - 'max-speed-exprs (list - `(abs (- (/ mom_x rho) vt)) - `(abs (+ (/ mom_x rho) vt))) ; local wave-speeds - 'parameters (list - `(define vt 1.0)) ; thermal velocity: vt = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 0.0) -(define x1 1.0) -(define t-final 0.1) -(define cfl 0.95) -(define init-funcs (list - `(cond - [(< x 0.5) 3.0] - [else 1.0]) - `(cond - [(< x 0.5) 1.5] - [else 0.0]))) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-lax - (generate-lax-friedrichs-vector2-1d pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_mom_x_lax.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-lax))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-lax-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-x-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-x-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-lax-cfl-stability - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-isothermal-euler-mom-x-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-lax-local-lipschitz - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-isothermal-euler-mom-x-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define code-isothermal-euler-mom-x-roe - (generate-roe-vector2-1d pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_mom_x_roe.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-roe))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-roe-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-x-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-x-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D isothermal Euler equations (density and x-momentum components). -(define proof-isothermal-euler-mom-x-roe-flux-conservation - (call-with-output-file "proofs/proof_isothermal_euler_mom_x_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-isothermal-euler-mom-x - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_x_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-isothermal-euler-mom-x-roe-flux-conservation) -(display "\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (density and x-momentum components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-isothermal-euler-mom-x-lax-minmod - (generate-lax-friedrichs-vector2-1d-second-order pde-system-isothermal-euler-mom-x limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_mom_x_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D isothermal Euler equations (density and x-momentum components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-isothermal-euler-mom-x-roe-minmod - (generate-roe-vector2-1d-second-order pde-system-isothermal-euler-mom-x limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_mom_x_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-x-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/test_isothermal_euler_mom_yz.rkt b/provable-algorithms/test_isothermal_euler_mom_yz.rkt deleted file mode 100644 index 704bad70..00000000 --- a/provable-algorithms/test_isothermal_euler_mom_yz.rkt +++ /dev/null @@ -1,276 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "code_generator_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "code_generator_core.rkt")) -(provide (all-from-out "code_generator_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D isothermal Euler equations (y- and z-momentum components). -(define pde-system-isothermal-euler-mom-yz - (hash - 'name "isothermal-euler-mom-yz" - 'cons-exprs (list - `mom_y - `mom_z) ; conserved variables: y-momentum, z-momentum - 'flux-exprs (list - `(* mom_y u) - `(* mom_z u)) ; flux vector - 'max-speed-exprs (list - `(abs u) - `(abs u)) ; local wave-speeds - 'parameters (list - `(define u 0.0)) ; advection velocity: 0.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 0.0) -(define x1 1.0) -(define t-final 0.1) -(define cfl 0.95) -(define init-funcs (list 0.0 0.0)) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-lax - (generate-lax-friedrichs-vector2-1d pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_mom_yz_lax.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-lax))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-lax-mom-yz-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-lax-mom-yz-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-yz-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-lax-cfl-stability - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-isothermal-euler-mom-yz-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-lax-local-lipschitz - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-isothermal-euler-mom-yz-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define code-isothermal-euler-mom-yz-roe - (generate-roe-vector2-1d pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_mom_yz_roe.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-roe))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-roe-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-yz-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-isothermal-euler-mom-yz-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D isothermal Euler equations (y- and z-momentum components). -(define proof-isothermal-euler-mom-yz-roe-flux-conservation - (call-with-output-file "proofs/proof_isothermal_euler_mom_yz_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-isothermal-euler-mom-yz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_isothermal_euler_mom_yz_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-isothermal-euler-mom-yz-roe-flux-conservation) -(display "\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D isothermal Euler equations (y- and z-momentum components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-isothermal-euler-mom-yz-lax-minmod - (generate-lax-friedrichs-vector2-1d-second-order pde-system-isothermal-euler-mom-yz limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_mom_yz_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D isothermal Euler equations (y- and z-momentum components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-isothermal-euler-mom-yz-roe-minmod - (generate-roe-vector2-1d-second-order pde-system-isothermal-euler-mom-yz limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/isothermal_euler_mom_yz_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-isothermal-euler-mom-yz-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/test_limiters.rkt b/provable-algorithms/test_limiters.rkt deleted file mode 100644 index b125f8b8..00000000 --- a/provable-algorithms/test_limiters.rkt +++ /dev/null @@ -1,177 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "prover_core.rkt") -(provide (all-from-out "code_generator_core.rkt")) - -;; Construct /proofs output directory if it does not already exist. -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -(display "Minmod flux limiter properties: \n\n") - -;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the minmod flux limiter. -(define proof-limiter-minmod-symmetry - (call-with-output-file "proofs/proof_limiter_minmod_symmetry.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-symmetry limiter-minmod))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_minmod_symmetry.rkt") - -;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. -(display "Symmetric (equivalent action on forward and backward gradients): ") -(display proof-limiter-minmod-symmetry) -(display "\n") - -;; Attempt to prove second-order TVD (total variation diminishing) of the minmod flux limiter. -(define proof-limiter-minmod-tvd - (call-with-output-file "proofs/proof_limiter_minmod_tvd.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-tvd limiter-minmod))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_minmod_tvd.rkt") - -;; Show whether the second-order TVD (total variation diminishing) property is satisfied. -(display "Second-order TVD (total variation diminishing): ") -(display proof-limiter-minmod-tvd) -(display "\n\n\n") - -;; Define the superbee flux limiter. -(define limiter-superbee - (hash - 'name "superbee" - 'limiter-expr `(max 0.0 (min (* 2.0 r) 1.0) (min r 2.0)) - 'limiter-ratio `r - )) - -(display "Superbee flux limiter properties: \n\n") - -;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the superbee flux limiter. -(define proof-limiter-superbee-symmetry - (call-with-output-file "proofs/proof_limiter_superbee_symmetry.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-symmetry limiter-superbee))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_superbee_symmetry.rkt") - -;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. -(display "Symmetric (equivalent action on forward and backward gradients): ") -(display proof-limiter-superbee-symmetry) -(display "\n") - -;; Attempt to prove second-order TVD (total variation diminishing) of the superbee flux limiter. -(define proof-limiter-superbee-tvd - (call-with-output-file "proofs/proof_limiter_superbee_tvd.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-tvd limiter-superbee))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_superbee_tvd.rkt") - -;; Show whether the second-order TVD (total variation diminishing) property is satisfied. -(display "Second-order TVD (total variation diminishing): ") -(display proof-limiter-superbee-tvd) -(display "\n\n\n") - -;; Define the monotonized-centered flux limiter. -(define limiter-monotonized-centered - (hash - 'name "monotonized-centered" - 'limiter-expr `(max 0.0 (min (* 2.0 r) (/ (+ 1.0 r) 2.0) 2.0)) - 'limiter-ratio `r - )) - -(display "Monotonized-centered flux limiter properties: \n\n") - -;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the monotonized-centered flux limiter. -(define proof-limiter-monotonized-centered-symmetry - (call-with-output-file "proofs/proof_limiter_monotonized_centered_symmetry.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-symmetry limiter-monotonized-centered))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_monotonized_centered_symmetry.rkt") - -;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. -(display "Symmetric (equivalent action on forward and backward gradients): ") -(display proof-limiter-monotonized-centered-symmetry) -(display "\n") - -;; Attempt to prove second-order TVD (total variation diminishing) of the monotonized-centered flux limiter. -(define proof-limiter-monotonized-centered-tvd - (call-with-output-file "proofs/proof_limiter_monotonized_centered_tvd.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-tvd limiter-monotonized-centered))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_monotonized_centered_tvd.rkt") - -;; Show whether the second-order TVD (total variation diminishing) property is satisfied. -(display "Second-order TVD (total variation diminishing): ") -(display proof-limiter-monotonized-centered-tvd) -(display "\n\n\n") - -;; Define the van Leer flux limiter. -(define limiter-van-leer - (hash - 'name "van-leer" - 'limiter-expr `(/ (+ r (abs r)) (+ 1.0 (abs r))) - 'limiter-ratio `r - )) - -(display "Van Leer flux limiter properties: \n\n") - -;; Attempt to prove symmetry (equivalent action on forward and backward gradients) of the van Leer flux limiter. -(define proof-limiter-van-leer-symmetry - (call-with-output-file "proofs/proof_limiter_van_leer_symmetry.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-symmetry limiter-van-leer))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_van_leer_symmetry.rkt") - -;; Show whether the symmetry (equivalent action on forward and backward gradients) property is satisfied. -(display "Symmetric (equivalent action on forward and backward gradients): ") -(display proof-limiter-van-leer-symmetry) -(display "\n") - -;; Attempt to prove second-order TVD (total variation diminishing) of the van Leer flux limiter. -(define proof-limiter-van-leer-tvd - (call-with-output-file "proofs/proof_limiter_van_leer_tvd.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-flux-limiter-tvd limiter-van-leer))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_limiter_van_leer_tvd.rkt") - -;; Show whether the second-order TVD (total variation diminishing) property is satisfied. -(display "Second-order TVD (total variation diminishing): ") -(display proof-limiter-van-leer-tvd) -(display "\n\n\n") \ No newline at end of file diff --git a/provable-algorithms/test_linear_advection.rkt b/provable-algorithms/test_linear_advection.rkt deleted file mode 100644 index 56817a1b..00000000 --- a/provable-algorithms/test_linear_advection.rkt +++ /dev/null @@ -1,218 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "prover_core.rkt") -(provide (all-from-out "code_generator_core.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D linear advection equation: du/dt + d(au)/dx = 0. -(define pde-linear-advection - (hash - 'name "linear-advection" - 'cons-expr `u ; conserved variable: u - 'flux-expr `(* a u) ; flux function: f(u) = a * u - 'max-speed-expr `(abs a) ; local wave-speed: alpha = |a| - 'parameters (list - `(define a 1.0)) ; advection speed: a = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 0.0) -(define x1 2.0) -(define t-final 0.5) -(define cfl 0.95) -(define init-func `(cond - [(< x 1.0) 1.0] - [else 0.0])) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D linear advection equation. -(define code-linear-advection-lax - (generate-lax-friedrichs-scalar-1d pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D linear advection equation. -(define proof-linear-advection-lax-hyperbolicity - (call-with-output-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-hyperbolicity pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-linear-advection-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D linear advection equation. -(define proof-linear-advection-lax-cfl-stability - (call-with-output-file "proofs/proof_linear_advection_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-cfl-stability pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-linear-advection-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D linear advection equation. -(define proof-linear-advection-lax-local-lipschitz - (call-with-output-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-lax-friedrichs-scalar-1d-local-lipschitz pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-linear-advection-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D linear advection equation. -(define code-linear-advection-roe - (generate-roe-scalar-1d pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D linear advection equation. -(define proof-linear-advection-roe-hyperbolicity - (call-with-output-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-hyperbolicity pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-linear-advection-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D linear advection equation. -(define proof-linear-advection-roe-flux-conservation - (call-with-output-file "proofs/proof_linear_advection_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n\n") - (prove-roe-scalar-1d-flux-conservation pde-linear-advection - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_linear_advection_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-linear-advection-roe-flux-conservation) -(display "\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-linear-advection-lax-minmod - (generate-lax-friedrichs-scalar-1d-second-order pde-linear-advection limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-linear-advection-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D linear advection equation (with a second-order flux extrapolation using the minmod flux limiter). -(define code-linear-advection-roe-minmod - (generate-roe-scalar-1d-second-order pde-linear-advection limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-func init-func)) - -;; Output the code to a file. -(with-output-to-file "code/linear_advection_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-linear-advection-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/test_maxwell_1d_Bx_psi.rkt b/provable-algorithms/test_maxwell_1d_Bx_psi.rkt deleted file mode 100644 index 5c1f0fba..00000000 --- a/provable-algorithms/test_maxwell_1d_Bx_psi.rkt +++ /dev/null @@ -1,282 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "code_generator_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "code_generator_core.rkt")) -(provide (all-from-out "code_generator_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D Maxwell equations (Bx and psi components). -(define pde-system-maxwell-1d-Bx-psi - (hash - 'name "maxwell-1d-Bx-psi" - 'cons-exprs (list - `Bx - `psi) ; conserved variables: magnetic field (x-component), magnetic field correction potential (psi). - 'flux-exprs (list - `(* b_fact psi) - `(* b_fact (* (* c c) Bx))) ; flux vector - 'max-speed-exprs (list - `(abs (* b_fact c)) - `(abs (* b_fact c))) ; local wave-speeds - 'parameters (list - `(define c 1.0) ; speed of light: c = 1.0 - `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 - `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.5) -(define x1 1.5) -(define t-final 1.0) -(define cfl 0.95) -(define init-funcs (list - 0.0 - `(cond - [(< x 0.0) 0.5] - [else -0.5]))) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-lax - (generate-lax-friedrichs-vector2-1d pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Bx_psi_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-lax))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-lax-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Bx-psi-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Bx-psi-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-lax-cfl-stability - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-maxwell-1d-Bx-psi-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Bx and psi components) -(define proof-maxwell-1d-Bx-psi-lax-local-lipschitz - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-maxwell-1d-Bx-psi-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Bx and psi components). -(define code-maxwell-1d-Bx-psi-roe - (generate-roe-vector2-1d pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Bx_psi_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-roe))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-roe-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Bx-psi-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Bx-psi-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Bx and psi components). -(define proof-maxwell-1d-Bx-psi-roe-flux-conservation - (call-with-output-file "proofs/proof_maxwell_1d_Bx_psi_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Bx-psi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Bx_psi_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-maxwell-1d-Bx-psi-roe-flux-conservation) -(display "\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and psi components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-maxwell-1d-Bx-psi-lax-minmod - (generate-lax-friedrichs-vector2-1d-second-order pde-system-maxwell-1d-Bx-psi limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Bx_psi_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Bx and psi components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-maxwell-1d-Bx-psi-roe-minmod - (generate-roe-vector2-1d-second-order pde-system-maxwell-1d-Bx-psi limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Bx_psi_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Bx-psi-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/test_maxwell_1d_Ex_phi.rkt b/provable-algorithms/test_maxwell_1d_Ex_phi.rkt deleted file mode 100644 index 6293d7c6..00000000 --- a/provable-algorithms/test_maxwell_1d_Ex_phi.rkt +++ /dev/null @@ -1,282 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "code_generator_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "code_generator_core.rkt")) -(provide (all-from-out "code_generator_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D Maxwell equations (Ex and phi components). -(define pde-system-maxwell-1d-Ex-phi - (hash - 'name "maxwell-1d-Ex-phi" - 'cons-exprs (list - `Ex - `phi) ; conserved variables: electric field (x-component), electric field correction potential (phi). - 'flux-exprs (list - `(* e_fact (* (* c c) phi)) - `(* e_fact Ex)) ; flux vector - 'max-speed-exprs (list - `(abs (* c e_fact)) - `(abs (* c e_fact))) ; local wave-speeds - 'parameters (list - `(define c 1.0) ; speed of light: c = 1.0 - `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 - `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.5) -(define x1 1.5) -(define t-final 1.0) -(define cfl 0.95) -(define init-funcs (list - 0.0 - `(cond - [(< x 0.0) 0.5] - [else -0.5]))) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-lax - (generate-lax-friedrichs-vector2-1d pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ex_phi_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-lax))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-lax-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ex-phi-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ex-phi-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-lax-cfl-stability - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-maxwell-1d-Ex-phi-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components) -(define proof-maxwell-1d-Ex-phi-lax-local-lipschitz - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-maxwell-1d-Ex-phi-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ex and phi components). -(define code-maxwell-1d-Ex-phi-roe - (generate-roe-vector2-1d pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ex_phi_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-roe))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-roe-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ex-phi-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ex-phi-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ex and phi components). -(define proof-maxwell-1d-Ex-phi-roe-flux-conservation - (call-with-output-file "proofs/proof_maxwell_1d_Ex_phi_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ex-phi - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ex_phi_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-maxwell-1d-Ex-phi-roe-flux-conservation) -(display "\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ex and phi components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-maxwell-1d-Ex-phi-lax-minmod - (generate-lax-friedrichs-vector2-1d-second-order pde-system-maxwell-1d-Ex-phi limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ex_phi_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ex and phi components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-maxwell-1d-Ex-phi-roe-minmod - (generate-roe-vector2-1d-second-order pde-system-maxwell-1d-Ex-phi limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ex_phi_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ex-phi-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/test_maxwell_1d_Ey_Bz.rkt b/provable-algorithms/test_maxwell_1d_Ey_Bz.rkt deleted file mode 100644 index d8aa4816..00000000 --- a/provable-algorithms/test_maxwell_1d_Ey_Bz.rkt +++ /dev/null @@ -1,282 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "code_generator_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "code_generator_core.rkt")) -(provide (all-from-out "code_generator_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D Maxwell equations (Ey and Bz components). -(define pde-system-maxwell-1d-Ey-Bz - (hash - 'name "maxwell-1d-Ey-Bz" - 'cons-exprs (list - `Ey - `Bz) ; conserved variables: electric field (y-component), magnetic field (z-component) - 'flux-exprs (list - `(* (* c c) Bz) - `Ey) ; flux vector - 'max-speed-exprs (list - `(abs c) - `(abs c)) ; local wave-speeds - 'parameters (list - `(define c 1.0) ; speed of light: c = 1.0 - `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 - `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.5) -(define x1 1.5) -(define t-final 1.0) -(define cfl 0.95) -(define init-funcs (list - 0.0 - `(cond - [(< x 0.0) 0.5] - [else -0.5]))) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-lax - (generate-lax-friedrichs-vector2-1d pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ey_Bz_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-lax))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-lax-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ey-Bz-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ey-Bz-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-lax-cfl-stability - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-maxwell-1d-Ey-Bz-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components) -(define proof-maxwell-1d-Ey-Bz-lax-local-lipschitz - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-maxwell-1d-Ey-Bz-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define code-maxwell-1d-Ey-Bz-roe - (generate-roe-vector2-1d pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ey_Bz_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-roe))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-roe-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ey-Bz-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ey-Bz-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ey and Bz components). -(define proof-maxwell-1d-Ey-Bz-roe-flux-conservation - (call-with-output-file "proofs/proof_maxwell_1d_Ey_Bz_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ey-Bz - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ey_Bz_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-maxwell-1d-Ey-Bz-roe-flux-conservation) -(display "\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ey and Bz components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-maxwell-1d-Ey-Bz-lax-minmod - (generate-lax-friedrichs-vector2-1d-second-order pde-system-maxwell-1d-Ey-Bz limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ey_Bz_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ey and Bz components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-maxwell-1d-Ey-Bz-roe-minmod - (generate-roe-vector2-1d-second-order pde-system-maxwell-1d-Ey-Bz limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ey_Bz_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ey-Bz-roe-minmod))) \ No newline at end of file diff --git a/provable-algorithms/test_maxwell_1d_Ez_By.rkt b/provable-algorithms/test_maxwell_1d_Ez_By.rkt deleted file mode 100644 index 3dfd256b..00000000 --- a/provable-algorithms/test_maxwell_1d_Ez_By.rkt +++ /dev/null @@ -1,282 +0,0 @@ -#lang racket - -(require "code_generator_core.rkt") -(require "code_generator_vector.rkt") -(require "prover_core.rkt") -(require "prover_vector.rkt") -(provide (all-from-out "code_generator_core.rkt")) -(provide (all-from-out "code_generator_vector.rkt")) - -;; Construct /code and /proofs output directories if they do not already exist. -(cond - [(not (directory-exists? "code")) (make-directory "code")]) -(cond - [(not (directory-exists? "proofs")) (make-directory "proofs")]) - -;; Define the 1D Maxwell equations (Ez and By components). -(define pde-system-maxwell-1d-Ez-By - (hash - 'name "maxwell-1d-Ez-By" - 'cons-exprs (list - `Ez - `By) ; conserved variables: electric field (z-component), magnetic field (y-component) - 'flux-exprs (list - `(* -1.0 (* (* c c) By)) - `(* -1.0 Ez)) ; flux vector - 'max-speed-exprs (list - `(abs c) - `(abs c)) ; local wave-speeds - 'parameters (list - `(define c 1.0) ; speed of light: c = 1.0 - `(define e_fact 1.0) ; electric field divergence error propagation: e_fact = 1.0 - `(define b_fact 1.0)) ; magnetic field divergence error propagation: b_fact = 1.0 - )) - -;; Define simulation parameters. -(define nx 200) -(define x0 -1.5) -(define x1 1.5) -(define t-final 1.0) -(define cfl 0.95) -(define init-funcs (list - 0.0 - `(cond - [(< x 0.0) 0.5] - [else -0.5]))) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-lax - (generate-lax-friedrichs-vector2-1d pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ez_By_lax.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-lax))) - -(display "Lax-Friedrichs (finite-difference) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-lax-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ez-By-lax-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-lax-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ez-By-lax-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove CFL stability of the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-lax-cfl-stability - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_cfl_stability.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-cfl-stability pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_cfl_stability.rkt") - -;; Show whether CFL stability is satisfied. -(display "CFL stability: ") -(display proof-maxwell-1d-Ez-By-lax-cfl-stability) -(display "\n") - -;; Attempt to prove local Lipschitz continuity of the discrete flux function for the Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components) -(define proof-maxwell-1d-Ez-By-lax-local-lipschitz - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_lax_local_lipschitz.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-lax-friedrichs-vector2-1d-local-lipschitz pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_lax_local_lipschitz.rkt") - -;; Show whether the local Lipschitz continuity property of the discrete flux function is satisfied. -(display "Local Lipschitz continuity of discrete flux function: ") -(display proof-maxwell-1d-Ez-By-lax-local-lipschitz) -(display "\n\n\n") - -;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ez and By components). -(define code-maxwell-1d-Ez-By-roe - (generate-roe-vector2-1d pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ez_By_roe.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-roe))) - -(display "Roe (finite-volume) properties: \n\n") - -;; Attempt to prove hyperbolicity of the Roe solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-roe-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-hyperbolicity pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_hyperbolicity.rkt") - -;; Show whether hyperbolicity is preserved. -(display "Hyperbolicity preservation: ") -(display proof-maxwell-1d-Ez-By-roe-hyperbolicity) -(display "\n") - -;; Attempt to prove strict hyperbolicity of the Roe solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-roe-strict-hyperbolicity - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_strict_hyperbolicity.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-strict-hyperbolicity pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_strict_hyperbolicity.rkt") - -;; Show whether strict hyperbolicity is preserved. -(display "Strict hyperbolicity preservation: ") -(display proof-maxwell-1d-Ez-By-roe-strict-hyperbolicity) -(display "\n") - -;; Attempt to prove flux conservation (jump continuity) of the Roe solver for the 1D Maxwell equations (Ez and By components). -(define proof-maxwell-1d-Ez-By-roe-flux-conservation - (call-with-output-file "proofs/proof_maxwell_1d_Ez_By_roe_flux_conservation.rkt" - (lambda (out) - (parameterize ([current-output-port out] [pretty-print-columns `infinity]) - (display "#lang racket\n\n") - (display "(require \"../prover_core.rkt\")\n") - (display "(require \"../prover_vector.rkt\")\n\n") - (prove-roe-vector2-1d-flux-conservation pde-system-maxwell-1d-Ez-By - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs))) - #:exists `replace)) -(remove-bracketed-expressions-from-file "proofs/proof_maxwell_1d_Ez_By_roe_flux_conservation.rkt") - -;; Show whether flux conservation (jump continuity) is preserved. -(display "Flux conservation (jump continuity): ") -(display proof-maxwell-1d-Ez-By-roe-flux-conservation) -(display "\n") - -;; Define the minmod flux limiter. -(define limiter-minmod - (hash - 'name "minmod" - 'limiter-expr `(max 0.0 (min 1.0 r)) - 'limiter-ratio `r - )) - -;; Synthesize the code for a Lax-Friedrichs solver for the 1D Maxwell equations (Ez and By components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-maxwell-1d-Ez-By-lax-minmod - (generate-lax-friedrichs-vector2-1d-second-order pde-system-maxwell-1d-Ez-By limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ez_By_lax_minmod.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-lax-minmod))) - -;; Synthesize the code for a Roe solver for the 1D Maxwell equations (Ez and By components, with a second-order flux extrapolation using the minmod flux limiter). -(define code-maxwell-1d-Ez-By-roe-minmod - (generate-roe-vector2-1d-second-order pde-system-maxwell-1d-Ez-By limiter-minmod - #:nx nx - #:x0 x0 - #:x1 x1 - #:t-final t-final - #:cfl cfl - #:init-funcs init-funcs)) - -;; Output the code to a file. -(with-output-to-file "code/maxwell_1d_Ez_By_roe_minmod.c" - #:exists 'replace - (lambda () - (display code-maxwell-1d-Ez-By-roe-minmod))) \ No newline at end of file From 517bb0da7f7b4b149dd0c810d79190951f1e23c9 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 27 Apr 2026 15:21:32 -0400 Subject: [PATCH 61/66] checkout origin/main of some files that got lost --- .../gkCrossPrimMomsBGKFuncs.mac | 111 ++++++++++++++++++ .../ms-gkCrossPrimMomsBGK-header.mac | 67 +++++++++++ .../cross_prim_moms/ms-gkCrossPrimMomsBGK.mac | 49 ++++++++ 3 files changed, 227 insertions(+) create mode 100644 maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac create mode 100644 maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac create mode 100644 maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac diff --git a/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac b/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac new file mode 100644 index 00000000..318dbbf9 --- /dev/null +++ b/maxima/g0/cross_prim_moms/gkCrossPrimMomsBGKFuncs.mac @@ -0,0 +1,111 @@ +/* Generate kernels for the updater that computes the cross primitive moments + upar_ei and vtsq_ei (or upar_ie and vtsq_ie) used in the cross collision + terms, given the moments of electrons and ions. + Weak division and multiplication are employed. */ + +load("modal-basis"); +load("out-scripts"); +load("nodal_operations/nodal_functions"); +load(stringproc)$ +fpprec : 24$ + +calcGKCrossPrimMomsBGK(fh, funcNm, cdim, vdim, basisFun, polyOrder) := block( + [varsC, bC, NC], + + /* Load basis of dimensionality requested. */ + [varsC,bC] : loadBasis(basisFun, cdim, polyOrder), + + /* Number of basis monomials. */ + NC : length(bC), + + print("gk ", cdim,"x", vdim, "v", polyOrder, "p"), + + /* Include the header files. */ + printf(fh, "#include ~%"), + printf(fh, "#include ~%"), + printf(fh, "#include ~%", basisFun, cdim, polyOrder), + printf(fh, " ~%"), + + /* Function declaration with input/output variables. */ + printf(fh, "GKYL_CU_DH void ~a(const double delta_sr, const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, double *prim_moms_cross) ~%{ ~%", funcNm), + printf(fh, " // delta_sr: Free parameter in relation between nu_sr and alpha_E. ~%"), + printf(fh, " // betaGreenep1: Greene's beta + 1. ~%"), + printf(fh, " // m_self: mass of this species. ~%"), + printf(fh, " // prim_moms_self: primitive moments of this species. ~%"), + printf(fh, " // m_other: mass of other species. ~%"), + printf(fh, " // prim_moms_other: primitive moments of other species. ~%"), + printf(fh, " // prim_moms_cross: cross primitive moments. ~%"), + printf(fh, " ~%"), + + printf(fh, " const double m_s = m_self; ~%"), + printf(fh, " const double m_r = m_other; ~%"), + /* Create pointers to the moments of each species. */ + printf(fh, " const double *n_s = &prim_moms_self[~a]; ~%", 0), + printf(fh, " const double *upar_s = &prim_moms_self[~a]; ~%", NC), + printf(fh, " const double *vtsq_s = &prim_moms_self[~a]; ~%", NC*2), + printf(fh, " const double *n_r = &prim_moms_other[~a]; ~%", 0), + printf(fh, " const double *upar_r = &prim_moms_other[~a]; ~%", NC), + printf(fh, " const double *vtsq_r = &prim_moms_other[~a]; ~%", NC*2), + printf(fh, " ~%"), + /* Create pointers to the cross moments. */ + printf(fh, " double *n_sr = &prim_moms_cross[~a]; ~%", 0), + printf(fh, " double *upar_sr = &prim_moms_cross[~a]; ~%", NC*1), + printf(fh, " double *vtsq_sr = &prim_moms_cross[~a]; ~%", NC*2), + printf(fh, "~%"), + + /* Calculate cross density n_sr. */ + for i : 1 thru NC do ( + printf(fh, " n_sr[~a] = n_s[~a]; ~%", i-1, i-1) + ), + printf(fh, " ~%"), + + /* Calculate cross parallel velocity upar_sr. */ + printf(fh, " const double deltaTbetap1 = delta_sr*betaGreenep1;~%"), + printf(fh, " ~%"), + + printf(fh, " double dUpar[~a]; ~%", NC), + for i : 1 thru NC do ( + printf(fh, " dUpar[~a] = upar_r[~a] - upar_s[~a]; ~%", i-1, i-1, i-1) + ), + for i : 1 thru NC do ( + printf(fh, " upar_sr[~a] = upar_s[~a] + 0.5*deltaTbetap1*dUpar[~a]; ~%", i-1, i-1, i-1) + ), + printf(fh, " ~%"), + + /* Calculate cross thermal velocity square vtsq_sr. */ + printf(fh, " const double vdimPhys = ~a; ~%", (vdim-1)*2+1), + printf(fh, " const double mSum = m_self + m_other;~%"), + printf(fh, " ~%"), + + printf(fh, " double dTemp[~a] = {0.0}; ~%", NC), + for i : 1 thru NC do ( + printf(fh, " dTemp[~a] = vdimPhys * (m_r*vtsq_r[~a]-m_s*vtsq_s[~a]); ~%", i-1, i-1, i-1) + ), + + printf(fh, " double dUparSq[~a] = {0.0}; ~%", NC), + printf(fh, " binop_mul_~ad_~a_p~a(dUpar, dUpar, dUparSq); ~%", cdim, basisFun, polyOrder), + + printf(fh, " const double dUparSq_fac = (m_r-0.25*deltaTbetap1*mSum/vdimPhys);~%"), + for i : 1 thru NC do ( + printf(fh, " vtsq_sr[~a] = vtsq_s[~a] + deltaTbetap1/(vdimPhys*mSum)*(dTemp[~a]+dUparSq_fac*dUparSq[~a]); ~%", i-1, i-1, i-1, i-1) + ), + printf(fh, " ~%"), + + /* Turn collisions off when vtsq_sr is not positive-definite. */ + printf(fh, " // If vtsq_sr is negative at a corner, turn off collisions.~%"), + printf(fh, " bool negative_cross_temp = false; ~%"), + nodes : getNodes(basisFun, cdim, 1), + vtsq_sr_e : doExpand1(vtsq_sr,bC), + vtsq_sr_corners : gcfac(float(fullratsimp( evAtNodes(vtsq_sr_e,nodes,varsC) ))), + for i : 1 thru length(nodes) do ( + printf(fh, " if (~a < 0.0) negative_cross_temp = true; ~%", vtsq_sr_corners[i]) + ), + printf(fh, " if (negative_cross_temp) { ~%"), + for j : 1 thru NC do ( + printf(fh, " upar_sr[~a] = upar_s[~a]; ~%", j-1, j-1), + printf(fh, " vtsq_sr[~a] = vtsq_s[~a]; ~%", j-1, j-1) + ), + printf(fh, " } ~%"), + + printf(fh, "} ~%") +)$ diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac new file mode 100644 index 00000000..752a42c8 --- /dev/null +++ b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK-header.mac @@ -0,0 +1,67 @@ +load("cross_prim_moms/gkCrossPrimMomsBGKFuncs")$ +load(stringproc)$ + +/* Generate a header file for cross primitive moments kernels in the GkBGK. */ + +/* ...... USER INPUTS........ */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 1$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor order basis. No need to generate p=1. */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 1$ +maxCdim_Tensor : 0$ + +/* Vdim possibilities for each of Cdim=[1,2,3]. */ +gkVdims : [[1,2], [2], [2]]$ + +/* ...... END OF USER INPUTS........ */ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +printPrototypeGK(deco, ci, vi, bStr, pi) := block([si], + printf(fh, "~avoid gyrokinetic_cross_prim_moms_bgk_~ax~av_~a_p~a(const double delta_sr, const double betaGreenep1, const double m_self, const double *prim_moms_self, const double m_other, const double *prim_moms_other, double *prim_moms_cross); ~%", deco, ci, vi, bStr, pi), + printf(fh, "~%") +)$ + +fh : openw("~/max-out/gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h")$ +printf(fh, "#pragma once ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, "#include ~%")$ +printf(fh, " ~%")$ +printf(fh, "EXTERN_C_BEG ~%")$ +printf(fh, "~%")$ + +decorator : "GKYL_CU_DH "$ + +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ + for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + + printPrototypeGK(decorator, c, v, bName[bInd], polyOrder) + + ) + ) + ) +); + +printf(fh, "EXTERN_C_END ~%")$ +close(fh)$ + +/* gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h */ diff --git a/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac new file mode 100644 index 00000000..834a14f2 --- /dev/null +++ b/maxima/g0/cross_prim_moms/ms-gkCrossPrimMomsBGK.mac @@ -0,0 +1,49 @@ +load("cross_prim_moms/gkCrossPrimMomsBGKFuncs")$ +load(stringproc)$ + +/* Generate a header file for cross moment kernels in the GkBGK. */ + +/* Serendipity basis. */ +minPolyOrder_Ser : 1$ +maxPolyOrder_Ser : 1$ +minCdim_Ser : 1$ +maxCdim_Ser : 3$ + +/* Tensor order basis. No need to generate p=1. */ +minPolyOrder_Tensor : 2$ +maxPolyOrder_Tensor : 0$ +minCdim_Tensor : 1$ +maxCdim_Tensor : 0$ + +/* Vdim possibilities for each of Cdim=[1,2,3]. */ +gkVdims : [[1,2], [2], [2]]$ + +/* ...... END OF USER INPUTS........ */ + +/* To generate other bases, just add corresponding column to arrays below. */ +bName : ["ser", "tensor"]$ +minPolyOrder : [minPolyOrder_Ser, minPolyOrder_Tensor]$ +maxPolyOrder : [maxPolyOrder_Ser, maxPolyOrder_Tensor]$ +minCdim : [minCdim_Ser, minCdim_Tensor]$ +maxCdim : [maxCdim_Ser, maxCdim_Tensor]$ + +for bInd : 1 thru length(bName) do ( + for c : minCdim[bInd] thru maxCdim[bInd] do ( + for gkV : 1 thru length(gkVdims[c]) do ( + v : gkVdims[c][gkV], + + maxPolyOrderB : maxPolyOrder[bInd], + if (c=3) then maxPolyOrderB : 1, /* Only generate p=1 kernels for 3x2v */ + for polyOrder : minPolyOrder[bInd] thru maxPolyOrderB do ( + + fname : sconcat("~/max-out/gyrokinetic_cross_prim_moms_bgk_", c, "x", v, "v_", bName[bInd], "_p", polyOrder, ".c"), + fh : openw(fname), + funcName : sconcat("gyrokinetic_cross_prim_moms_bgk_", c, "x", v, "v_", bName[bInd], "_p", polyOrder), + calcGKCrossPrimMomsBGK(fh, funcName, c, v, bName[bInd], polyOrder), + close(fh) + ) + ) + ) +); + +/* gkyl_gyrokinetic_cross_prim_moms_bgk_kernels.h */ From 3518c6b170889ec4234f3fe9bb1734fcf996e87f Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 27 Apr 2026 15:21:58 -0400 Subject: [PATCH 62/66] remove auxiliary script --- maxima/g0/gk_collisionless/verify_no_leak.mac | 21 ------------------- 1 file changed, 21 deletions(-) delete mode 100644 maxima/g0/gk_collisionless/verify_no_leak.mac diff --git a/maxima/g0/gk_collisionless/verify_no_leak.mac b/maxima/g0/gk_collisionless/verify_no_leak.mac deleted file mode 100644 index 90621efd..00000000 --- a/maxima/g0/gk_collisionless/verify_no_leak.mac +++ /dev/null @@ -1,21 +0,0 @@ -kill(all)$ -/* load("dg_gk-vol.mac")$ */ -/* load("nodal_operations/node_locations")$ */ -/* load(stringproc)$ */ -/* fpprec : 24$ */ -/* load("eigen")$ */ - -/* values()$ */ -/* print(values)$ */ - -load("modal-basis")$ - -vars : [z,v,m]$ -n : 1$ -basis : makeSerendipBasis(vars, n)$ - -print("Serendipity basis:")$ -for i : 1 thru length(basis) do ( - printf(true, " basis[~a] = ~a~%", i, basis[i]) -)$ - From 68c2693cc07e11a9c6f50f4ee5dc4bdb968ff6a6 Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Mon, 27 Apr 2026 17:56:24 -0400 Subject: [PATCH 63/66] fix the 2D limit of the grad A cross product --- maxima/g0/gk_collisionless/dg_gk-vol.mac | 15 ++++++---- .../gk_collisionless_flux-surf-vpar.mac | 28 ++++++++----------- 2 files changed, 20 insertions(+), 23 deletions(-) diff --git a/maxima/g0/gk_collisionless/dg_gk-vol.mac b/maxima/g0/gk_collisionless/dg_gk-vol.mac index d74abea1..71e05911 100644 --- a/maxima/g0/gk_collisionless/dg_gk-vol.mac +++ b/maxima/g0/gk_collisionless/dg_gk-vol.mac @@ -444,25 +444,28 @@ addAparGKEMVolKernel(fh, funcNm, cdim, vdim, basisFun, polyOrder, varsInB, no_by gradA_vec : [dA_dx, dA_dy, dA_dz] ) else if cdim = 2 then ( dA_dx : diff(Apar_e*rdx2vec[xidx],varsP[xidx]), + dA_dy : 0, dA_dz : diff(Apar_e*rdx2vec[zidx],varsP[zidx]), gradA_vec : [dA_dx, dA_dz] ) else if cdim = 1 then ( + dA_dx : 0, + dA_dy : 0, dA_dz : diff(Apar_e*rdx2vec[zidx],varsP[zidx]), gradA_vec : [dA_dz] ), /* Use bioverJB to calculate ∇Apar x b / B in a vector */ if cdim = 3 then ( - gradAxbhatoverB_x : gradA_vec[2]*bioverJB_vec[3] - gradA_vec[3]*bioverJB_vec[2], - gradAxbhatoverB_y : gradA_vec[3]*bioverJB_vec[1] - gradA_vec[1]*bioverJB_vec[3], - gradAxbhatoverB_z : gradA_vec[1]*bioverJB_vec[2] - gradA_vec[2]*bioverJB_vec[1], + gradAxbhatoverB_x : dA_dy*bioverJB_3_e - dA_dz*bioverJB_2_e, + gradAxbhatoverB_y : dA_dz*bioverJB_1_e - dA_dx*bioverJB_3_e, + gradAxbhatoverB_z : dA_dx*bioverJB_2_e - dA_dy*bioverJB_1_e, gradAxboverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_y, gradAxbhatoverB_z] ) else if cdim = 2 then ( - gradAxbhatoverB_x : 0 - gradA_vec[2]*bioverJB_vec[2], - gradAxbhatoverB_z : gradA_vec[1]*bioverJB_vec[2] - 0, + gradAxbhatoverB_x : dA_dy*bioverJB_3_e - dA_dz*bioverJB_2_e, + gradAxbhatoverB_z : dA_dx*bioverJB_2_e - dA_dy*bioverJB_1_e, gradAxboverB_vec : [gradAxbhatoverB_x, gradAxbhatoverB_z] ) else if cdim = 1 then ( - gradAxbhatoverB_z : 0, + gradAxbhatoverB_z : dA_dx*bioverJB_2_e - dA_dy*bioverJB_1_e, gradAxboverB_vec : [gradAxbhatoverB_z] ), diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 558605cf..ddec7cb4 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -178,35 +178,28 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b dH_dz : dH_dz_nodes[3], dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), dA_dy : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)), - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[3],varsP[3]),surfNodes,surfIntVars)), - gradHxgradA : [ - dH_dy*dA_dz - dH_dz*dA_dy, - dH_dz*dA_dx - dH_dx*dA_dz, - dH_dx*dA_dy - dH_dy*dA_dx - ] + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[3],varsP[3]),surfNodes,surfIntVars)) ) else if cdim = 2 then ( dH_dx : dH_dz_nodes[1], dH_dy : 0, dH_dz : dH_dz_nodes[2], dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), dA_dy : 0, - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)), - gradHxgradA : [ - dH_dy*dA_dz - dH_dz*dA_dy, - dH_dx*dA_dy - dH_dy*dA_dx - ] + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)) ) else if cdim = 1 then ( dH_dx : 0, dH_dy : 0, dH_dz : dH_dz_nodes[1], dA_dx : 0, dA_dy : 0, - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), - gradHxgradA : [ - dH_dx*dA_dy - dH_dy*dA_dx - ] + dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)) ), - + gradHxgradA : [ + dH_dy*dA_dz - dH_dz*dA_dy, + dH_dz*dA_dx - dH_dx*dA_dz, + dH_dx*dA_dy - dH_dy*dA_dx + ], + /* Now calculate alpha at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ printf(fh, " double *flux_surf_nodal = &flux_surf[~a]; ~%", NSurfIndexing*(surfDir-1)), @@ -266,7 +259,8 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 0), printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[j1index], 2), /* EM - ∇H x ∇A . b dψ/dvpar */ - printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 0, gradHxgradA[1][j1index]), + /* printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 0, gradHxgradA[1][j1index]), */ + /* printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 2, gradHxgradA[2][j1index]) */ printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 2, gradHxgradA[2][j1index]) ), if cdim = 1 then ( From 82a47efe75be38e2e62da698f6cb407cab2e547d Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 28 Apr 2026 14:03:06 -0400 Subject: [PATCH 64/66] rename return zero kernel functions for consistency Co-authored-by: Copilot --- maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac index 753e81b5..5b208422 100644 --- a/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac +++ b/maxima/g0/gk_collisionless/ms-gk_collisionless_flux.mac @@ -116,11 +116,11 @@ for bInd : 1 thru length(bName) do ( )$ /* Generate the return zero kernel */ -fname : sconcat(outputDir,"gk_collisionless_flux_surfconf_return_zero.c")$ +fname : sconcat(outputDir,"gk_collisionless_flux_surfconf_none.c")$ disp(printf(false,"Creating return zero kernel file: ~a",fname))$ fh : openw(fname)$ printf(fh, "#include ~%")$ -printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surfconf_return_zero(~%")$ +printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surfconf_none(~%")$ printf(fh, " const double *w, const double *dxv,~%")$ printf(fh, " const double *vmap, const double *vmapSq, const double q_, const double m_,~%")$ printf(fh, " const struct gkyl_dg_surf_geom *dgs, const struct gkyl_gk_dg_surf_geom *gkdgs, ~%")$ @@ -132,11 +132,11 @@ printf(fh, " return 0.0; ~%")$ printf(fh, "}~%")$ close(fh)$ -fname : sconcat(outputDir,"gk_collisionless_flux_surfvpar_return_zero.c")$ +fname : sconcat(outputDir,"gk_collisionless_flux_surfvpar_none.c")$ disp(printf(false,"Creating return zero kernel file: ~a",fname))$ fh : openw(fname)$ printf(fh, "#include ~%")$ -printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surfvpar_return_zero(~%")$ +printf(fh, "GKYL_CU_DH double gk_collisionless_flux_surfvpar_none(~%")$ printf(fh, " const double *w, const double *dxv,~%")$ printf(fh, " const double *vmap_prime_l, const double *vmap_prime_r,~%")$ printf(fh, " const double *vmap, const double *vmapSq, const double q_, const double m_, ~%")$ From c8b1ebedc710e4f945bca6f5ab4ab8c8657d38ec Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 28 Apr 2026 14:40:58 -0400 Subject: [PATCH 65/66] combine the expansions before evalAtNodes for gradA x gradH and A . gradH terms. I don't see much of a difference Co-authored-by: Copilot --- .../gk_collisionless_flux-surf-vpar.mac | 71 ++++++++++--------- 1 file changed, 36 insertions(+), 35 deletions(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index ddec7cb4..68e8d487 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -12,8 +12,8 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_nodes,dA_dx_nodes,k, - apardot_e,apardot_nodes,mvpar_j1,dH_dx,dH_dy,dH_dz,dH_dvpar,dA_dx,dA_dy,dA_dz, - gradHxgradA, apar_bP_e + apardot_e,apardot_nodes,mvpar_j1,dH_dx_e,dH_dy_e,dH_dz_e,dA_dx_e,dA_dy_e,dA_dz_e, + gradHxgradA_nodes, apargradH_nodes ], kill(varsC,varsP,bC,bP), @@ -142,9 +142,6 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b dA_dx_nodes[i] : float(evAtNodes(diff(apar_e*rdx2vec[i],varsC[i]),surfNodes,surfIntVars)) ), - /* Create a Apar expansion on phase space basis */ - apar_bP_e : doExpand1(apar, bP), - /*fl and fr */ JfL_e : doExpand1(JfL, bP), JfR_e : doExpand1(JfR, bP), @@ -173,32 +170,37 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b ), if cdim = 3 then ( - dH_dx : dH_dz_nodes[1], - dH_dy : dH_dz_nodes[2], - dH_dz : dH_dz_nodes[3], - dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), - dA_dy : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)), - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[3],varsP[3]),surfNodes,surfIntVars)) + dH_dx_e : diff(hamil_e*rdx2vec[1],varsP[1]), + dH_dy_e : diff(hamil_e*rdx2vec[2],varsP[2]), + dH_dz_e : diff(hamil_e*rdx2vec[3],varsP[3]), + dA_dx_e : diff(apar_e*rdx2vec[1],varsP[1]), + dA_dy_e : diff(apar_e*rdx2vec[2],varsP[2]), + dA_dz_e : diff(apar_e*rdx2vec[3],varsP[3]) ) else if cdim = 2 then ( - dH_dx : dH_dz_nodes[1], - dH_dy : 0, - dH_dz : dH_dz_nodes[2], - dA_dx : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)), - dA_dy : 0, - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[2],varsP[2]),surfNodes,surfIntVars)) + dH_dx_e : diff(hamil_e*rdx2vec[1],varsP[1]), + dH_dy_e : 0, + dH_dz_e : diff(hamil_e*rdx2vec[2],varsP[2]), + dA_dx_e : diff(apar_e*rdx2vec[1],varsP[1]), + dA_dy_e : 0, + dA_dz_e : diff(apar_e*rdx2vec[2],varsP[2]) ) else if cdim = 1 then ( - dH_dx : 0, - dH_dy : 0, - dH_dz : dH_dz_nodes[1], - dA_dx : 0, - dA_dy : 0, - dA_dz : float(evAtNodes(diff(apar_e*rdx2vec[1],varsP[1]),surfNodes,surfIntVars)) + dH_dx_e : 0, + dH_dy_e : 0, + dH_dz_e : diff(hamil_e*rdx2vec[1],varsP[1]), + dA_dx_e : 0, + dA_dy_e : 0, + dA_dz_e : diff(apar_e*rdx2vec[1],varsP[1]) ), - gradHxgradA : [ - dH_dy*dA_dz - dH_dz*dA_dy, - dH_dz*dA_dx - dH_dx*dA_dz, - dH_dx*dA_dy - dH_dy*dA_dx + gradHxgradA_nodes : [ + float(evAtNodes(dH_dy_e*dA_dz_e - dH_dz_e*dA_dy_e,surfNodes,surfIntVars)), + float(evAtNodes(dH_dz_e*dA_dx_e - dH_dx_e*dA_dz_e,surfNodes,surfIntVars)), + float(evAtNodes(dH_dx_e*dA_dy_e - dH_dy_e*dA_dx_e,surfNodes,surfIntVars)) ], + + apargradH_nodes : makelist(0, i, 1, cdim), + for i : 1 thru cdim do ( + apargradH_nodes[i] : float(evAtNodes(apar_e*diff(hamil_e*rdx2vec[i],varsP[i]),surfNodes,surfIntVars)) + ), /* Now calculate alpha at all quadrature nodes */ /*printf(fh, " double flux_surf_nodal[~a]= {0.0}; ~%", numSurfNodes),*/ @@ -246,9 +248,9 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b /* EM term using ∇ x (A b) . ∇H = A . ∇ x b . ∇H + ∇A x b . ∇H = A . ∇ x b . ∇H + ∇H x ∇A . b */ for k : 1 thru cdim do ( /* - A ∇ x b . ∇H dψ/dvpar = - A (∇ x b)_i dH/dxi dψ/dvpar */ - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[k][j1index], apar_nodes[j1index], k-1), + printf(fh, " alpha_quad += -1.0/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", apargradH_nodes[k][j1index], k-1), /* - ∇H x ∇A . b dψ/dvpar = - b_i/B 1/J eps_ijk dH/dx_j dA/dx_k */ - printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", k-1, gradHxgradA[k][j1index]) + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", k-1, gradHxgradA_nodes[k][j1index]) ) ), if cdim = 2 then ( @@ -256,18 +258,17 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 0, mvpar_j1), printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[2][j1index], 2, mvpar_j1), /* EM - A * ∇ x b . ∇H dψ/dvpar*/ - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 0), - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[2][j1index], apar_nodes[j1index], 2), + printf(fh, " alpha_quad += -1.0/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", apargradH_nodes[1][j1index], 0), + printf(fh, " alpha_quad += -1.0/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", apargradH_nodes[2][j1index], 2), /* EM - ∇H x ∇A . b dψ/dvpar */ - /* printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 0, gradHxgradA[1][j1index]), */ - /* printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 2, gradHxgradA[2][j1index]) */ - printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 2, gradHxgradA[2][j1index]) + /* Only b_2 term is non zero in 2x2v */ + printf(fh, " alpha_quad += -bioverJB_quad[~a]/m_ *(~a); ~%", 2, gradHxgradA_nodes[2][j1index]) ), if cdim = 1 then ( /* Finish ES term */ printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * 1/q_*dualcurlbhat_quad[~a]*(~a); ~%", dH_dz_nodes[1][j1index], 2, mvpar_j1), /* EM - A * ∇ x b . ∇H dψ/dvpar*/ - printf(fh, " alpha_quad += -(~a)/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", dH_dz_nodes[1][j1index], apar_nodes[j1index], 2) + printf(fh, " alpha_quad += -1.0/m_/bmag_quad * (~a)*dualcurlbhat_quad[~a]; ~%", apargradH_nodes[1][j1index], 2) /* EM - ∇H x ∇A . b dψ/dvpar */ /* none */ ) From 3c8ff0d5b9c1bf35257c1d07547f9a962e625f1f Mon Sep 17 00:00:00 2001 From: Antoinehoff Date: Tue, 28 Apr 2026 14:43:01 -0400 Subject: [PATCH 66/66] add local variables Co-authored-by: Copilot --- maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac index 68e8d487..409eab38 100644 --- a/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac +++ b/maxima/g0/gk_collisionless/gk_collisionless_flux-surf-vpar.mac @@ -11,7 +11,7 @@ buildGKFluxVparKernel(surfDir, fh, funcNm, cdim, vdim, basisFun, polyOrder, no_b numVelNodes,tempVars,tempBasis,NSurfIndexing,numNodesIndexing,d,rdx2vec,rdv2vec,rdSurfVar2, bmagBasis,phi_e,bmag_e,vmap_e,vmapSq_e,vmap_prime_e,evPoint,hamil_e,hamil_c,replaceList, hamilCvar,hamilNoZero_c,JfL_e,JfR_e,JfL_c,JfR_c,JfL_nodes,JfR_nodes,vmap_prime_nodes,vpardim, - dH_dz_nodes,i,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_nodes,dA_dx_nodes,k, + dH_dz_nodes,i,i0index,i1index,j,j0index,j1index,pOrderCFL,vprimeStr,apar_e,apar_nodes,dA_dx_nodes,k, apardot_e,apardot_nodes,mvpar_j1,dH_dx_e,dH_dy_e,dH_dz_e,dA_dx_e,dA_dy_e,dA_dz_e, gradHxgradA_nodes, apargradH_nodes ],