From 11d31e5f787d9357f1c153e8cbd55462bffd7e41 Mon Sep 17 00:00:00 2001 From: Weiqun Zhang Date: Thu, 25 Jul 2024 17:37:21 -0700 Subject: [PATCH] AmrData: remove dependency on Fortran (#4049) This allows us to compile Amrvis without a Fortran compiler. Also removed AmrData::Interp which is never being used anywhere. --- Src/Extern/amrdata/AMReX_AmrData.H | 4 - Src/Extern/amrdata/AMReX_AmrData.cpp | 189 +------ Src/Extern/amrdata/AMReX_FABUTIL_1D.F | 297 ---------- Src/Extern/amrdata/AMReX_FABUTIL_2D.F | 297 ---------- Src/Extern/amrdata/AMReX_FABUTIL_3D.F | 758 -------------------------- Src/Extern/amrdata/CMakeLists.txt | 1 - Src/Extern/amrdata/Make.package | 1 - Tools/CMake/AMReXOptions.cmake | 3 +- 8 files changed, 29 insertions(+), 1521 deletions(-) delete mode 100644 Src/Extern/amrdata/AMReX_FABUTIL_1D.F delete mode 100644 Src/Extern/amrdata/AMReX_FABUTIL_2D.F delete mode 100644 Src/Extern/amrdata/AMReX_FABUTIL_3D.F diff --git a/Src/Extern/amrdata/AMReX_AmrData.H b/Src/Extern/amrdata/AMReX_AmrData.H index e62ce6b1549..dcb9253fdc5 100644 --- a/Src/Extern/amrdata/AMReX_AmrData.H +++ b/Src/Extern/amrdata/AMReX_AmrData.H @@ -16,8 +16,6 @@ namespace amrex { -class Interpolater; - class AmrData { protected: @@ -182,8 +180,6 @@ class AmrData { // fill on interior by piecewise constant interpolation void FillInterior(FArrayBox &dest, int level, const Box &subbox); - void Interp(FArrayBox &fine, FArrayBox &crse, - const Box &fine_box, int lrat); void PcInterp(FArrayBox &fine, const FArrayBox &crse, const Box &subbox, int lrat); FArrayBox *ReadGrid(std::istream &is, int numVar); diff --git a/Src/Extern/amrdata/AMReX_AmrData.cpp b/Src/Extern/amrdata/AMReX_AmrData.cpp index 9717f36a90c..a71d1a6b827 100644 --- a/Src/Extern/amrdata/AMReX_AmrData.cpp +++ b/Src/Extern/amrdata/AMReX_AmrData.cpp @@ -34,73 +34,6 @@ using std::ifstream; #define VSHOWVAL(verbose, val) { if(verbose) { \ cout << #val << " = " << val << endl; } } - -#if defined( BL_FORT_USE_UPPERCASE ) -# if (BL_SPACEDIM == 1) -# define FORT_PCINTERP PCINTERP1D -# elif (BL_SPACEDIM == 2) -# define FORT_CINTERP CINTERP2D -# define FORT_PCINTERP PCINTERP2D -# define FORT_CARTGRIDMINMAX CARTGRIDMINMAX2D -# elif (BL_SPACEDIM == 3) -# define FORT_CINTERP CINTERP3D -# define FORT_PCINTERP PCINTERP3D -# define FORT_CARTGRIDMINMAX CARTGRIDMINMAX3D -# endif -#elif defined( BL_FORT_USE_LOWERCASE ) -# if (BL_SPACEDIM == 1) -# define FORT_PCINTERP pcinterp1d -# elif (BL_SPACEDIM == 2) -# define FORT_CINTERP cinterp2d -# define FORT_PCINTERP pcinterp2d -# define FORT_CARTGRIDMINMAX cartgridminmax2d -# elif (BL_SPACEDIM == 3) -# define FORT_CINTERP cinterp3d -# define FORT_PCINTERP pcinterp3d -# define FORT_CARTGRIDMINMAX cartgridminmax3d -# endif -#else -# if (BL_SPACEDIM == 1) -# define FORT_PCINTERP pcinterp1d_ -# elif (BL_SPACEDIM == 2) -# define FORT_CINTERP cinterp2d_ -# define FORT_PCINTERP pcinterp2d_ -# define FORT_CARTGRIDMINMAX cartgridminmax2d_ -# elif (BL_SPACEDIM == 3) -# define FORT_CINTERP cinterp3d_ -# define FORT_PCINTERP pcinterp3d_ -# define FORT_CARTGRIDMINMAX cartgridminmax3d_ -# endif -#endif - - -extern "C" { -#if (BL_SPACEDIM != 1) - void FORT_CINTERP(amrex::Real *fine, AMREX_ARLIM_P(flo), AMREX_ARLIM_P(fhi), - const int *fblo, const int *fbhi, - const int &nvar, const int &lratio, - const amrex::Real *crse, const int &clo, const int &chi, - const int *cslo, const int *cshi, - const int *fslo, const int *fshi, - amrex::Real *cslope, const int &c_len, - amrex::Real *fslope, amrex::Real *fdat, const int &f_len, - amrex::Real *foff); -#endif - - void FORT_PCINTERP(amrex::Real *fine, AMREX_ARLIM_P(flo), AMREX_ARLIM_P(fhi), - const int *fblo, const int *fbhi, - const int &lrat, const int &nvar, - const amrex::Real *crse, AMREX_ARLIM_P(clo), AMREX_ARLIM_P(chi), - const int *cblo, const int *cbhi, - amrex::Real *temp, const int &tlo, const int &thi); - -#if (BL_SPACEDIM != 1) - void FORT_CARTGRIDMINMAX (amrex::Real *data, AMREX_ARLIM_P(dlo), AMREX_ARLIM_P(dhi), - const amrex::Real *vfrac, const amrex::Real &vfeps, - amrex::Real &dmin, amrex::Real &dmax); -#endif -} - namespace amrex { bool AmrData::verbose = false; @@ -1775,7 +1708,7 @@ bool AmrData::MinMax(const Box &onBox, const string &derived, int level, bool valid(false); // does onBox intersect any grids (are minmax valid) Real minVal, maxVal; dataMin = std::numeric_limits::max(); - dataMax = -std::numeric_limits::max(); + dataMax = std::numeric_limits::lowest(); Box overlap; // our strategy here is to use the VisMF min and maxes if possible @@ -1833,22 +1766,21 @@ bool AmrData::MinMax(const Box &onBox, const string &derived, int level, if(visMFMin < dataMin || visMFMax > dataMax) { // do it the hard way DefineFab(level, compIndex, gdx); DefineFab(level, vfIndex, gdx); - Real *ddat = (*dataGrids[level][compIndex])[gpli].dataPtr(); - Real *vdat = (*dataGrids[level][vfIndex])[gpli].dataPtr(); - const int *dlo = (*dataGrids[level][compIndex])[gpli].loVect(); - const int *dhi = (*dataGrids[level][compIndex])[gpli].hiVect(); - overlap = onBox; overlap &= gpli.validbox(); Real vfMaxVal = (*dataGrids[level][vfIndex])[gpli].max(overlap, 0); if(vfMaxVal >= vfEps[level]) { ++cCountMixedFort; valid = true; - - FORT_CARTGRIDMINMAX(ddat, AMREX_ARLIM(dlo), AMREX_ARLIM(dhi), vdat, vfEps[level], - minVal, maxVal); - dataMin = std::min(dataMin, minVal); - dataMax = std::max(dataMax, maxVal); + auto const& da = (*dataGrids[level][compIndex])[gpli].const_array(); + auto const& va = (*dataGrids[level][vfIndex])[gpli].const_array(); + amrex::LoopOnCpu((*dataGrids[level][compIndex])[gpli].box(), [&] (int i, int j, int k) + { + if (va(i,j,k) >= vfEps[level]) { + dataMin = std::min(dataMin, da(i,j,k)); + dataMax = std::max(dataMax, da(i,j,k)); + } + }); } } else { ++cCountMixedSkipped; @@ -1861,22 +1793,21 @@ bool AmrData::MinMax(const Box &onBox, const string &derived, int level, if(visMFMin < dataMin || visMFMax > dataMax) { // do it the hard way DefineFab(level, compIndex, gdx); DefineFab(level, vfIndex, gdx); - Real *ddat = (*dataGrids[level][compIndex])[gpli].dataPtr(); - Real *vdat = (*dataGrids[level][vfIndex])[gpli].dataPtr(); - const int *dlo = (*dataGrids[level][compIndex])[gpli].loVect(); - const int *dhi = (*dataGrids[level][compIndex])[gpli].hiVect(); - overlap = onBox; overlap &= gpli.validbox(); Real vfMaxVal = (*dataGrids[level][vfIndex])[gpli].max(overlap, 0); if(vfMaxVal >= vfEps[level]) { ++iCountMixedFort; valid = true; - - FORT_CARTGRIDMINMAX(ddat, AMREX_ARLIM(dlo), AMREX_ARLIM(dhi), vdat, vfEps[level], - minVal, maxVal); - dataMin = std::min(dataMin, minVal); - dataMax = std::max(dataMax, maxVal); + auto const& da = (*dataGrids[level][compIndex])[gpli].const_array(); + auto const& va = (*dataGrids[level][vfIndex])[gpli].const_array(); + amrex::LoopOnCpu((*dataGrids[level][compIndex])[gpli].box(), [&] (int i, int j, int k) + { + if (va(i,j,k) >= vfEps[level]) { + dataMin = std::min(dataMin, da(i,j,k)); + dataMax = std::max(dataMax, da(i,j,k)); + } + }); } else { ++iCountAllBody; } @@ -1963,58 +1894,6 @@ int AmrData::StateNumber(const string &statename) const { } -// --------------------------------------------------------------- -void AmrData::Interp(FArrayBox &fine, FArrayBox &crse, - const Box &fine_box, int lrat) -{ -#if (BL_SPACEDIM == 1) - amrex::ignore_unused(fine, crse, fine_box, lrat); - amrex::Abort("AmrData::MinMax: should not be here for 1d."); -#else - BL_ASSERT(fine.box().contains(fine_box)); - Box crse_bx(amrex::coarsen(fine_box,lrat)); - Box fslope_bx(amrex::refine(crse_bx,lrat)); - Box cslope_bx(crse_bx); - cslope_bx.grow(1); - BL_ASSERT(crse.box() == cslope_bx); - - // alloc temp space for coarse grid slopes - Long cLen = cslope_bx.numPts(); - Real *cslope = new Real[BL_SPACEDIM*cLen]; - Long loslp = cslope_bx.index(crse_bx.smallEnd()); - Long hislp = cslope_bx.index(crse_bx.bigEnd()); - Long cslope_vol = cslope_bx.numPts(); - Long clo = 1 - loslp; - Long chi = clo + cslope_vol - 1; - cLen = hislp - loslp + 1; - - // alloc temp space for one strip of fine grid slopes - int dir; - int fLen = fslope_bx.longside(dir); - Real *fdat = new Real[(BL_SPACEDIM+2)*fLen]; - Real *foff = fdat + fLen; - Real *fslope = foff + fLen; - - - // alloc tmp space for slope calc and to allow for vectorization - const int *fblo = fine_box.loVect(); - const int *fbhi = fine_box.hiVect(); - const int *cblo = crse_bx.loVect(); - const int *cbhi = crse_bx.hiVect(); - const int *fslo = fslope_bx.loVect(); - const int *fshi = fslope_bx.hiVect(); - - FORT_CINTERP(fine.dataPtr(0),AMREX_ARLIM(fine.loVect()),AMREX_ARLIM(fine.hiVect()), - fblo,fbhi,fine.nComp(),lrat, - crse.dataPtr(0),clo,chi,cblo,cbhi,fslo,fshi, - cslope,cLen,fslope,fdat,fLen,foff); - - delete [] fdat; - delete [] cslope; -#endif -} - - // --------------------------------------------------------------- void AmrData::PcInterp(FArrayBox &fine, const FArrayBox &crse, const Box &subbox, int lrat) @@ -2026,27 +1905,15 @@ void AmrData::PcInterp(FArrayBox &fine, const FArrayBox &crse, Box fine_ovlp(subbox); fine_ovlp &= cfine; if(fine_ovlp.ok()) { - const int *fblo = fine_ovlp.smallEnd().getVect(); - const int *fbhi = fine_ovlp.bigEnd().getVect(); - Box crse_ovlp(fine_ovlp); - crse_ovlp.coarsen(lrat); - const int *cblo = crse_ovlp.smallEnd().getVect(); - const int *cbhi = crse_ovlp.bigEnd().getVect(); - Box fine_temp(crse_ovlp); - fine_temp.refine(lrat); - int tlo = fine_temp.smallEnd()[0]; - int thi = fine_temp.bigEnd()[0]; - int inextra(0); - if(fine_temp.ixType().test(0) == true) { // node type - inextra = 1; - } - Real *tempSpace = new Real[thi-tlo+1+inextra]; - FORT_PCINTERP(fine.dataPtr(0),AMREX_ARLIM(fine.loVect()),AMREX_ARLIM(fine.hiVect()), - fblo,fbhi, lrat,fine.nComp(), - crse.dataPtr(),AMREX_ARLIM(crse.loVect()),AMREX_ARLIM(crse.hiVect()), - cblo,cbhi, tempSpace,tlo,thi); - - delete [] tempSpace; + auto const& fa = fine.array(); + auto const& ca = crse.const_array(); + amrex::LoopOnCpu(fine_ovlp, fine.nComp(), [&] (int i, int j, int k, int n) + { + int ic = amrex::coarsen(i,lrat); + int jc = amrex::coarsen(j,lrat); + int kc = amrex::coarsen(k,lrat); + fa(i,j,k,n) = ca(ic,jc,kc,n); + }); } } diff --git a/Src/Extern/amrdata/AMReX_FABUTIL_1D.F b/Src/Extern/amrdata/AMReX_FABUTIL_1D.F deleted file mode 100644 index 42824b08963..00000000000 --- a/Src/Extern/amrdata/AMReX_FABUTIL_1D.F +++ /dev/null @@ -1,297 +0,0 @@ -c ::: SCCS stuff "@(#)FABUTIL_2D.F 3.1\t6/25/93" - -#define FORT_CINTERP cinterp1d -#define FORT_PCINTERP pcinterp1d - -#include "AMReX_REAL.H" - -#ifdef BL_USE_FLOAT -#define REAL_T real -#define bigreal 1.0e30 -#define zero 0.0e0 -#define one 1.0e0 -#define half 0.5e0 -#else -#define REAL_T double precision -#define bigreal 1.0d30 -#define zero 0.0d0 -#define one 1.0d0 -#define half 0.5d0 -#endif - -c ::: -------------------------------------------------------------- - subroutine FORT_CINTERP (fine,floi1,floi2,fhii1,fhii2, fblo,fbhi, - $ nvar,lratio, crse,clo,chi,cblo,cbhi,fslo,fshi, cslope,clen, - $ fslope,fdat,flen,voff) - - implicit none - - integer floi1,floi2, fhii1,fhii2 - - integer fblo(2), fbhi(2) - integer cblo(2), cbhi(2) - integer fslo(2), fshi(2) - integer lratio, nvar, clen, flen, clo, chi - REAL_T fine(floi1 :fhii1 ,floi2 :fhii2, nvar) - REAL_T crse(clo:chi, nvar) - REAL_T cslope(clo:chi, 2) - REAL_T fslope(flen, 2) - REAL_T fdat(flen) - REAL_T voff(flen) - -c ::: NOTE: data must be sent in so that -c ::: cslope(1,*) and crse(1,*) are associated with -c ::: the same cell - -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: cinterp: conservative interpolation from coarse grid to -c ::: subregion of fine grid defined by (fblo,fbhi) -c ::: -c ::: Inputs/Outputs -c ::: fine <=> (modify) fine grid array -c ::: flo,fhi => (const) index limits of fine grid -c ::: fblo,fbhi => (const) subregion of fine grid to get values -c ::: nvar => (const) number of variables in state vector -c ::: lratio => (const) refinement ratio between levels -c ::: -c ::: crse => (const) coarse grid data widended by 1 zone -c ::: and unrolled -c ::: clo,chi => (const) one dimensional limits of crse grid -c ::: cslo,cshi => (const) coarse grid index limits where -c ::: slopes are to be defined. This is -c ::: the projection of (fblo,fbhi) down -c ::: to the coarse level -c ::: fslo,fshi => (const) fine grid index limits where -c ::: slopes are needed. This is the -c ::: refinement of (cslo,cshi) and -c ::: contains but may not be identical -c ::: to (fblo,fbhi). -c ::: cslope => (modify) temp array coarse grid slopes -c ::: clen => (const) length of coarse gtid slopes -c ::: fslope => (modify) temp array for fine grid slope -c ::: flen => (const) length of fine grid slope array -c ::: fdat => (const) temp array for fine grid data -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - -c ::: local var - integer n, fn - integer i, ic, ioff - integer j, jc, joff - integer ist, jst - REAL_T hafrat, volratio - REAL_T cen, forw, back, slp - REAL_T xoff, yoff - integer ncbx, ncby - integer ncsx, ncsy - integer islo, jslo - integer icc, istart, iend - integer lenx, leny, maxlen - - call bl_abort("fix FORT_CINTERP for 1d.") - - hafrat = half*float(lratio-1) - volratio = one/float(lratio) - - ncbx = cbhi(1)-cblo(1)+1 - ncby = cbhi(2)-cblo(2)+1 - ncsx = ncbx+2 - ncsy = ncby+2 - ist = 1 - jst = ncsx - islo = cblo(1)-1 - jslo = cblo(2)-1 - lenx = fbhi(1)-fblo(1)+1 - leny = fbhi(2)-fblo(2)+1 - maxlen = max(lenx,leny) - if (maxlen .eq. lenx) then - do 100 i = fblo(1), fbhi(1) - fn = i-fslo(1)+1 - ioff = mod(fn-1,lratio) - voff(fn) = float(ioff)-hafrat -100 continue - else - do 110 j = fblo(2), fbhi(2) - fn = j-fslo(2)+1 - joff = mod(fn-1,lratio) - voff(fn) = float(joff)-hafrat -110 continue - end if - do 120 n = 1, nvar - -c ::: ::::: compute slopes in x direction - do 130 i = 1, clen - cen = half*(crse(i+ist,n)-crse(i-ist,n)) - forw = crse(i+ist,n)-crse(i,n) - back = crse(i,n)-crse(i-ist,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,1)=merge(slp,zero,forw*back>=0.0d0) -130 continue -c ::: ::::: compute slopes in y direction - do 140 i = 1, clen - cen = half*(crse(i+jst,n)-crse(i-jst,n)) - forw = crse(i+jst,n)-crse(i,n) - back = crse(i,n)-crse(i-jst,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,2)=merge(slp,zero,forw*back>=0.0d0) -140 continue - if (maxlen .eq. lenx) then - do 150 jc = cblo(2), cbhi(2) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 160 ioff = 1, lratio - icc = clo + ist + jst*(jc-jslo) - istart = ioff - iend = ioff + (ncbx-1)*lratio - do 170 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fdat(fn) = crse(icc,n) - icc = icc + ist -170 continue -160 continue - - do 180 joff = 0, lratio-1 - j = lratio*jc + joff - if (j .lt. fblo(2)) then - goto 180 -c --- next --- - end if - if (j .gt. fbhi(2)) then - goto 181 -c --- break --- - end if - yoff = float(joff)-hafrat - - do 190 i = fblo(1), fbhi(1) - fn = i-fslo(1)+1 - fine(i,j,n) = fdat(fn) + volratio* (voff(fn)* - $ fslope(fn,1)+yoff*fslope(fn,2)) -190 continue -180 continue -181 continue -150 continue - else - do 200 ic = cblo(1), cbhi(1) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 210 joff = 1, lratio - icc = clo + ist*(ic-islo) + jst - istart = joff - iend = joff + (ncby-1)*lratio - do 220 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fdat(fn) = crse(icc,n) - icc = icc + jst -220 continue -210 continue - - do 230 ioff = 0, lratio-1 - i = lratio*ic + ioff - if (i .lt. fblo(1)) then - goto 230 -c --- next --- - end if - if (i .gt. fbhi(1)) then - goto 231 -c --- break --- - end if - xoff = float(ioff)-hafrat - - do 240 j = fblo(2), fbhi(2) - fn = j-fslo(2)+1 - fine(i,j,n) = fdat(fn) + volratio* (xoff* - $ fslope(fn,1)+voff(fn)*fslope(fn,2)) -240 continue -230 continue -231 continue -200 continue - end if -120 continue - - return - end - - -c ::: -------------------------------------------------------------- - subroutine FORT_PCINTERP (fine,floi1,fhii1,fblo, fbhi,lrat, - $ nvar, crse,cloi1,chii1,cblo, cbhi,temp,tloi,thii) - - implicit none - - integer floi1 - integer fhii1 - integer cloi1 - integer chii1 - - integer fblo(1), fbhi(1) - integer cblo(1), cbhi(1) - integer lrat, nvar, tloi, thii - REAL_T fine(floi1 :fhii1, nvar) - REAL_T crse(cloi1 :chii1, nvar) - REAL_T temp(tloi:thii + 1) -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: pcinterp: use piecewise constant interpolation to define -c ::: values on the subregion of the fine FAB defined -c ::: by (fblo,fbhi). -c ::: -c ::: Inputs/Outputs -c ::: fine <=> (modify) fab to get interpolated values -c ::: flo,fhi => (const) index limits of fine -c ::: fblo,fbhi => (const) subregion of fine grid to get values -c ::: crse => (const) fab holding coarse grid values -c ::: clo,chi => (const) index limits of src -c ::: cblo,cbhi => (const) subregion of coarse grid holding values -c ::: temp => (modify) temporary space for vectorization -c ::: tlo,thi => (const) index limits of temp space -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: local var - integer i,ic,ioff,n - integer ixproj,ii,ll - ixproj(ii,ll) = (ii + ll*iabs(ii))/ll - iabs(ii) - - do 130 n = 1, nvar - do 140 ioff = 0, lrat-1 - do 150 ic = cblo(1),cbhi(1) - i = lrat*ic + ioff - temp(i) = crse(ic,n) -150 continue -140 continue - do 160 i = fblo(1), fbhi(1) - fine(i,n) = temp(i) -160 continue -130 continue - - return - end - - -c ::: -------------------------------------------------------------- - subroutine cartgridminmax1d (data, lo1, lo2, hi1, hi2, - $ vfracdata, vfeps, dmin, dmax) - implicit none - - integer lo1, lo2, hi1, hi2 - REAL_T data(lo1:hi1 ,lo2:hi2) - REAL_T vfracdata(lo1:hi1 ,lo2:hi2) - REAL_T vfeps, dmin, dmax - - integer i, j - - call bl_abort("fix cartgridminmax1d for 1d.") - - dmax = -bigreal - dmin = bigreal - do 420 j = lo2, hi2 - do 430 i = lo1, hi1 -c print *, "i j vfracdata(i,j) = ",i,j,vfracdata(i,j) - if ( .not. (vfracdata(i,j).lt.vfeps)) then - dmax = max(dmax,data(i,j)) - dmin = min(dmin,data(i,j)) - endif -430 continue -420 continue - - return - end - diff --git a/Src/Extern/amrdata/AMReX_FABUTIL_2D.F b/Src/Extern/amrdata/AMReX_FABUTIL_2D.F deleted file mode 100644 index 8748760ff35..00000000000 --- a/Src/Extern/amrdata/AMReX_FABUTIL_2D.F +++ /dev/null @@ -1,297 +0,0 @@ -c ::: SCCS stuff "@(#)FABUTIL_2D.F 3.1\t6/25/93" - -#define FORT_CINTERP cinterp2d -#define FORT_PCINTERP pcinterp2d - -#include "AMReX_REAL.H" - -#ifdef BL_USE_FLOAT -#define REAL_T real -#define bigreal 1.0e30 -#define zero 0.0e0 -#define one 1.0e0 -#define half 0.5e0 -#else -#define REAL_T double precision -#define bigreal 1.0d30 -#define zero 0.0d0 -#define one 1.0d0 -#define half 0.5d0 -#endif - -c ::: -------------------------------------------------------------- - subroutine FORT_CINTERP (fine,floi1,floi2,fhii1,fhii2, fblo,fbhi, - $ nvar,lratio, crse,clo,chi,cblo,cbhi,fslo,fshi, cslope,clen, - $ fslope,fdat,flen,voff) - - implicit none - - integer floi1,floi2, fhii1,fhii2 - - integer fblo(2), fbhi(2) - integer cblo(2), cbhi(2) - integer fslo(2), fshi(2) - integer lratio, nvar, clen, flen, clo, chi - REAL_T fine(floi1 :fhii1 ,floi2 :fhii2, nvar) - REAL_T crse(clo:chi, nvar) - REAL_T cslope(clo:chi, 2) - REAL_T fslope(flen, 2) - REAL_T fdat(flen) - REAL_T voff(flen) - -c ::: NOTE: data must be sent in so that -c ::: cslope(1,*) and crse(1,*) are associated with -c ::: the same cell - -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: cinterp: conservative interpolation from coarse grid to -c ::: subregion of fine grid defined by (fblo,fbhi) -c ::: -c ::: Inputs/Outputs -c ::: fine <=> (modify) fine grid array -c ::: flo,fhi => (const) index limits of fine grid -c ::: fblo,fbhi => (const) subregion of fine grid to get values -c ::: nvar => (const) number of variables in state vector -c ::: lratio => (const) refinement ratio between levels -c ::: -c ::: crse => (const) coarse grid data widended by 1 zone -c ::: and unrolled -c ::: clo,chi => (const) one dimensional limits of crse grid -c ::: cslo,cshi => (const) coarse grid index limits where -c ::: slopes are to be defined. This is -c ::: the projection of (fblo,fbhi) down -c ::: to the coarse level -c ::: fslo,fshi => (const) fine grid index limits where -c ::: slopes are needed. This is the -c ::: refinement of (cslo,cshi) and -c ::: contains but may not be identical -c ::: to (fblo,fbhi). -c ::: cslope => (modify) temp array coarse grid slopes -c ::: clen => (const) length of coarse gtid slopes -c ::: fslope => (modify) temp array for fine grid slope -c ::: flen => (const) length of fine grid slope array -c ::: fdat => (const) temp array for fine grid data -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - -c ::: local var - integer n, fn - integer i, ic, ioff - integer j, jc, joff - integer ist, jst - REAL_T hafrat, volratio - REAL_T cen, forw, back, slp - REAL_T xoff, yoff - integer ncbx, ncby - integer ncsx, ncsy - integer islo, jslo - integer icc, istart, iend - integer lenx, leny, maxlen - - hafrat = half*float(lratio-1) - volratio = one/float(lratio) - - ncbx = cbhi(1)-cblo(1)+1 - ncby = cbhi(2)-cblo(2)+1 - ncsx = ncbx+2 - ncsy = ncby+2 - ist = 1 - jst = ncsx - islo = cblo(1)-1 - jslo = cblo(2)-1 - lenx = fbhi(1)-fblo(1)+1 - leny = fbhi(2)-fblo(2)+1 - maxlen = max(lenx,leny) - if (maxlen .eq. lenx) then - do 100 i = fblo(1), fbhi(1) - fn = i-fslo(1)+1 - ioff = mod(fn-1,lratio) - voff(fn) = float(ioff)-hafrat -100 continue - else - do 110 j = fblo(2), fbhi(2) - fn = j-fslo(2)+1 - joff = mod(fn-1,lratio) - voff(fn) = float(joff)-hafrat -110 continue - end if - do 120 n = 1, nvar - -c ::: ::::: compute slopes in x direction - do 130 i = 1, clen - cen = half*(crse(i+ist,n)-crse(i-ist,n)) - forw = crse(i+ist,n)-crse(i,n) - back = crse(i,n)-crse(i-ist,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,1)=merge(slp,zero,forw*back>=0.0d0) -130 continue -c ::: ::::: compute slopes in y direction - do 140 i = 1, clen - cen = half*(crse(i+jst,n)-crse(i-jst,n)) - forw = crse(i+jst,n)-crse(i,n) - back = crse(i,n)-crse(i-jst,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,2)=merge(slp,zero,forw*back>=0.0d0) -140 continue - if (maxlen .eq. lenx) then - do 150 jc = cblo(2), cbhi(2) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 160 ioff = 1, lratio - icc = clo + ist + jst*(jc-jslo) - istart = ioff - iend = ioff + (ncbx-1)*lratio - do 170 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fdat(fn) = crse(icc,n) - icc = icc + ist -170 continue -160 continue - - do 180 joff = 0, lratio-1 - j = lratio*jc + joff - if (j .lt. fblo(2)) then - goto 180 -c --- next --- - end if - if (j .gt. fbhi(2)) then - goto 181 -c --- break --- - end if - yoff = float(joff)-hafrat - - do 190 i = fblo(1), fbhi(1) - fn = i-fslo(1)+1 - fine(i,j,n) = fdat(fn) + volratio* (voff(fn)* - $ fslope(fn,1)+yoff*fslope(fn,2)) -190 continue -180 continue -181 continue -150 continue - else - do 200 ic = cblo(1), cbhi(1) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 210 joff = 1, lratio - icc = clo + ist*(ic-islo) + jst - istart = joff - iend = joff + (ncby-1)*lratio - do 220 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fdat(fn) = crse(icc,n) - icc = icc + jst -220 continue -210 continue - - do 230 ioff = 0, lratio-1 - i = lratio*ic + ioff - if (i .lt. fblo(1)) then - goto 230 -c --- next --- - end if - if (i .gt. fbhi(1)) then - goto 231 -c --- break --- - end if - xoff = float(ioff)-hafrat - - do 240 j = fblo(2), fbhi(2) - fn = j-fslo(2)+1 - fine(i,j,n) = fdat(fn) + volratio* (xoff* - $ fslope(fn,1)+voff(fn)*fslope(fn,2)) -240 continue -230 continue -231 continue -200 continue - end if -120 continue - - return - end - - -c ::: -------------------------------------------------------------- - subroutine FORT_PCINTERP (fine,floi1,floi2,fhii1,fhii2,fblo, - $ fbhi,lrat,nvar,crse,cloi1,cloi2,chii1,chii2,cblo, - $ cbhi,temp,tloi,thii) - - implicit none - - integer floi1,floi2 - integer fhii1,fhii2 - integer cloi1,cloi2 - integer chii1,chii2 - - integer fblo(2), fbhi(2) - integer cblo(2), cbhi(2) - integer lrat, nvar, tloi, thii - REAL_T fine(floi1 :fhii1 ,floi2 :fhii2, nvar) - REAL_T crse(cloi1 :chii1 ,cloi2 :chii2, nvar) - REAL_T temp(tloi:thii + 1) -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: pcinterp: use piecewise constant interpolation to define -c ::: values on the subregion of the fine FAB defined -c ::: by (fblo,fbhi). -c ::: -c ::: Inputs/Outputs -c ::: fine <=> (modify) fab to get interpolated values -c ::: flo,fhi => (const) index limits of fine -c ::: fblo,fbhi => (const) subregion of fine grid to get values -c ::: crse => (const) fab holding coarse grid values -c ::: clo,chi => (const) index limits of src -c ::: cblo,cbhi => (const) subregion of coarse grid holding values -c ::: temp => (modify) temporary space for vectorization -c ::: tlo,thi => (const) index limits of temp space -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: local var - integer i,j,k,ic,jc,kc,ioff,n - integer ixproj,ii,ll - ixproj(ii,ll) = (ii + ll*iabs(ii))/ll - iabs(ii) - - do 120 j = fblo(2), fbhi(2) - jc = ixproj(j,lrat) - do 130 n = 1, nvar - do 140 ioff = 0, lrat-1 - do 150 ic = cblo(1),cbhi(1) - i = lrat*ic + ioff - temp(i) = crse(ic,jc,n) -150 continue -140 continue - do 160 i = fblo(1), fbhi(1) - fine(i,j,n) = temp(i) -160 continue -130 continue -120 continue - - return - end - - -c ::: -------------------------------------------------------------- - subroutine cartgridminmax2d (data, lo1, lo2, hi1, hi2, - $ vfracdata, vfeps, dmin, dmax) - implicit none - - integer lo1, lo2, hi1, hi2 - REAL_T data(lo1:hi1 ,lo2:hi2) - REAL_T vfracdata(lo1:hi1 ,lo2:hi2) - REAL_T vfeps, dmin, dmax - - integer i, j - - dmax = -bigreal - dmin = bigreal - do 420 j = lo2, hi2 - do 430 i = lo1, hi1 -c print *, "i j vfracdata(i,j) = ",i,j,vfracdata(i,j) - if ( .not. (vfracdata(i,j).lt.vfeps)) then - dmax = max(dmax,data(i,j)) - dmin = min(dmin,data(i,j)) - endif -430 continue -420 continue - - return - end - diff --git a/Src/Extern/amrdata/AMReX_FABUTIL_3D.F b/Src/Extern/amrdata/AMReX_FABUTIL_3D.F deleted file mode 100644 index 8a6ff561577..00000000000 --- a/Src/Extern/amrdata/AMReX_FABUTIL_3D.F +++ /dev/null @@ -1,758 +0,0 @@ -c ::: SCCS stuff "@(#)FABUTIL_3D.F 3.1\t6/25/93" - -#define FORT_CINTERP cinterp3d -#define FORT_PCINTERP pcinterp3d -#define FORT_VCINTERP vcinterp3d -#define FORT_CARTGRIDMINMAX cartgridminmax3d - -#include "AMReX_REAL.H" - -#ifdef BL_USE_FLOAT -#define REAL_T real -#define bigreal 1.0e30 -#define zero 0.0e0 -#define one 1.0e0 -#define half 0.5e0 -#else -#define REAL_T double precision -#define bigreal 1.0d30 -#define zero 0.0d0 -#define one 1.0d0 -#define half 0.5d0 -#endif - -#define IX_PROJ(A,B) (A+B*iabs(A))/B-iabs(A) - - -c ::: -------------------------------------------------------------- - subroutine FORT_CARTGRIDMINMAX (data, dlo1, dlo2, dlo3, dhi1, - $ dhi2, dhi3, vfracdata, vfeps, - $ dmin, dmax) - implicit none - - integer dlo1, dlo2, dlo3, dhi1, dhi2, dhi3 - REAL_T data(dlo1:dhi1 ,dlo2:dhi2, dlo3:dhi3) - REAL_T vfracdata(dlo1:dhi1 ,dlo2:dhi2, dlo3:dhi3) - REAL_T vfeps, dmin, dmax - - integer i, j, k - - dmax = -bigreal - dmin = bigreal - do 410 k = dlo3, dhi3 - do 420 j = dlo2, dhi2 - do 430 i = dlo1, dhi1 - if ( (vfracdata(i,j,k).ge.vfeps)) then - dmax = max(dmax,data(i,j,k)) - dmin = min(dmin,data(i,j,k)) - endif -430 continue -420 continue -410 continue - - return - end - - -c ::: -------------------------------------------------------------- - subroutine FORT_CINTERP (fine,floi1,floi2,floi3,fhii1,fhii2,fhii3, - $ fblo,fbhi,nvar,lratio, crse,clo,chi,cblo,cbhi,fslo,fshi, cslope, - $ clen,fslope,fdat,flen,voff) - - implicit none - - integer floi1,floi2,floi3, fhii1,fhii2,fhii3 - integer fblo(3), fbhi(3) - integer cblo(3), cbhi(3) - integer fslo(3), fshi(3) - integer lratio, nvar, clen, flen, clo, chi - REAL_T fine(floi1:fhii1,floi2:fhii2,floi3:fhii3,nvar) - REAL_T crse(clo:chi, nvar) - REAL_T cslope(clo:chi, 3) - REAL_T fslope(flen, 3) - REAL_T fdat(flen) - REAL_T voff(flen) - -c ::: NOTE: data must be sent in so that -c ::: cslope(1,*) and crse(1,*) are associated with -c ::: the same cell - -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: cinterp: conservative interpolation from coarse grid to -c ::: subregion of fine grid defined by (fblo,fbhi) -c ::: -c ::: Inputs/Outputs -c ::: fine <=> (modify) fine grid array -c ::: flo,fhi => (const) index limits of fine grid -c ::: fblo,fbhi => (const) subregion of fine grid to get values -c ::: nvar => (const) number of variables in state vector -c ::: lratio => (const) refinement ratio between levels -c ::: -c ::: crse => (const) coarse grid data widended by 1 zone -c ::: and unrolled -c ::: clo,chi => (const) one dimensional limits of crse grid -c ::: cslo,cshi => (const) coarse grid index limits where -c ::: slopes are to be defined. This is -c ::: the projection of (fblo,fbhi) down -c ::: to the coarse level -c ::: fslo,fshi => (const) fine grid index limits where -c ::: slopes are needed. This is the -c ::: refinement of (cslo,cshi) and -c ::: contains but may not be identical -c ::: to (fblo,fbhi). -c ::: cslope => (modify) temp array coarse grid slopes -c ::: clen => (const) length of coarse gtid slopes -c ::: fslope => (modify) temp array for fine grid slope -c ::: flen => (const) length of fine grid slope array -c ::: fdat => (const) temp array for fine grid data -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - -c ::: local var - integer n, fn - integer i, ic, ioff - integer j, jc, joff - integer k, kc, koff - integer ist, jst, kst - REAL_T hafrat, volratio - REAL_T cen, forw, back, slp - REAL_T xoff, yoff, zoff - integer ncbx, ncby, ncbz - integer ncsx, ncsy, ncsz - integer islo, jslo, kslo - integer icc, istart, iend - integer lenx, leny, lenz, maxlen - - hafrat = half*float(lratio-1) - volratio = one/float(lratio) - - ncbx = cbhi(1)-cblo(1)+1 - ncby = cbhi(2)-cblo(2)+1 - ncbz = cbhi(3)-cblo(3)+1 - ncsx = ncbx+2 - ncsy = ncby+2 - ncsz = ncbz+2 - ist = 1 - jst = ncsx - kst = ncsx*ncsy - islo = cblo(1)-1 - jslo = cblo(2)-1 - kslo = cblo(3)-1 - lenx = fbhi(1)-fblo(1)+1 - leny = fbhi(2)-fblo(2)+1 - lenz = fbhi(3)-fblo(3)+1 - maxlen = max(lenx,leny,lenz) - if (maxlen .eq. lenx) then - do 100 i = fblo(1), fbhi(1) - fn = i-fslo(1)+1 - ioff = mod(fn-1,lratio) - voff(fn) = float(ioff)-hafrat -100 continue - else if (maxlen .eq. leny) then - do 110 j = fblo(2), fbhi(2) - fn = j-fslo(2)+1 - joff = mod(fn-1,lratio) - voff(fn) = float(joff)-hafrat -110 continue - else - do 120 k = fblo(3), fbhi(3) - fn = k-fslo(3)+1 - koff = mod(fn-1,lratio) - voff(fn) = float(koff)-hafrat -120 continue - end if - do 130 n = 1, nvar - -c ::: ::::: compute slopes in x direction - do 140 i = 1, clen - cen = half*(crse(i+ist,n)-crse(i-ist,n)) - forw = crse(i+ist,n)-crse(i,n) - back = crse(i,n)-crse(i-ist,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,1)=merge(slp,zero,forw*back>=0.0d0) -140 continue -c ::: ::::: compute slopes in y direction - do 150 i = 1, clen - cen = half*(crse(i+jst,n)-crse(i-jst,n)) - forw = crse(i+jst,n)-crse(i,n) - back = crse(i,n)-crse(i-jst,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,2)=merge(slp,zero,forw*back>=0.0d0) -150 continue -c ::: ::::: compute slopes in z direction - do 160 i = 1, clen - cen = half*(crse(i+kst,n)-crse(i-kst,n)) - forw = crse(i+kst,n)-crse(i,n) - back = crse(i,n)-crse(i-kst,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,3)=merge(slp,zero,forw*back>=0.0d0) -160 continue - - if (maxlen .eq. lenx) then - do 170 kc = cblo(3), cbhi(3) - do 180 jc = cblo(2), cbhi(2) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 190 ioff = 1, lratio - icc = clo + ist + jst*(jc-jslo) + kst*(kc- - $ kslo) - istart = ioff - iend = ioff + (ncbx-1)*lratio - do 200 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fslope(fn,3) = cslope(icc,3) - fdat(fn) = crse(icc,n) - icc = icc + ist -200 continue -190 continue - - do 210 koff = 0, lratio-1 - k = lratio*kc + koff - if (k .lt. fblo(3)) then - goto 210 -c --- next --- - end if - if (k .gt. fbhi(3)) then - goto 211 -c --- break --- - end if - zoff = float(koff)-hafrat - do 220 joff = 0, lratio-1 - j = lratio*jc + joff - if (j .lt. fblo(2)) then - goto 220 -c --- next --- - end if - if (j .gt. fbhi(2)) then - goto 221 -c --- break --- - end if - yoff = float(joff)-hafrat - - do 230 i = fblo(1), fbhi(1) - fn = i-fslo(1)+1 - fine(i,j,k,n) = fdat(fn) + volratio* - $ (voff(fn)*fslope(fn,1)+yoff*fslope(fn, - $ 2)+ zoff*fslope(fn,3)) -230 continue -220 continue -221 continue -210 continue -211 continue -180 continue -170 continue - else if (maxlen .eq. leny) then - do 240 kc = cblo(3), cbhi(3) - do 250 ic = cblo(1), cbhi(1) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 260 joff = 1, lratio - icc = clo + ist*(ic-islo) + jst + kst*(kc- - $ kslo) - istart = joff - iend = joff + (ncby-1)*lratio - do 270 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fslope(fn,3) = cslope(icc,3) - fdat(fn) = crse(icc,n) - icc = icc + jst -270 continue -260 continue - - do 280 koff = 0, lratio-1 - k = lratio*kc + koff - if (k .lt. fblo(3)) then - goto 280 -c --- next --- - end if - if (k .gt. fbhi(3)) then - goto 281 -c --- break --- - end if - zoff = float(koff)-hafrat - do 290 ioff = 0, lratio-1 - i = lratio*ic + ioff - if (i .lt. fblo(1)) then - goto 290 -c --- next --- - end if - if (i .gt. fbhi(1)) then - goto 291 -c --- break --- - end if - xoff = float(ioff)-hafrat - - do 300 j = fblo(2), fbhi(2) - fn = j-fslo(2)+1 - fine(i,j,k,n) = fdat(fn) + volratio* - $ (xoff*fslope(fn,1)+voff(fn)*fslope(fn, - $ 2)+ zoff*fslope(fn,3)) -300 continue -290 continue -291 continue -280 continue -281 continue -250 continue -240 continue - else - do 310 jc = cblo(2), cbhi(2) - do 320 ic = cblo(1), cbhi(1) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 330 koff = 1, lratio - icc = clo + ist*(ic-islo) + jst*(jc-jslo) + - $ kst - istart = koff - iend = koff + (ncbz-1)*lratio - do 340 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fslope(fn,3) = cslope(icc,3) - fdat(fn) = crse(icc,n) - icc = icc + kst -340 continue -330 continue - - do 350 joff = 0, lratio-1 - j = lratio*jc + joff - if (j .lt. fblo(2)) then - goto 350 -c --- next --- - end if - if (j .gt. fbhi(2)) then - goto 351 -c --- break --- - end if - yoff = float(joff)-hafrat - do 360 ioff = 0, lratio-1 - i = lratio*ic + ioff - if (i .lt. fblo(1)) then - goto 360 -c --- next --- - end if - if (i .gt. fbhi(1)) then - goto 361 -c --- break --- - end if - xoff = float(ioff)-hafrat - - do 370 k = fblo(3), fbhi(3) - fn = k-fslo(3)+1 - fine(i,j,k,n) = fdat(fn) + volratio* - $ (xoff*fslope(fn,1)+yoff*fslope(fn,2)+ - $ voff(fn)*fslope(fn,3)) -370 continue -360 continue -361 continue -350 continue -351 continue -320 continue -310 continue - end if -130 continue - - return - end - - -c ::: -------------------------------------------------------------- - subroutine FORT_PCINTERP (fine,floi1,floi2,floi3,fhii1,fhii2, - $ fhii3,fblo,fbhi,lrat,nvar,crse,cloi1,cloi2,cloi3,chii1,chii2, - $ chii3,cblo,cbhi,temp,tloi,thii) - - implicit none - - integer floi1,floi2,floi3 - integer fhii1,fhii2,fhii3 - integer cloi1,cloi2,cloi3 - integer chii1,chii2,chii3 - - integer fblo(3), fbhi(3) - integer cblo(3), cbhi(3) - integer lrat, nvar, tloi, thii - REAL_T fine(floi1:fhii1,floi2:fhii2,floi3:fhii3, nvar) - REAL_T crse(cloi1:chii1,cloi2:chii2,cloi3:chii3, nvar) - REAL_T temp(tloi:thii + 1) -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: pcinterp: use piecewise constant interpolation to define -c ::: values on the subregion of the fine FAB defined -c ::: by (fblo,fbhi). -c ::: -c ::: Inputs/Outputs -c ::: fine <=> (modify) fab to get interpolated values -c ::: flo,fhi => (const) index limits of fine -c ::: fblo,fbhi => (const) subregion of fine grid to get values -c ::: crse => (const) fab holding coarse grid values -c ::: clo,chi => (const) index limits of src -c ::: cblo,cbhi => (const) subregion of coarse grid holding values -c ::: temp => (modify) temporary space for vectorization -c ::: tlo,thi => (const) index limits of temp space -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: local var - integer i,j,k,ic,jc,kc,ioff,n - integer ixproj,ii,ll - ixproj(ii,ll) = (ii + ll*iabs(ii))/ll - iabs(ii) - - do 130 k = fblo(3), fbhi(3) - kc = ixproj(k,lrat) - do 140 j = fblo(2), fbhi(2) - jc = ixproj(j,lrat) - do 150 n = 1, nvar - do 160 ioff = 0, lrat-1 - do 170 ic = cblo(1),cbhi(1) - i = lrat*ic + ioff - temp(i) = crse(ic,jc,kc,n) -170 continue -160 continue - do 180 i = fblo(1), fbhi(1) - fine(i,j,k,n) = temp(i) -180 continue -150 continue -140 continue -130 continue - - return - end - - -c ::: -------------------------------------------------------------- - subroutine FORT_VCINTERP (fine,floi1,floi2,floi3,fhii1,fhii2, - $ fhii3,fbloi1,fbloi2,fbloi3, fbhii1,fbhii2,fbhii3,nvar,lratio, - $ crse,clo,chi,cblo,cbhi, fslo,fshi,cvloi1,cvloi2,cvloi3,cvhii1, - $ cvhii2,cvhii3, cslope,clen,fslope,fdat,flen,voff, cvc1,fvc1,cvc2, - $ fvc2,cvc3,fvc3) - - implicit none - - integer floi1,floi2,floi3 - integer fhii1,fhii2,fhii3 - integer fbloi1,fbloi2,fbloi3 - integer fbhii1,fbhii2,fbhii3 - integer cvloi1,cvloi2,cvloi3 - integer cvhii1,cvhii2,cvhii3 - - integer cblo(3), cbhi(3) - integer fslo(3), fshi(3) - integer lratio, nvar, clen, flen, clo, chi - REAL_T fine(floi1:fhii1,floi2:fhii2,floi3:fhii3,nvar) - REAL_T crse(clo:chi, nvar) - REAL_T cslope(clo:chi, 3) - REAL_T fslope(flen, 3) - REAL_T fdat(flen) - REAL_T voff(flen) - - REAL_T cvc1(cvloi1 :cvhii1+1) - REAL_T cvc2(cvloi2 :cvhii2+1) - REAL_T cvc3(cvloi3 :cvhii3+1) - REAL_T fvc1(fbloi1 :fbhii1+1) - REAL_T fvc2(fbloi2 :fbhii2+1) - REAL_T fvc3(fbloi3 :fbhii3+1) - -c ::: NOTE: data must be sent in so that -c ::: cslope(1,*) and crse(1,*) are associated with -c ::: the same cell - -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -c ::: vcinterp: conservative interpolation in volume coordinates -c ::: from coarse grid to -c ::: subregion of fine grid defined by (fblo,fbhi) -c ::: -c ::: Inputs/Outputs -c ::: fine <=> (modify) fine grid array -c ::: flo,fhi => (const) index limits of fine grid -c ::: fblo,fbhi => (const) subregion of fine grid to get values -c ::: nvar => (const) number of variables in state vector -c ::: lratio => (const) refinement ratio between levels -c ::: -c ::: crse => (const) coarse grid data widended by 1 zone -c ::: and unrolled -c ::: clo,chi => (const) one dimensional limits of crse grid -c ::: cslo,cshi => (const) coarse grid index limits where -c ::: slopes are to be defined. This is -c ::: the projection of (fblo,fbhi) down -c ::: to the coarse level -c ::: fslo,fshi => (const) fine grid index limits where -c ::: slopes are needed. This is the -c ::: refinement of (cslo,cshi) and -c ::: contains but may not be identical -c ::: to (fblo,fbhi). -c ::: cslope => (modify) temp array coarse grid slopes -c ::: clen => (const) length of coarse gtid slopes -c ::: fslope => (modify) temp array for fine grid slope -c ::: flen => (const) length of fine grid slope array -c ::: fdat => (const) temp array for fine grid data -c ::: cvlo,cvhi => (const) coarse grid index limits where -c ::: volume coordinates are defined -c ::: cvc1 => (const) coarse grid volume coords, x-dir -c ::: cvc2 => (const) coarse grid volume coords, y_dir -c ::: cvc3 => (const) coarse grid volume coords, z-dir -c ::: fvc1 => (const) fine grid volume coords, x-dir -c ::: fvc2 => (const) fine grid volume coords, y-dir -c ::: fvc3 => (const) fine grid volume coords, z-dir -c ::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - -c ::: local var - integer n, fn - integer i, ic, ioff - integer j, jc, joff - integer k, kc, koff - integer ist, jst, kst - REAL_T cen, forw, back, slp - REAL_T xoff, yoff, zoff - REAL_T fcen, ccen - integer ncbx, ncby, ncbz - integer ncsx, ncsy, ncsz - integer islo, jslo, kslo - integer icc, istart, iend - integer lenx, leny, lenz, maxlen - - ncbx = cbhi(1)-cblo(1)+1 - ncby = cbhi(2)-cblo(2)+1 - ncbz = cbhi(3)-cblo(3)+1 - ncsx = ncbx+2 - ncsy = ncby+2 - ncsz = ncbz+2 - ist = 1 - jst = ncsx - kst = ncsx*ncsy - islo = cblo(1)-1 - jslo = cblo(2)-1 - kslo = cblo(3)-1 - lenx = fbhii1-fbloi1+1 - leny = fbhii2-fbloi2+1 - lenz = fbhii3-fbloi3+1 - maxlen = max(lenx,leny,lenz) - if (maxlen .eq. lenx) then - do 380 i = fbloi1, fbhii1 - fn = i-fslo(1)+1 - ic = IX_PROJ(i,lratio) - fcen = half*(fvc1(i)+fvc1(i+1)) - ccen = half*(cvc1(ic)+cvc1(ic+1)) - voff(fn) = (fcen-ccen)/(cvc1(ic+1)-cvc1(ic)) -380 continue - else if (maxlen .eq. leny) then - do 390 j = fbloi2, fbhii2 - fn = j-fslo(2)+1 - jc = IX_PROJ(j,lratio) - fcen = half*(fvc2(j)+fvc2(j+1)) - ccen = half*(cvc2(jc)+cvc2(jc+1)) - voff(fn) = (fcen-ccen)/(cvc2(jc+1)-cvc2(jc)) -390 continue - else - do 400 k = fbloi3, fbhii3 - fn = k-fslo(3)+1 - kc = IX_PROJ(k,lratio) - fcen = half*(fvc3(k)+fvc3(k+1)) - ccen = half*(cvc3(kc)+cvc3(kc+1)) - voff(fn) = (fcen-ccen)/(cvc3(kc+1)-cvc3(kc)) -400 continue - end if - do 410 n = 1, nvar - -c ::: ::::: compute slopes in x direction - do 420 i = 1, clen - cen = half*(crse(i+ist,n)-crse(i-ist,n)) - forw = crse(i+ist,n)-crse(i,n) - back = crse(i,n)-crse(i-ist,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,1)=merge(slp,zero,forw*back>=0.0d0) -420 continue -c ::: ::::: compute slopes in y direction - do 430 i = 1, clen - cen = half*(crse(i+jst,n)-crse(i-jst,n)) - forw = crse(i+jst,n)-crse(i,n) - back = crse(i,n)-crse(i-jst,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,2)=merge(slp,zero,forw*back>=0.0d0) -430 continue -c ::: ::::: compute slopes in z direction - do 440 i = 1, clen - cen = half*(crse(i+kst,n)-crse(i-kst,n)) - forw = crse(i+kst,n)-crse(i,n) - back = crse(i,n)-crse(i-kst,n) - slp = sign(one,cen)*min(abs(cen),abs(forw),abs(back)) - cslope(i,3)=merge(slp,zero,forw*back>=0.0d0) -440 continue - - if (maxlen .eq. lenx) then - do 450 kc = cblo(3), cbhi(3) - do 460 jc = cblo(2), cbhi(2) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 470 ioff = 1, lratio - icc = clo + ist + jst*(jc-jslo) + kst*(kc- - $ kslo) - istart = ioff - iend = ioff + (ncbx-1)*lratio - do 480 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fslope(fn,3) = cslope(icc,3) - fdat(fn) = crse(icc,n) - icc = icc + ist -480 continue -470 continue - - do 490 koff = 0, lratio-1 - k = lratio*kc + koff - if (k .lt. fbloi3) then - goto 490 -c --- next --- - end if - if (k .gt. fbhii3) then - goto 491 -c --- break --- - end if - fcen = half*(fvc3(k)+fvc3(k+1)) - ccen = half*(cvc3(kc)+cvc3(kc+1)) - zoff = (fcen-ccen)/(cvc3(kc+1)-cvc3(kc)) - do 500 joff = 0, lratio-1 - j = lratio*jc + joff - if (j .lt. fbloi2) then - goto 500 -c --- next --- - end if - if (j .gt. fbhii2) then - goto 501 -c --- break --- - end if - fcen = half*(fvc2(j)+fvc2(j+1)) - ccen = half*(cvc2(jc)+cvc2(jc+1)) - yoff = (fcen-ccen)/(cvc2(jc+1)-cvc2(jc)) - - do 510 i = fbloi1, fbhii1 - fn = i-fslo(1)+1 - fine(i,j,k,n) = fdat(fn) + voff(fn)* - $ fslope(fn,1)+yoff*fslope(fn,2)+ zoff* - $ fslope(fn,3) -510 continue -500 continue -501 continue -490 continue -491 continue -460 continue -450 continue - else if (maxlen .eq. leny) then - do 520 kc = cblo(3), cbhi(3) - do 530 ic = cblo(1), cbhi(1) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 540 joff = 1, lratio - icc = clo + ist*(ic-islo) + jst + kst*(kc- - $ kslo) - istart = joff - iend = joff + (ncby-1)*lratio - do 550 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fslope(fn,3) = cslope(icc,3) - fdat(fn) = crse(icc,n) - icc = icc + jst -550 continue -540 continue - - do 560 koff = 0, lratio-1 - k = lratio*kc + koff - if (k .lt. fbloi3) then - goto 560 -c --- next --- - end if - if (k .gt. fbhii3) then - goto 561 -c --- break --- - end if - fcen = half*(fvc3(k)+fvc3(k+1)) - ccen = half*(cvc3(kc)+cvc3(kc+1)) - zoff = (fcen-ccen)/(cvc3(kc+1)-cvc3(kc)) - do 570 ioff = 0, lratio-1 - i = lratio*ic + ioff - if (i .lt. fbloi1) then - goto 570 -c --- next --- - end if - if (i .gt. fbhii1) then - goto 571 -c --- break --- - end if - fcen = half*(fvc1(i)+fvc1(i+1)) - ccen = half*(cvc1(ic)+cvc1(ic+1)) - xoff = (fcen-ccen)/(cvc1(ic+1)-cvc1(ic)) - - do 580 j = fbloi2, fbhii2 - fn = j-fslo(2)+1 - fine(i,j,k,n) = fdat(fn) + xoff* - $ fslope(fn,1)+voff(fn)*fslope(fn,2)+ - $ zoff*fslope(fn,3) -580 continue -570 continue -571 continue -560 continue -561 continue -530 continue -520 continue - else - do 590 jc = cblo(2), cbhi(2) - do 600 ic = cblo(1), cbhi(1) - -c ::: ..,.......::::: strip out a fine grid slope vector - do 610 koff = 1, lratio - icc = clo + ist*(ic-islo) + jst*(jc-jslo) + - $ kst - istart = koff - iend = koff + (ncbz-1)*lratio - do 620 fn = istart, iend, lratio - fslope(fn,1) = cslope(icc,1) - fslope(fn,2) = cslope(icc,2) - fslope(fn,3) = cslope(icc,3) - fdat(fn) = crse(icc,n) - icc = icc + kst -620 continue -610 continue - - do 630 joff = 0, lratio-1 - j = lratio*jc + joff - if (j .lt. fbloi2) then - goto 630 -c --- next --- - end if - if (j .gt. fbhii2) then - goto 631 -c --- break --- - end if - fcen = half*(fvc2(j)+fvc2(j+1)) - ccen = half*(cvc2(jc)+cvc2(jc+1)) - yoff = (fcen-ccen)/(cvc2(jc+1)-cvc2(jc)) - do 640 ioff = 0, lratio-1 - i = lratio*ic + ioff - if (i .lt. fbloi1) then - goto 640 -c --- next --- - end if - if (i .gt. fbhii1) then - goto 641 -c --- break --- - end if - fcen = half*(fvc1(i)+fvc1(i+1)) - ccen = half*(cvc1(ic)+cvc1(ic+1)) - xoff = (fcen-ccen)/(cvc1(ic+1)-cvc1(ic)) - - do 650 k = fbloi3, fbhii3 - fn = k-fslo(3)+1 - fine(i,j,k,n) = fdat(fn) + xoff* - $ fslope(fn,1)+yoff*fslope(fn,2)+ - $ voff(fn)*fslope(fn,3) -650 continue -640 continue -641 continue -630 continue -631 continue -600 continue -590 continue - end if -410 continue - - return - end - - diff --git a/Src/Extern/amrdata/CMakeLists.txt b/Src/Extern/amrdata/CMakeLists.txt index 10761f6a641..d17fcddec19 100644 --- a/Src/Extern/amrdata/CMakeLists.txt +++ b/Src/Extern/amrdata/CMakeLists.txt @@ -12,7 +12,6 @@ foreach(D IN LISTS AMReX_SPACEDIM) AMReX_WritePlotFile.H AMReX_WritePlotFile.cpp AMReX_AmrvisConstants.H - AMReX_FABUTIL_${D}D.F ) if (AMReX_PROFPARSER) diff --git a/Src/Extern/amrdata/Make.package b/Src/Extern/amrdata/Make.package index 3f3769ad174..9368e0669b3 100644 --- a/Src/Extern/amrdata/Make.package +++ b/Src/Extern/amrdata/Make.package @@ -1,6 +1,5 @@ CEXE_sources += AMReX_AmrData.cpp AMReX_XYPlotDataList.cpp AMReX_DataServices.cpp AMReX_WritePlotFile.cpp CEXE_headers += AMReX_AmrData.H AMReX_AmrvisConstants.H AMReX_XYPlotDataList.H AMReX_DataServices.H AMReX_WritePlotFile.H -FEXE_sources += AMReX_FABUTIL_${DIM}D.F VPATH_LOCATIONS += $(AMREX_HOME)/Src/Extern/amrdata INCLUDE_LOCATIONS += $(AMREX_HOME)/Src/Extern/amrdata diff --git a/Tools/CMake/AMReXOptions.cmake b/Tools/CMake/AMReXOptions.cmake index c99c3a63791..a59456d7bb8 100644 --- a/Tools/CMake/AMReXOptions.cmake +++ b/Tools/CMake/AMReXOptions.cmake @@ -284,8 +284,7 @@ print_option(AMReX_FORTRAN_INTERFACES) option( AMReX_LINEAR_SOLVERS "Build AMReX Linear solvers" ON ) print_option( AMReX_LINEAR_SOLVERS ) -cmake_dependent_option( AMReX_AMRDATA "Build data services" OFF - "AMReX_FORTRAN" OFF ) +option( AMReX_AMRDATA "Build data services" OFF ) print_option( AMReX_AMRDATA ) option( AMReX_PARTICLES "Build particle classes" ON)