ccseapps-2.5/ 0000755 0001750 0001750 00000000000 11634153217 014316 5 ustar amckinstry amckinstry ccseapps-2.5/NOTES 0000644 0001750 0001750 00000001265 11634153073 015135 0 ustar amckinstry amckinstry
From Akira:
Akira has mucked with the header files. The reason for this is as follows:
-> The serial build of Boxlib fakes MPI under the covers
-> When we try to build an AVT boxlib reader, a parallel version of the reader
is built.
-> That reader links against MPI, which conflicts with the way the Boxlib
library fakes MPI under the covers.
-> Problems emerge.
So use Akira's headers.
As far as building Boxlib:
-> Untar the tarball in this directory.
-> Go to the Boxlib subdirectory and modify the GNUmakefile.
-> It will figure out the platform, etc.
-> You pretty much just need to specify the dimension.
-> Rename the library to be something like libbox2D.a or libbox3D.a
ccseapps-2.5/CCSEApps/ 0000755 0001750 0001750 00000000000 11634153073 015657 5 ustar amckinstry amckinstry ccseapps-2.5/CCSEApps/mglib/ 0000755 0001750 0001750 00000000000 11634153073 016751 5 ustar amckinstry amckinstry ccseapps-2.5/CCSEApps/mglib/Banner.html 0000644 0001750 0001750 00000000567 11634153073 021054 0 ustar amckinstry amckinstry Problems with this Web page should be sent to webmaster@mothra.lbl.gov
Bugs in the software should be sent to guthamr-bugs@mothra.lbl.gov
(C)opyright by Lawrence Berkeley National Laboratory
ccseapps-2.5/CCSEApps/mglib/Make.package 0000644 0001750 0001750 00000001562 11634153073 021147 0 ustar amckinstry amckinstry #
# $Id: Make.package,v 1.2 1999/04/01 21:43:11 car Exp $
#
MGLIB_BASE=EXE
ifeq ($(LBASE),mg)
MGLIB_BASE=LIB
endif
C$(MGLIB_BASE)_sources += ABecLaplacian.cpp BndryData.cpp CGSolver.cpp \
InterpBndryData.cpp LinOp.cpp \
Mask.cpp MultiGrid.cpp
C$(MGLIB_BASE)_sources += Laplacian.cpp
C$(MGLIB_BASE)_headers += ABecLaplacian.H BndryData.H BoundCond.H \
CGSolver.H InterpBndryData.H LO_BCTYPES.H \
LinOp.H Mask.H MultiGrid.H
C$(MGLIB_BASE)_headers += Laplacian.H
F$(MGLIB_BASE)_headers += ABec_F.H CG_F.H INTERPBNDRYDATA_F.H LO_F.H \
LP_F.H MG_F.H
F$(MGLIB_BASE)_sources += ABec_$(DIM)D.F ABec_UTIL.F CG_$(DIM)D.F \
INTERPBNDRYDATA_$(DIM)D.F LO_$(DIM)D.F \
LO_UTIL.F LP_$(DIM)D.F MG_$(DIM)D.F
ccseapps-2.5/CCSEApps/mglib/InterpBndryData.H 0000644 0001750 0001750 00000014314 11634153073 022117 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _INTERPBNDRYDATA_H_
#define _INTERPBNDRYDATA_H_
//
// $Id: InterpBndryData.H,v 1.8 2000/10/02 20:51:16 lijewski Exp $
//
#include
#include
#include
#include
#include
#include
#include
#include
//@Man:
/*@Memo:
An InterpBndryData object adds to a BndryData object the ability to
manipulate and set the data stored in the boundary cells.
*/
/*@Doc:
The "Interpbndrydata" class is a virtual base class derived from
BndryData. It is intended to provide a more physical method for
filling boundary-related data. Boundary values in a BndryData object
are stored in FabSets around each grid in the domain, and the
InterpBndryData class provides a mechanism for filling these FabSets,
consistent with AMR-like numerical discretizations. When asked to
set it's boundary values, an InterpBndryData object:
\begin{enumerate}
\item Fills with physical boundary values if the FAB is on the
domain boundary ({\it the corresponding values are presumed to be
stored in the ghost cells of a MultiFab given to the boundary filling
routine})
\item Fills on intersection with data from the VALID region of the
input MultiFab, ensuring that adjacent FABs use consistent data at
their intersection, and otherwise,
\item Fills with values interpolated from a coarser FAB that
bounds the cells that do not meet the above two criteria
\end{enumerate}
This class does NOT provide a copy constructor or assignment operator.
*/
class InterpBndryData
:
public BndryData
{
public:
//
//@ManDoc: default constructor
//
InterpBndryData ()
:
BndryData() {}
//
//@ManDoc: constructor for given BoxArray, etc
//
InterpBndryData (const BoxArray& _grids,
int _ncomp,
const Geometry& geom);
//
//@ManDoc: Copy constructor.
//
InterpBndryData (const InterpBndryData& rhs) : BndryData(rhs) {}
//
//@ManDoc: Copy assignment operator.
//
InterpBndryData& operator= (const InterpBndryData& rhs)
{
if (!(this == &rhs))
{
BndryData::operator=(rhs);
}
return *this;
}
//
//@ManDoc: interpret user BCs to those expected by LinOp: takes integer ratio and
// is a wrapper to the IntVect version
//
void setBndryConds (const BCRec& phys_bc,
int ratio);
//
//@ManDoc: interpret user BCs to those expected by LinOp: takes IntVect ratio
//
virtual void setBndryConds (const BCRec& phys_bc,
IntVect& ratio,
int comp=0) = 0;
//
//@ManDoc: set bndry values at coarse level (non interpolation performed)
//
void setBndryValues (const MultiFab& mf,
int mf_start,
int bnd_start,
int num_comp,
const BCRec& phys_bc);
//
//@ManDoc: set bndry values at fine level, performing necessary interpolations
//
void setBndryValues (::BndryRegister& crse,
int c_start,
const MultiFab& fine,
int f_start,
int bnd_start,
int num_comp,
int ratio,
const BCRec& phys_bc);
//
//@ManDoc: set bndry values at fine level, performing necessary interpolations
//
void setBndryValues (::BndryRegister& crse,
int c_start,
const MultiFab& fine,
int f_start,
int bnd_start,
int num_comp,
IntVect& ratio,
const BCRec& phys_bc);
};
inline
void
InterpBndryData::setBndryValues (::BndryRegister& crse,
int c_start,
const MultiFab& fine,
int f_start,
int bnd_start,
int num_comp,
int ratio,
const BCRec& bc)
{
IntVect ratio_vect = ratio * IntVect::TheUnitVector();
setBndryValues(crse,c_start,fine,f_start,bnd_start,num_comp,ratio_vect,bc);
}
inline
void
InterpBndryData::setBndryConds (const BCRec& phys_bc,
int ratio)
{
IntVect ratio_vect = ratio * IntVect::TheUnitVector();
setBndryConds(phys_bc, ratio_vect);
}
#endif /*_INTERPBNDRYDATA_H_*/
ccseapps-2.5/CCSEApps/mglib/Mask.H 0000644 0001750 0001750 00000012232 11634153073 017755 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _MASK_H_
#define _MASK_H_
//
// $Id: Mask.H,v 1.5 2001/08/01 21:51:04 lijewski Exp $
//
#include
#include
//@Man:
/*@Memo:
A Mask is a derived Fab class whose elements maintain a logical
"TRUE" or "FALSE" state. A Mask can perform several elementary
logical operations on its data members.
*/
/*@Doc:
Implement a logical class Mask to maintain the TRUE or FALSE state
of elements in a box. A Mask can perform element-wise logical
operations, but is otherwise very similar to an FArrayBox object.
A Mask object can set its components based on comparing (a subregion
of a) real-valued FArrayBox element magnitudes to a scalar value, or
by "and", "or" operations with (the a subregion of) other Masks.
This class does NOT provide a copy constructor or assignment operator.
*/
class Mask
:
public BaseFab
{
public:
//
//@ManDoc: default constructor
//
Mask ()
:
BaseFab() {}
//
//@ManDoc: allocating constructor (nc=number of components)
//
Mask (const Box& bx,
int nc = 1)
:
BaseFab(bx,nc) {}
//
//@ManDoc: construct from input stream
//
Mask (std::istream& is);
//
//@ManDoc: destructor
//
virtual ~Mask () {}
//
//@ManDoc: Initialize from stream.
//
friend std::istream& operator>> (std::istream&, Mask&);
//
//@ManDoc: initialize from stream, FAB-style
//
void readFrom (std::istream&);
//
//@ManDoc: output to stream
//
friend std::ostream& operator<< (std::ostream&, const Mask&);
//
//@ManDoc: output to stream, FAB-style
//
void writeOn (std::ostream&) const;
//
//@ManDoc: in-place And operator
//
Mask& operator&= (const Mask& src) { return And(src); }
//
//@ManDoc: in-place And
//
Mask& And (const Mask& src);
//
//@ManDoc: as above, but specify source/destination/number of components
//
Mask& And (const Mask& src,
int srccomp,
int destcomp,
int numcomp = 1);
//
//@ManDoc: as above, and specify subregion
//
Mask& And (const Mask& src,
const Box& subbox,
int srccomp,
int destcomp,
int numcomp = 1);
//
//@ManDoc: in-pace And, over source components to destination components,
// and on intersection of source and destination boxes
//
Mask& And (const Mask& src,
const Box& srcbox,
const Box& destbox,
int srccomp,
int destcomp,
int numcomp = 1);
//
//@ManDoc: in-place Or operator
//
Mask& operator|= (const Mask& src) { return Or(src); }
//
//@ManDoc: in-place Or
//
Mask& Or (const Mask& src);
//
//@ManDoc: as above, but specify source/destination/number of components
//
Mask& Or (const Mask& src,
int srccomp,
int destcomp,
int numcomp = 1);
//
//@ManDoc: as above, and specify subregion
//
Mask& Or (const Mask& src,
const Box& subbox,
int srccomp,
int destcomp,
int numcomp = 1);
//
//@ManDoc: in-pace Or, over source components to destination components,
// and on intersection of source and destination boxes
//
Mask& Or (const Mask& src,
const Box& srcbox,
const Box& destbox,
int srccomp,
int destcomp,
int numcomp = 1);
private:
//
// Disallow copy constructor and operator.
//
Mask& operator= (const Mask&);
Mask (const Mask&);
};
#endif /*_MASK_H_*/
ccseapps-2.5/CCSEApps/mglib/MG_F.H 0000644 0001750 0001750 00000005504 11634153073 017636 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _MG_F_H_
#define _MG_F_H_
/*
** $Id: MG_F.H,v 1.3 2002/04/26 22:10:02 lijewski Exp $
*/
#include
#if defined(BL_LANG_FORT)
#if (BL_SPACEDIM == 2)
#define FORT_AVERAGE average2dgen
#define FORT_INTERP interp2dgen
#endif
#if (BL_SPACEDIM == 3)
#define FORT_AVERAGE average3dgen
#define FORT_INTERP interp3dgen
#endif
#else
#if (BL_SPACEDIM == 2)
#if defined(BL_FORT_USE_UPPERCASE)
#define FORT_AVERAGE AVERAGE2DGEN
#define FORT_INTERP INTERP2DGEN
#elif defined(BL_FORT_USE_LOWERCASE)
#define FORT_AVERAGE average2dgen
#define FORT_INTERP interp2dgen
#elif defined(BL_FORT_USE_UNDERSCORE)
#define FORT_AVERAGE average2dgen_
#define FORT_INTERP interp2dgen_
#endif
#endif
#if (BL_SPACEDIM == 3)
#if defined(BL_FORT_USE_UPPERCASE)
#define FORT_AVERAGE AVERAGE3DGEN
#define FORT_INTERP INTERP3DGEN
#elif defined(BL_FORT_USE_LOWERCASE)
#define FORT_AVERAGE average3dgen
#define FORT_INTERP interp3dgen
#elif defined(BL_FORT_USE_UNDERSCORE)
#define FORT_AVERAGE average3dgen_
#define FORT_INTERP interp3dgen_
#endif
#endif
#include
extern "C"
{
void FORT_AVERAGE (
Real* crse, ARLIM_P(crse_lo), ARLIM_P(crse_hi),
const Real* fine, ARLIM_P(fine_lo), ARLIM_P(fine_hi),
const int *tlo, const int *thi,
const int *nc);
void FORT_INTERP (
Real* fine, ARLIM_P(fine_lo), ARLIM_P(fine_hi),
const Real* crse, ARLIM_P(crse_lo), ARLIM_P(crse_hi),
const int *tlo, const int *thi,
const int *nc);
}
#endif
#endif /*_MG_F_H_*/
ccseapps-2.5/CCSEApps/mglib/ABecLaplacian.cpp 0000644 0001750 0001750 00000044652 11634153073 022067 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: ABecLaplacian.cpp,v 1.20 2002/11/20 16:52:07 lijewski Exp $
//
#include
#include
#include
#include
#include
#include
#include
Real ABecLaplacian::a_def = 0.0;
Real ABecLaplacian::b_def = 1.0;
Real ABecLaplacian::alpha_def = 1.0;
Real ABecLaplacian::beta_def = 1.0;
ABecLaplacian::ABecLaplacian (const BndryData& _bd,
Real _h)
:
LinOp(_bd,_h),
alpha(alpha_def),
beta(beta_def)
{
initCoefficients(_bd.boxes());
}
ABecLaplacian::ABecLaplacian (const BndryData& _bd,
const Real* _h)
:
LinOp(_bd,_h),
alpha(alpha_def),
beta(beta_def)
{
initCoefficients(_bd.boxes());
}
ABecLaplacian::~ABecLaplacian ()
{
clearToLevel(-1);
}
Real
ABecLaplacian::norm(int nm, int level)
{
BL_ASSERT(nm == 0);
const MultiFab& a = aCoefficients(level);
D_TERM(const MultiFab& bX = bCoefficients(0,level);,
const MultiFab& bY = bCoefficients(1,level);,
const MultiFab& bZ = bCoefficients(2,level););
const int nc = a.nComp();
Real res = 0.0;
for (MFIter amfi(a); amfi.isValid(); ++amfi)
{
Real tres;
#if (BL_SPACEDIM==2)
FORT_NORMA(&tres,
&alpha, &beta,
a[amfi].dataPtr(), ARLIM(a[amfi].loVect()), ARLIM(a[amfi].hiVect()),
bX[amfi].dataPtr(), ARLIM(bX[amfi].loVect()), ARLIM(bX[amfi].hiVect()),
bY[amfi].dataPtr(), ARLIM(bY[amfi].loVect()), ARLIM(bY[amfi].hiVect()),
amfi.validbox().loVect(), amfi.validbox().hiVect(), &nc,
h[level]);
#elif (BL_SPACEDIM==3)
FORT_NORMA(&tres,
&alpha, &beta,
a[amfi].dataPtr(), ARLIM(a[amfi].loVect()), ARLIM(a[amfi].hiVect()),
bX[amfi].dataPtr(), ARLIM(bX[amfi].loVect()), ARLIM(bX[amfi].hiVect()),
bY[amfi].dataPtr(), ARLIM(bY[amfi].loVect()), ARLIM(bY[amfi].hiVect()),
bZ[amfi].dataPtr(), ARLIM(bZ[amfi].loVect()), ARLIM(bZ[amfi].hiVect()),
amfi.validbox().loVect(), amfi.validbox().hiVect(), &nc,
h[level]);
#endif
res = std::max(res, tres);
}
ParallelDescriptor::ReduceRealMax(res);
return res;
}
void
ABecLaplacian::clearToLevel (int level)
{
BL_ASSERT(level >= -1);
for (int i = level+1; i < numLevels(); ++i)
{
delete acoefs[i];
a_valid[i] = false;
for (int j = 0; j < BL_SPACEDIM; ++j)
{
delete bcoefs[i][j];
}
b_valid[i] = false;
}
}
void
ABecLaplacian::prepareForLevel (int level)
{
LinOp::prepareForLevel(level);
if (level == 0 )
return;
prepareForLevel(level-1);
//
// If coefficients were marked invalid, or if not yet made, make new ones
// (Note: makeCoefficients is a LinOp routine, and it allocates AND
// fills coefficients. A more efficient implementation would allocate
// and fill in separate steps--we could then use the a_valid bool
// along with the length of a_valid to separately determine whether to
// fill or allocate the coefficient MultiFabs.
//
if (level >= a_valid.size() || a_valid[level] == false)
{
if (acoefs.size() < level+1)
{
acoefs.resize(level+1);
acoefs[level] = new MultiFab;
}
else
{
delete acoefs[level];
acoefs[level] = new MultiFab;
}
makeCoefficients(*acoefs[level], *acoefs[level-1], level);
a_valid.resize(level+1);
a_valid[level] = true;
}
if (level >= b_valid.size() || b_valid[level] == false)
{
if (bcoefs.size() < level+1)
{
bcoefs.resize(level+1);
for(int i = 0; i < BL_SPACEDIM; ++i)
bcoefs[level][i] = new MultiFab;
}
else
{
for(int i = 0; i < BL_SPACEDIM; ++i)
{
delete bcoefs[level][i];
bcoefs[level][i] = new MultiFab;
}
}
for (int i = 0; i < BL_SPACEDIM; ++i)
{
makeCoefficients(*bcoefs[level][i], *bcoefs[level-1][i], level);
}
b_valid.resize(level+1);
b_valid[level] = true;
}
}
void
ABecLaplacian::initCoefficients (const BoxArray& _ba)
{
const int nComp=1;
const int nGrow=0;
acoefs.resize(1);
bcoefs.resize(1);
acoefs[0] = new MultiFab(_ba, nComp, nGrow, Fab_allocate);
acoefs[0]->setVal(a_def);
a_valid.resize(1);
a_valid[0] = true;
for (int i = 0; i < BL_SPACEDIM; ++i)
{
BoxArray edge_boxes(_ba);
edge_boxes.surroundingNodes(i);
bcoefs[0][i] = new MultiFab(edge_boxes, nComp, nGrow, Fab_allocate);
bcoefs[0][i]->setVal(b_def);
}
b_valid.resize(1);
b_valid[0] = true;
}
void
ABecLaplacian::invalidate_a_to_level (int lev)
{
lev = (lev >= 0 ? lev : 0);
for (int i = lev; i < numLevels(); i++)
a_valid[i] = false;
}
void
ABecLaplacian::invalidate_b_to_level (int lev)
{
lev = (lev >= 0 ? lev : 0);
for (int i = lev; i < numLevels(); i++)
b_valid[i] = false;
}
void
ABecLaplacian::compFlux (D_DECL(MultiFab &xflux, MultiFab &yflux, MultiFab &zflux),
MultiFab& in, const BC_Mode& bc_mode)
{
compFlux(D_DECL(xflux, yflux, zflux), in, bc_mode, true);
}
void
ABecLaplacian::compFlux (D_DECL(MultiFab &xflux, MultiFab &yflux, MultiFab &zflux),
MultiFab& in, const BC_Mode& bc_mode, bool do_ApplyBC)
{
int level = 0;
int src_comp = 0;
int num_comp = 1;
if (do_ApplyBC)
applyBC(in,src_comp,num_comp,level,bc_mode);
const BoxArray& bxa = gbox[level];
const MultiFab& a = aCoefficients(level);
D_TERM(const MultiFab& bX = bCoefficients(0,level);,
const MultiFab& bY = bCoefficients(1,level);,
const MultiFab& bZ = bCoefficients(2,level););
int nc = in.nComp();
for (MFIter inmfi(in); inmfi.isValid(); ++inmfi)
{
BL_ASSERT(bxa[inmfi.index()] == inmfi.validbox());
FORT_FLUX(in[inmfi].dataPtr(),
ARLIM(in[inmfi].loVect()), ARLIM(in[inmfi].hiVect()),
&alpha, &beta, a[inmfi].dataPtr(),
ARLIM(a[inmfi].loVect()), ARLIM(a[inmfi].hiVect()),
bX[inmfi].dataPtr(),
ARLIM(bX[inmfi].loVect()), ARLIM(bX[inmfi].hiVect()),
bY[inmfi].dataPtr(),
ARLIM(bY[inmfi].loVect()), ARLIM(bY[inmfi].hiVect()),
#if (BL_SPACEDIM == 3)
bZ[inmfi].dataPtr(),
ARLIM(bZ[inmfi].loVect()), ARLIM(bZ[inmfi].hiVect()),
#endif
inmfi.validbox().loVect(), inmfi.validbox().hiVect(), &nc,
h[level],
xflux[inmfi].dataPtr(),
ARLIM(xflux[inmfi].loVect()), ARLIM(xflux[inmfi].hiVect()),
yflux[inmfi].dataPtr(),
ARLIM(yflux[inmfi].loVect()), ARLIM(yflux[inmfi].hiVect())
#if (BL_SPACEDIM == 3)
,zflux[inmfi].dataPtr(),
ARLIM(zflux[inmfi].loVect()), ARLIM(zflux[inmfi].hiVect())
#endif
);
}
}
#ifdef BL_THREADS
class task_gsrb
:
public WorkQueue::task
{
public:
task_gsrb(FArrayBox& solnL_,
const FArrayBox& rhsL_,
Real alpha_, Real beta_,
const FArrayBox& a_,
D_DECL(const FArrayBox& bX_,
const FArrayBox& bY_,
const FArrayBox& bZ_),
const FArrayBox& f0_, const Mask& m0_,
const FArrayBox& f1_, const Mask& m1_,
const FArrayBox& f2_, const Mask& m2_,
const FArrayBox& f3_, const Mask& m3_,
#if BL_SPACEDIM == 3
const FArrayBox& f4_, const Mask& m4_,
const FArrayBox& f5_, const Mask& m5_,
#endif
const Box& vbox_,
int nc_,
const Real* h_,
int redBlackFlag_)
:
solnL(solnL_),
rhsL(rhsL_),
alpha(alpha_), beta(beta_),
a(a_),
D_DECL(bX(bX_),
bY(bY_),
bZ(bZ_)),
f0(f0_), m0(m0_),
f1(f1_), m1(m1_),
f2(f2_), m2(m2_),
f3(f3_), m3(m3_),
#if BL_SPACEDIM == 3
f4(f4_), m4(m4_),
f5(f5_), m5(m5_),
#endif
vbox(vbox_),
nc(nc_),
h(h_),
redBlackFlag(redBlackFlag_)
{}
virtual void run();
private:
FArrayBox& solnL;
const FArrayBox& rhsL;
const Real alpha, beta;
const FArrayBox& a;
D_TERM(const FArrayBox& bX,
;const FArrayBox& bY,
;const FArrayBox& bZ);
const FArrayBox& f0;
const Mask& m0;
const FArrayBox& f1;
const Mask& m1;
const FArrayBox& f2;
const Mask& m2;
const FArrayBox& f3;
const Mask& m3;
#if BL_SPACEDIM == 3
const FArrayBox& f4;
const Mask& m4;
const FArrayBox& f5;
const Mask& m5;
#endif
const Box vbox;
const int nc;
const Real* h;
const int redBlackFlag;
};
void
task_gsrb::run ()
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::run()");
FORT_GSRB(solnL.dataPtr(), ARLIM(solnL.loVect()),ARLIM(solnL.hiVect()),
rhsL.dataPtr(), ARLIM(rhsL.loVect()), ARLIM(rhsL.hiVect()),
&alpha, &beta,
a.dataPtr(), ARLIM(a.loVect()), ARLIM(a.hiVect()),
bX.dataPtr(), ARLIM(bX.loVect()), ARLIM(bX.hiVect()),
bY.dataPtr(), ARLIM(bY.loVect()), ARLIM(bY.hiVect()),
#if BL_SPACEDIM==3
bZ.dataPtr(), ARLIM(bZ.loVect()), ARLIM(bZ.hiVect()),
#endif
f0.dataPtr(), ARLIM(f0.loVect()), ARLIM(f0.hiVect()),
m0.dataPtr(), ARLIM(m0.loVect()), ARLIM(m0.hiVect()),
f1.dataPtr(), ARLIM(f1.loVect()), ARLIM(f1.hiVect()),
m1.dataPtr(), ARLIM(m1.loVect()), ARLIM(m1.hiVect()),
f2.dataPtr(), ARLIM(f2.loVect()), ARLIM(f2.hiVect()),
m2.dataPtr(), ARLIM(m2.loVect()), ARLIM(m2.hiVect()),
f3.dataPtr(), ARLIM(f3.loVect()), ARLIM(f3.hiVect()),
m3.dataPtr(), ARLIM(m3.loVect()), ARLIM(m3.hiVect()),
#if BL_SPACEDIM==3
f4.dataPtr(), ARLIM(f4.loVect()), ARLIM(f4.hiVect()),
m4.dataPtr(), ARLIM(m4.loVect()), ARLIM(m4.hiVect()),
f5.dataPtr(), ARLIM(f5.loVect()), ARLIM(f5.hiVect()),
m5.dataPtr(), ARLIM(m5.loVect()), ARLIM(m5.hiVect()),
#endif
vbox.loVect(), vbox.hiVect(),
&nc, h, &redBlackFlag);
}
#endif
//
// Must be defined for MultiGrid/CGSolver to work.
//
void
ABecLaplacian::Fsmooth (MultiFab& solnL,
const MultiFab& rhsL,
int level,
int redBlackFlag)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::Fsmooth()");
const BoxArray& bxa = gbox[level];
OrientationIter oitr;
const FabSet& f0 = (*undrrelxr[level])[oitr()]; oitr++;
const FabSet& f1 = (*undrrelxr[level])[oitr()]; oitr++;
const FabSet& f2 = (*undrrelxr[level])[oitr()]; oitr++;
const FabSet& f3 = (*undrrelxr[level])[oitr()]; oitr++;
#if (BL_SPACEDIM > 2)
const FabSet& f4 = (*undrrelxr[level])[oitr()]; oitr++;
const FabSet& f5 = (*undrrelxr[level])[oitr()]; oitr++;
#endif
const MultiFab& a = aCoefficients(level);
D_TERM(const MultiFab &bX = bCoefficients(0,level);,
const MultiFab &bY = bCoefficients(1,level);,
const MultiFab &bZ = bCoefficients(2,level););
const int nc = solnL.nComp();
for (MFIter solnLmfi(solnL); solnLmfi.isValid(); ++solnLmfi)
{
oitr.rewind();
const int gn = solnLmfi.index();
const Mask& m0 = *maskvals[level][gn][oitr()]; oitr++;
const Mask& m1 = *maskvals[level][gn][oitr()]; oitr++;
const Mask& m2 = *maskvals[level][gn][oitr()]; oitr++;
const Mask& m3 = *maskvals[level][gn][oitr()]; oitr++;
#if (BL_SPACEDIM > 2)
const Mask& m4 = *maskvals[level][gn][oitr()]; oitr++;
const Mask& m5 = *maskvals[level][gn][oitr()]; oitr++;
#endif
BL_ASSERT(bxa[solnLmfi.index()] == solnLmfi.validbox());
#ifdef BL_THREADS
BoxLib::theWorkQueue().add(new task_gsrb(solnL[gn],
rhsL[gn],
alpha, beta,
a[gn],
D_DECL(bX[gn], bY[gn], bZ[gn]),
f0[gn], m0,
f1[gn], m1,
f2[gn], m2,
f3[gn], m3,
#if BL_SPACEDIM == 3
f4[gn], m4,
f5[gn], m5,
#endif
solnLmfi.validbox(),
nc, h[level], redBlackFlag));
#else
#if (BL_SPACEDIM == 2)
FORT_GSRB(solnL[solnLmfi].dataPtr(), ARLIM(solnL[solnLmfi].loVect()),ARLIM(solnL[solnLmfi].hiVect()),
rhsL[solnLmfi].dataPtr(), ARLIM(rhsL[solnLmfi].loVect()), ARLIM(rhsL[solnLmfi].hiVect()),
&alpha, &beta,
a[solnLmfi].dataPtr(), ARLIM(a[solnLmfi].loVect()), ARLIM(a[solnLmfi].hiVect()),
bX[solnLmfi].dataPtr(), ARLIM(bX[solnLmfi].loVect()), ARLIM(bX[solnLmfi].hiVect()),
bY[solnLmfi].dataPtr(), ARLIM(bY[solnLmfi].loVect()), ARLIM(bY[solnLmfi].hiVect()),
f0[solnLmfi.index()].dataPtr(), ARLIM(f0[solnLmfi.index()].loVect()), ARLIM(f0[solnLmfi.index()].hiVect()),
m0.dataPtr(), ARLIM(m0.loVect()), ARLIM(m0.hiVect()),
f1[solnLmfi.index()].dataPtr(), ARLIM(f1[solnLmfi.index()].loVect()), ARLIM(f1[solnLmfi.index()].hiVect()),
m1.dataPtr(), ARLIM(m1.loVect()), ARLIM(m1.hiVect()),
f2[solnLmfi.index()].dataPtr(), ARLIM(f2[solnLmfi.index()].loVect()), ARLIM(f2[solnLmfi.index()].hiVect()),
m2.dataPtr(), ARLIM(m2.loVect()), ARLIM(m2.hiVect()),
f3[solnLmfi.index()].dataPtr(), ARLIM(f3[solnLmfi.index()].loVect()), ARLIM(f3[solnLmfi.index()].hiVect()),
m3.dataPtr(), ARLIM(m3.loVect()), ARLIM(m3.hiVect()),
solnLmfi.validbox().loVect(), solnLmfi.validbox().hiVect(),
&nc, h[level], &redBlackFlag);
#endif
#if (BL_SPACEDIM == 3)
FORT_GSRB(solnL[solnLmfi].dataPtr(), ARLIM(solnL[solnLmfi].loVect()),ARLIM(solnL[solnLmfi].hiVect()),
rhsL[solnLmfi].dataPtr(), ARLIM(rhsL[solnLmfi].loVect()), ARLIM(rhsL[solnLmfi].hiVect()),
&alpha, &beta,
a[solnLmfi].dataPtr(), ARLIM(a[solnLmfi].loVect()), ARLIM(a[solnLmfi].hiVect()),
bX[solnLmfi].dataPtr(), ARLIM(bX[solnLmfi].loVect()), ARLIM(bX[solnLmfi].hiVect()),
bY[solnLmfi].dataPtr(), ARLIM(bY[solnLmfi].loVect()), ARLIM(bY[solnLmfi].hiVect()),
bZ[solnLmfi].dataPtr(), ARLIM(bZ[solnLmfi].loVect()), ARLIM(bZ[solnLmfi].hiVect()),
f0[solnLmfi.index()].dataPtr(), ARLIM(f0[solnLmfi.index()].loVect()), ARLIM(f0[solnLmfi.index()].hiVect()),
m0.dataPtr(), ARLIM(m0.loVect()), ARLIM(m0.hiVect()),
f1[solnLmfi.index()].dataPtr(), ARLIM(f1[solnLmfi.index()].loVect()), ARLIM(f1[solnLmfi.index()].hiVect()),
m1.dataPtr(), ARLIM(m1.loVect()), ARLIM(m1.hiVect()),
f2[solnLmfi.index()].dataPtr(), ARLIM(f2[solnLmfi.index()].loVect()), ARLIM(f2[solnLmfi.index()].hiVect()),
m2.dataPtr(), ARLIM(m2.loVect()), ARLIM(m2.hiVect()),
f3[solnLmfi.index()].dataPtr(), ARLIM(f3[solnLmfi.index()].loVect()), ARLIM(f3[solnLmfi.index()].hiVect()),
m3.dataPtr(), ARLIM(m3.loVect()), ARLIM(m3.hiVect()),
f4[solnLmfi.index()].dataPtr(), ARLIM(f4[solnLmfi.index()].loVect()), ARLIM(f4[solnLmfi.index()].hiVect()),
m4.dataPtr(), ARLIM(m4.loVect()), ARLIM(m4.hiVect()),
f5[solnLmfi.index()].dataPtr(), ARLIM(f5[solnLmfi.index()].loVect()), ARLIM(f5[solnLmfi.index()].hiVect()),
m5.dataPtr(), ARLIM(m5.loVect()), ARLIM(m5.hiVect()),
solnLmfi.validbox().loVect(), solnLmfi.validbox().hiVect(),
&nc, h[level], &redBlackFlag);
#endif
#endif
}
BoxLib::theWorkQueue().wait();
}
void
ABecLaplacian::Fapply (MultiFab& y,
const MultiFab& x,
int level)
{
const BoxArray& bxa = gbox[level];
const MultiFab& a = aCoefficients(level);
D_TERM(const MultiFab& bX = bCoefficients(0,level);,
const MultiFab& bY = bCoefficients(1,level);,
const MultiFab& bZ = bCoefficients(2,level););
const int nc = y.nComp();
for (MFIter ymfi(y); ymfi.isValid(); ++ymfi)
{
BL_ASSERT(bxa[ymfi.index()] == ymfi.validbox());
#if (BL_SPACEDIM == 2)
FORT_ADOTX(y[ymfi].dataPtr(),
ARLIM(y[ymfi].loVect()),ARLIM(y[ymfi].hiVect()),
x[ymfi].dataPtr(),
ARLIM(x[ymfi].loVect()), ARLIM(x[ymfi].hiVect()),
&alpha, &beta, a[ymfi].dataPtr(),
ARLIM(a[ymfi].loVect()), ARLIM(a[ymfi].hiVect()),
bX[ymfi].dataPtr(),
ARLIM(bX[ymfi].loVect()), ARLIM(bX[ymfi].hiVect()),
bY[ymfi].dataPtr(),
ARLIM(bY[ymfi].loVect()), ARLIM(bY[ymfi].hiVect()),
ymfi.validbox().loVect(), ymfi.validbox().hiVect(), &nc,
h[level]);
#endif
#if (BL_SPACEDIM ==3)
FORT_ADOTX(y[ymfi].dataPtr(),
ARLIM(y[ymfi].loVect()), ARLIM(y[ymfi].hiVect()),
x[ymfi].dataPtr(),
ARLIM(x[ymfi].loVect()), ARLIM(x[ymfi].hiVect()),
&alpha, &beta, a[ymfi].dataPtr(),
ARLIM(a[ymfi].loVect()), ARLIM(a[ymfi].hiVect()),
bX[ymfi].dataPtr(),
ARLIM(bX[ymfi].loVect()), ARLIM(bX[ymfi].hiVect()),
bY[ymfi].dataPtr(),
ARLIM(bY[ymfi].loVect()), ARLIM(bY[ymfi].hiVect()),
bZ[ymfi].dataPtr(),
ARLIM(bZ[ymfi].loVect()), ARLIM(bZ[ymfi].hiVect()),
ymfi.validbox().loVect(), ymfi.validbox().hiVect(), &nc,
h[level]);
#endif
}
}
ccseapps-2.5/CCSEApps/mglib/MultiGrid.cpp 0000644 0001750 0001750 00000042327 11634153073 021365 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: MultiGrid.cpp,v 1.32 2003/03/12 21:03:32 lijewski Exp $
//
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
bool MultiGrid::initialized = false;
int MultiGrid::def_nu_0 = 1;
int MultiGrid::def_nu_1 = 2;
int MultiGrid::def_nu_2 = 2;
int MultiGrid::def_nu_f = 8;
int MultiGrid::def_maxiter = 40;
int MultiGrid::def_maxiter_b = 80;
int MultiGrid::def_numiter = -1;
int MultiGrid::def_verbose = 0;
int MultiGrid::def_usecg = 1;
#ifndef CG_USE_OLD_CONVERGENCE_CRITERIA
Real MultiGrid::def_rtol_b = 0.001;
#else
Real MultiGrid::def_rtol_b = 0.01;
#endif
Real MultiGrid::def_atol_b = -1.0;
int MultiGrid::def_nu_b = 0;
int MultiGrid::def_numLevelsMAX = 1024;
int MultiGrid::def_smooth_on_cg_unstable = 0;
CGSolver::Solver MultiGrid::def_cg_solver = CGSolver::BiCGStab;
static
Real
norm_inf (const MultiFab& res)
{
Real restot = 0.0;
for (MFIter mfi(res); mfi.isValid(); ++mfi)
{
restot = std::max(restot, res[mfi].norm(mfi.validbox(), 0));
}
ParallelDescriptor::ReduceRealMax(restot);
return restot;
}
static
void
Spacer (std::ostream& os, int lev)
{
for (int k = 0; k < lev; k++)
{
os << " ";
}
}
void
MultiGrid::initialize ()
{
ParmParse pp("mg");
initialized = true;
pp.query("maxiter", def_maxiter);
pp.query("maxiter_b", def_maxiter_b);
pp.query("numiter", def_numiter);
pp.query("nu_0", def_nu_0);
pp.query("nu_1", def_nu_1);
pp.query("nu_2", def_nu_2);
pp.query("nu_f", def_nu_f);
pp.query("v", def_verbose);
pp.query("verbose", def_verbose);
pp.query("usecg", def_usecg);
pp.query("rtol_b", def_rtol_b);
pp.query("bot_atol", def_atol_b);
pp.query("nu_b", def_nu_b);
pp.query("numLevelsMAX", def_numLevelsMAX);
pp.query("smooth_on_cg_unstable", def_smooth_on_cg_unstable);
int ii;
if (pp.query("cg_solver", ii ))
{
switch (ii)
{
case 0: def_cg_solver = CGSolver::CG; break;
case 1: def_cg_solver = CGSolver::BiCGStab; break;
case 2: def_cg_solver = CGSolver::CG_Alt; break;
default:
BoxLib::Error("MultiGrid::initialize(): bad cg_solver value");
}
}
if (ParallelDescriptor::IOProcessor() && def_verbose)
{
std::cout << "MultiGrid settings...\n";
std::cout << " def_nu_0 = " << def_nu_0 << '\n';
std::cout << " def_nu_1 = " << def_nu_1 << '\n';
std::cout << " def_nu_2 = " << def_nu_2 << '\n';
std::cout << " def_nu_f = " << def_nu_f << '\n';
std::cout << " def_maxiter = " << def_maxiter << '\n';
std::cout << " def_usecg = " << def_usecg << '\n';
std::cout << " def_maxiter_b = " << def_maxiter_b << '\n';
std::cout << " def_rtol_b = " << def_rtol_b << '\n';
std::cout << " def_atol_b = " << def_atol_b << '\n';
std::cout << " def_nu_b = " << def_nu_b << '\n';
std::cout << " def_numLevelsMAX = " << def_numLevelsMAX << '\n';
std::cout << " def_smooth_on_cg_unstable = " << def_smooth_on_cg_unstable << '\n';
std::cout << " def_cg_solver = " << def_cg_solver << '\n';
}
}
MultiGrid::MultiGrid (LinOp &_Lp)
:
initialsolution(0),
Lp(_Lp)
{
if (!initialized)
initialize();
maxiter = def_maxiter;
numiter = def_numiter;
nu_0 = def_nu_0;
nu_1 = def_nu_1;
nu_2 = def_nu_2;
nu_f = def_nu_f;
usecg = def_usecg;
verbose = def_verbose;
maxiter_b = def_maxiter_b;
rtol_b = def_rtol_b;
atol_b = def_atol_b;
nu_b = def_nu_b;
numLevelsMAX = def_numLevelsMAX;
smooth_on_cg_unstable = def_smooth_on_cg_unstable;
cg_solver = def_cg_solver;
numlevels = numLevels();
if ( ParallelDescriptor::IOProcessor() && verbose == 1 )
{
BoxArray tmp = Lp.boxArray();
std::cout << "MultiGrid: numlevels = " << numlevels
<< ": ngrid = " << tmp.size() << ", npts = [";
for ( int i = 0; i < numlevels; ++i )
{
if ( i > 0 ) tmp.coarsen(2);
std::cout << tmp.numPts() << " ";
}
std::cout << "]" << std::endl;
}
if ( ParallelDescriptor::IOProcessor() && verbose > 2 )
{
std::cout << "MultiGrid: " << numlevels
<< " multigrid levels created for this solve" << '\n';
std::cout << "Grids: " << '\n';
BoxArray tmp = Lp.boxArray();
for (int i = 0; i < numlevels; ++i)
{
if (i > 0)
tmp.coarsen(2);
std::cout << " Level: " << i << '\n';
for (int k = 0; k < tmp.size(); k++)
{
const Box& b = tmp[k];
std::cout << " [" << k << "]: " << b << " ";
for (int j = 0; j < BL_SPACEDIM; j++)
std::cout << b.length(j) << ' ';
std::cout << '\n';
}
}
}
}
MultiGrid::~MultiGrid ()
{
delete initialsolution;
for (int i = 0; i < cor.size(); ++i)
{
delete res[i];
delete rhs[i];
delete cor[i];
}
}
Real
MultiGrid::errorEstimate (int level,
LinOp::BC_Mode bc_mode)
{
Lp.residual(*res[level], *rhs[level], *cor[level], level, bc_mode);
return norm_inf(*res[level]);
}
void
MultiGrid::prepareForLevel (int level)
{
//
// Build this level by allocating reqd internal MultiFabs if necessary.
//
if (cor.size() > level) return;
res.resize(level+1, (MultiFab*)0);
rhs.resize(level+1, (MultiFab*)0);
cor.resize(level+1, (MultiFab*)0);
Lp.prepareForLevel(level);
if (cor[level] == 0)
{
res[level] = new MultiFab(Lp.boxArray(level), 1, 1, Fab_allocate);
rhs[level] = new MultiFab(Lp.boxArray(level), 1, 1, Fab_allocate);
cor[level] = new MultiFab(Lp.boxArray(level), 1, 1, Fab_allocate);
if (level == 0)
{
initialsolution = new MultiFab(Lp.boxArray(0), 1, 1, Fab_allocate);
}
}
}
void
MultiGrid::residualCorrectionForm (MultiFab& resL,
const MultiFab& rhsL,
MultiFab& solnL,
const MultiFab& inisol,
LinOp::BC_Mode bc_mode,
int level)
{
//
// Using the linearity of the operator, Lp, we can solve this system
// instead by solving for the correction required to the initial guess.
//
initialsolution->copy(inisol);
solnL.copy(inisol);
Lp.residual(resL, rhsL, solnL, level, bc_mode);
solnL.setVal(0.0);
}
void
MultiGrid::solve (MultiFab& _sol,
const MultiFab& _rhs,
Real _eps_rel,
Real _eps_abs,
LinOp::BC_Mode bc_mode)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::solve()");
//
// Prepare memory for new level, and solve the general boundary
// value problem to within relative error _eps_rel. Customized
// to solve at level=0.
//
const int level = 0;
prepareForLevel(level);
residualCorrectionForm(*rhs[level],_rhs,*cor[level],_sol,bc_mode,level);
if (!solve_(_sol, _eps_rel, _eps_abs, LinOp::Homogeneous_BC, level))
{
BoxLib::Error("MultiGrid:: failed to converge!");
}
}
int
MultiGrid::solve_ (MultiFab& _sol,
Real eps_rel,
Real eps_abs,
LinOp::BC_Mode bc_mode,
int level)
{
//
// Relax system maxiter times, stop if relative error <= _eps_rel or
// if absolute err <= _abs_eps
//
int returnVal = 0;
const Real error0 = errorEstimate(level, bc_mode);
Real error = error0;
if (ParallelDescriptor::IOProcessor() && verbose)
{
Spacer(std::cout, level);
std::cout << "MultiGrid: Initial error (error0) = " << error0 << '\n';
}
if (ParallelDescriptor::IOProcessor() && eps_rel < 1.0e-16 && eps_rel > 0)
{
std::cout << "MultiGrid: Tolerance "
<< eps_rel
<< " < 1e-16 is probably set too low" << '\n';
}
//
// Initialize correction to zero at this level (auto-filled at levels below)
//
(*cor[level]).setVal(0.0);
//
// Note: if eps_rel, eps_abs < 0 then that test is effectively bypassed
//
const Real norm_rhs = norm_inf(*rhs[level]);
const Real norm_Lp = Lp.norm(0, level);
const Real new_error_0 = norm_rhs;
Real norm_cor = 0.0;
int nit = 1;
for ( ;
error > eps_abs &&
error > eps_rel*(norm_Lp*norm_cor+norm_rhs) &&
nit <= maxiter;
++nit)
{
relax(*cor[level], *rhs[level], level, eps_rel, eps_abs, bc_mode);
norm_cor = norm_inf(*cor[level]);
error = errorEstimate(level, bc_mode);
if (ParallelDescriptor::IOProcessor() && verbose > 1 )
{
const Real rel_error = (error0 != 0) ? error/new_error_0 : 0;
Spacer(std::cout, level);
std::cout << "MultiGrid: Iteration "
<< nit
<< " error/error0 "
<< rel_error << '\n';
}
}
if ( ParallelDescriptor::IOProcessor() && verbose )
{
const Real rel_error = (error0 != 0) ? error/error0 : 0;
Spacer(std::cout, level);
std::cout << "MultiGrid: iterations(" << nit
<< ") rel_error( " << rel_error << ")" << std::endl;
}
if ( nit == numiter ||
error <= eps_rel*(norm_Lp*norm_cor+norm_rhs) ||
error <= eps_abs )
{
//
// Omit ghost update since maybe not initialized in calling routine.
// Add to boundary values stored in initialsolution.
//
_sol.copy(*cor[level]);
_sol.plus(*initialsolution,0,_sol.nComp(),0);
returnVal = 1;
}
//
// Otherwise, failed to solve satisfactorily
//
return returnVal;
}
int
MultiGrid::numLevels () const
{
int ng = Lp.numGrids();
int lv = numLevelsMAX;
//
// The routine `falls through' since coarsening and refining
// a unit box does not yield the initial box.
//
const BoxArray& bs = Lp.boxArray(0);
for (int i = 0; i < ng; ++i)
{
int llv = 0;
Box tmp = bs[i];
for (;;)
{
Box ctmp = tmp; ctmp.coarsen(2);
Box rctmp = ctmp; rctmp.refine(2);
if (tmp != rctmp || ctmp.numPts() == 1)
break;
llv++;
tmp = ctmp;
}
//
// Set number of levels so that every box can be refined to there.
//
if (lv >= llv)
lv = llv;
}
return lv+1; // Including coarsest.
}
void
MultiGrid::relax (MultiFab& solL,
MultiFab& rhsL,
int level,
Real eps_rel,
Real eps_abs,
LinOp::BC_Mode bc_mode)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::relax()");
//
// Recursively relax system. Equivalent to multigrid V-cycle.
// At coarsest grid, call coarsestSmooth.
//
if (level < numlevels - 1 )
{
for (int i = preSmooth() ; i > 0 ; i--)
{
Lp.smooth(solL, rhsL, level, bc_mode);
}
Lp.residual(*res[level], rhsL, solL, level, bc_mode);
prepareForLevel(level+1);
average(*rhs[level+1], *res[level]);
cor[level+1]->setVal(0.0);
for (int i = cntRelax(); i > 0 ; i--)
{
relax(*cor[level+1],*rhs[level+1],level+1,eps_rel,eps_abs,bc_mode);
}
interpolate(solL, *cor[level+1]);
for (int i = postSmooth(); i > 0 ; i--)
{
Lp.smooth(solL, rhsL, level, bc_mode);
}
}
else
{
coarsestSmooth(solL, rhsL, level, eps_rel, eps_abs, bc_mode, usecg);
}
}
void
MultiGrid::coarsestSmooth (MultiFab& solL,
MultiFab& rhsL,
int level,
Real eps_rel,
Real eps_abs,
LinOp::BC_Mode bc_mode,
int local_usecg)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "coarsestSmooth()");
prepareForLevel(level);
if (local_usecg == 0)
{
Real error0;
if (verbose)
{
error0 = errorEstimate(level, bc_mode);
if (ParallelDescriptor::IOProcessor())
std::cout << " Bottom Smoother: Initial error (error0) = "
<< error0 << '\n';
}
for (int i = finalSmooth(); i > 0; i--)
{
Lp.smooth(solL, rhsL, level, bc_mode);
if (verbose > 1 || (i == 1 && verbose))
{
Real error = errorEstimate(level, bc_mode);
const Real rel_error = (error0 != 0) ? error/error0 : 0;
if (ParallelDescriptor::IOProcessor())
std::cout << " Bottom Smoother: Iteration "
<< i
<< " error/error0 "
<< rel_error << '\n';
}
}
}
else
{
bool use_mg_precond = false;
CGSolver cg(Lp, use_mg_precond, level);
cg.setExpert(true);
cg.setMaxIter(maxiter_b);
int ret = cg.solve(solL, rhsL, rtol_b, atol_b, bc_mode, cg_solver);
if (ret != 0)
{
if (smooth_on_cg_unstable)
{
//
// If the CG solver returns a nonzero value indicating
// the problem is unstable. Assume this is not an accuracy
// issue and pound on it with the smoother.
//
if (ParallelDescriptor::IOProcessor() && def_verbose)
{
std::cout << "MultiGrid::coarsestSmooth(): CGSolver returns nonzero. Smoothing...." << std::endl;
}
coarsestSmooth(solL, rhsL, level, eps_rel, eps_abs, bc_mode, 0);
}
else
{
//
// cg failure probably indicates loss of precision accident.
// setting solL to 0 should be ok.
//
solL.setVal(0);
if (ParallelDescriptor::IOProcessor() && def_verbose)
{
std::cout << "MultiGrid::coarsestSmooth(): setting coarse corr to zero" << std::endl;
}
}
}
for (int i = 0; i < nu_b; i++)
{
Lp.smooth(solL, rhsL, level, bc_mode);
}
}
}
void
MultiGrid::average (MultiFab& c,
const MultiFab& f)
{
//
// Use Fortran function to average down (restrict) f to c.
//
for (MFIter cmfi(c); cmfi.isValid(); ++cmfi)
{
BL_ASSERT(c.boxArray().get(cmfi.index()) == cmfi.validbox());
const Box& bx = cmfi.validbox();
int nc = c.nComp();
FORT_AVERAGE(c[cmfi].dataPtr(),
ARLIM(c[cmfi].loVect()), ARLIM(c[cmfi].hiVect()),
f[cmfi].dataPtr(),
ARLIM(f[cmfi].loVect()), ARLIM(f[cmfi].hiVect()),
bx.loVect(), bx.hiVect(), &nc);
}
}
void
MultiGrid::interpolate (MultiFab& f,
const MultiFab& c)
{
//
// Use fortran function to interpolate up (prolong) c to f
// Note: returns f=f+P(c) , i.e. ADDS interp'd c to f.
//
for (MFIter fmfi(f); fmfi.isValid(); ++fmfi)
{
const Box& bx = c.boxArray()[fmfi.index()];
int nc = f.nComp();
FORT_INTERP(f[fmfi].dataPtr(),
ARLIM(f[fmfi].loVect()), ARLIM(f[fmfi].hiVect()),
c[fmfi].dataPtr(),
ARLIM(c[fmfi].loVect()), ARLIM(c[fmfi].hiVect()),
bx.loVect(), bx.hiVect(), &nc);
}
}
ccseapps-2.5/CCSEApps/mglib/GNUmakefile 0000644 0001750 0001750 00000003567 11634153073 021036 0 ustar amckinstry amckinstry #
# $Id: GNUmakefile,v 1.8 2000/06/01 20:59:38 car Exp $
#
PBOXLIB_HOME = ..
TOP = $(PBOXLIB_HOME)
PRECISION = DOUBLE
DEBUG = TRUE
DIM = 3
COMP = KCC
USE_MPI = TRUE
#
# The base name of the library we're building.
#
LBASE = mg
#
# Where libraries and include files will be installed.
#
INSTALL_ROOT = $(TOP)
include $(TOP)/mk/Make.defs Make.package
INCLUDE_LOCATIONS += $(TOP)/include
#
# Libraries to close against.
#
ifeq ($(COMP), KCC)
LibsToCloseAgainst := $(TOP)/lib/$(machineSuffix)/libamr$(DIM)d.a
LibsToCloseAgainst += $(TOP)/lib/$(machineSuffix)/libbndry$(DIM)d.a
LibsToCloseAgainst += $(TOP)/lib/$(machineSuffix)/libbox$(DIM)d.a
endif
all: $(optionsLib)
include $(TOP)/mk/Make.rules
#
# Temp stuff for doing html docs.
#
_docHeaders := $(sort $(wildcard *.H))
_htmlDir := html
#
# This will make the HTML files in the directory html provided
# any of the relevant .H files have changed more recently than the
# directory itself.
#
html: $(_docHeaders)
-if `doc++ -h > /dev/null` ; then \
$(RM) -r $(_htmlDir); \
mkdir -p $(_htmlDir); \
doc++ -f -j -B Banner.html -d $(_htmlDir) $(_docHeaders); \
fi
MgLib.tex: $(_docHeaders)
-if `doc++ -h > /dev/null` ; then \
doc++ -f -t -j -o MgLib.tex -ep docxx_squish $(_docHeaders); \
sed '/[\]usepackage[{]docxx[}]/d' < MgLib.tex > .junk; \
mv .junk MgLib.tex; \
fi
MgLib.dvi: MgLib.tex
latex MgLib.tex; latex MgLib.tex
MgLib.ps: MgLib.dvi
dvips MgLib.dvi -o MgLib.ps
#
# Install the PostScript file into $(INSTALL_ROOT)/ps
#
install_ps: MgLib.ps
-if [ ! -d $(INSTALL_ROOT)/ps ]; then \
mkdir -p $(INSTALL_ROOT)/ps; \
chmod 755 $(INSTALL_ROOT)/ps; \
fi
$(INSTALL_DATA) MgLib.ps $(INSTALL_ROOT)/ps
ccseapps-2.5/CCSEApps/mglib/Mask.cpp 0000644 0001750 0001750 00000012161 11634153073 020351 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: Mask.cpp,v 1.6 2001/08/01 21:51:04 lijewski Exp $
//
#include
#include
#include
#include
const char NL = '\n';
const char SP = ' ';
Mask::Mask (std::istream& is)
{
readFrom(is);
}
std::ostream&
operator<< (std::ostream& os,
const Mask& m)
{
int ncomp = m.nComp();
os << "(Mask: " << m.box() << SP << ncomp << NL;
IntVect sm = m.box().smallEnd();
IntVect bg = m.box().bigEnd();
for (IntVect p = sm; p <= bg; m.box().next(p))
{
os << p;
for (int k = 0; k < ncomp; k++)
os << " " << m(p,k);
os << NL;
}
os << ")\n";
BL_ASSERT(os.good());
return os;
}
std::istream&
operator>> (std::istream& is,
Mask& m)
{
is.ignore(BL_IGNORE_MAX,':');
Box b;
int ncomp;
is >> b >> ncomp;
is.ignore(BL_IGNORE_MAX, '\n');
m.resize(b,ncomp);
IntVect sm = b.smallEnd();
IntVect bg = b.bigEnd();
IntVect q;
for (IntVect p = sm; p <= bg; b.next(p))
{
is >> q;
BL_ASSERT( p == q);
for( int k=0; k> m(p,k);
is.ignore(BL_IGNORE_MAX, '\n');
}
is.ignore(BL_IGNORE_MAX,'\n');
BL_ASSERT(is.good());
return is;
}
void
Mask::writeOn (std::ostream& os) const
{
os << "(Mask: " << domain << SP << nvar << NL;
const int* ptr = dataPtr();
int len = domain.numPts();
os.write( (char*) ptr, len*sizeof(int) );
os << ")\n";
}
void
Mask::readFrom (std::istream& is)
{
is.ignore(BL_IGNORE_MAX,':');
Box b;
int ncomp;
is >> b >> ncomp;
is.ignore(BL_IGNORE_MAX, '\n');
resize(b,ncomp);
int *ptr = dataPtr();
int len = domain.numPts();
is.read( (char*) ptr, len*sizeof(int) );
is.ignore(BL_IGNORE_MAX, '\n');
}
Mask&
Mask::And (const Mask& src)
{
ForAllThisXC(int,src) {
thisR = (thisR ? srcR : 0);
} EndForTX;
return *this;
}
Mask&
Mask::And (const Mask& src,
int srccomp,
int destcomp,
int numcomp)
{
Box domain(box());
ForAllThisBNNXC(int,domain,destcomp,numcomp,src,srccomp) {
thisR = (thisR ? srcR : 0);
} EndForTX;
return *this;
}
Mask&
Mask::And (const Mask& src,
const Box& subbox,
int srccomp,
int destcomp,
int numcomp)
{
ForAllThisBNNXC(int,subbox,destcomp,numcomp,src,srccomp) {
thisR = (thisR ? srcR : 0);
} EndForTX;
return *this;
}
Mask&
Mask::And (const Mask& src,
const Box& srcbox,
const Box& destbox,
int srccomp,
int destcomp,
int numcomp)
{
ForAllThisBNNXCBN(int,destbox,destcomp,numcomp,src,srcbox,srccomp) {
thisR = (thisR ? srcR : 0);
} EndForTX;
return *this;
}
Mask&
Mask::Or (const Mask& src)
{
ForAllThisXC(int,src) {
thisR = (thisR ? 1 : srcR);
} EndForTX;
return *this;
}
Mask&
Mask::Or (const Mask& src,
int srccomp,
int destcomp,
int numcomp)
{
Box domain(box());
ForAllThisBNNXC(int,domain,destcomp,numcomp,src,srccomp) {
thisR = (thisR ? 1 : srcR);
} EndForTX;
return *this;
}
Mask&
Mask::Or (const Mask& src,
const Box& subbox,
int srccomp,
int destcomp,
int numcomp)
{
ForAllThisBNNXC(int,subbox,destcomp,numcomp,src,srccomp) {
thisR = (thisR ? 1 : srcR);
} EndForTX;
return *this;
}
Mask&
Mask::Or (const Mask& src,
const Box& srcbox,
const Box& destbox,
int srccomp,
int destcomp,
int numcomp)
{
ForAllThisBNNXCBN(int,destbox,destcomp,numcomp,src,srcbox,srccomp) {
thisR = (thisR ? 1 : srcR);
} EndForTX;
return *this;
}
ccseapps-2.5/CCSEApps/mglib/LP_2D.F 0000644 0001750 0001750 00000016744 11634153073 017734 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: LP_2D.F,v 1.5 2002/08/29 22:14:39 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
#include
#include "LP_F.H"
#include "ArrayLim.H"
c-----------------------------------------------------------------------
c
c Gauss-Seidel Red-Black (GSRB):
c Apply the GSRB relaxation to the state phi for the equation
c L(phi) = Div(Grad(phi(x))) = rhs(x) central differenced, according
c to the arrays of boundary masks (m#) and auxiliary data (f#).
c
c In general, if the linear operator L=gamma*y-rho, the GS relaxation
c is y = (R - rho)/gamma. Near a boundary, the ghost data is filled
c using a polynomial interpolant based on the "old" phi values, so
c L=(gamma-delta)*y - rho + delta*yOld. The resulting iteration is
c
c y = (R - delta*yOld + rho)/(gamma - delta)
c
c This expression is valid additionally in the interior provided
c delta->0 there. delta is constructed by summing all the
c contributions to the central stencil element coming from boundary
c interpolants. The f#s contain the corresponding coefficient of
c the interpolating polynomial. The masks are set > 0 if the boundary
c value was filled with an interpolant involving the central stencil
c element.
c
c-----------------------------------------------------------------------
subroutine FORT_GSRB (
$ phi, DIMS(phi),
$ rhs, DIMS(rhs),
$ f0, DIMS(f0), m0, DIMS(m0),
$ f1, DIMS(f1), m1, DIMS(m1),
$ f2, DIMS(f2), m2, DIMS(m2),
$ f3, DIMS(f3), m3, DIMS(m3),
$ lo, hi, nc,
$ h, redblack
$ )
integer nc
integer DIMDEC(phi)
REAL_T phi(DIMV(phi),nc)
integer DIMDEC(rhs)
REAL_T rhs(DIMV(rhs),nc)
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM)
integer DIMDEC(f0)
integer DIMDEC(f1)
integer DIMDEC(f2)
integer DIMDEC(f3)
REAL_T f0(DIMV(f0))
REAL_T f1(DIMV(f1))
REAL_T f2(DIMV(f2))
REAL_T f3(DIMV(f3))
integer DIMDEC(m0)
integer DIMDEC(m1)
integer DIMDEC(m2)
integer DIMDEC(m3)
integer m0(DIMV(m0))
integer m1(DIMV(m1))
integer m2(DIMV(m2))
integer m3(DIMV(m3))
integer redblack
REAL_T h
c
integer i, j, ioff, n
c
REAL_T cf0, cf1, cf2, cf3
REAL_T delta, gamma, rho
c
gamma = 4.0D0
do n = 1, nc
do j = lo(2), hi(2)
ioff = MOD(j + redblack,2)
do i = lo(1) + ioff,hi(1),2
c
cf0 = cvmgt(f0(lo(1),j), 0.0D0,
$ (i .eq. lo(1)) .and. (m0(lo(1)-1,j).gt.0))
cf1 = cvmgt(f1(i,lo(2)), 0.0D0,
$ (j .eq. lo(2)) .and. (m1(i,lo(2)-1).gt.0))
cf2 = cvmgt(f2(hi(1),j), 0.0D0,
$ (i .eq. hi(1)) .and. (m2(hi(1)+1,j).gt.0))
cf3 = cvmgt(f3(i,hi(2)), 0.0D0,
$ (j .eq. hi(2)) .and. (m3(i,hi(2)+1).gt.0))
c
delta = cf0 + cf1 + cf2 + cf3
c
rho = phi(i-1,j,n) + phi(i+1,j,n)
$ + phi(i,j-1,n) + phi(i,j+1,n)
c
phi(i,j,n) = (rhs(i,j,n)*h*h - rho + phi(i,j,n)*delta)
$ / (delta - gamma)
c
end do
end do
end do
end
c-----------------------------------------------------------------------
c
c Solve Preconditioned system here
c
subroutine FORT_CGPRECND(
$ zz, DIMS(zz),
$ rho,
$ rr, DIMS(rr),
$ lo, hi, nc,
$ h
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(zz)
REAL_T zz(DIMV(zz),nc)
integer DIMDEC(rr)
REAL_T rr(DIMV(rr),nc)
REAL_T h
REAL_T rho
c
integer i
integer j
integer n
REAL_T denom
c
rho = 0.0D0
denom = -h**2/4.0D0
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
zz(i,j,n) = rr(i,j,n)*denom
rho = rho + zz(i,j,n)*rr(i,j,n)
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c Fill in a matrix x vector operator here
c
subroutine FORT_ADOTX(
$ y, DIMS(y),
$ x, DIMS(x),
$ lo, hi, nc,
$ h
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(y)
REAL_T y(DIMV(y),nc)
integer DIMDEC(x)
REAL_T x(DIMV(x),nc)
REAL_T h
c
integer i, j, n
REAL_T scal
c
scal = 1.0D0/h**2
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
y(i,j,n) = scal*
$ ( x(i-1,j,n) + x(i+1,j,n)
$ + x(i,j-1,n) + x(i,j+1,n)
$ - 4*x(i,j,n) )
end do
end do
end do
c
end
c-----------------------------------------------------------------------
subroutine FORT_ESTANORM(
& lo, hi, nc,
& h
& )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer i, j, n
REAL_T h,res
c
res = 8.0D0/h**2
end
c-----------------------------------------------------------------------
c
c Fill in fluxes
c
subroutine FORT_FLUX(
$ x,DIMS(x),
$ lo,hi,nc,
$ h,
$ xflux,DIMS(xflux),
$ yflux,DIMS(yflux)
$ )
implicit none
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(x)
integer DIMDEC(xflux)
integer DIMDEC(yflux)
REAL_T x(DIMV(x),nc)
REAL_T xflux(DIMV(xflux),nc)
REAL_T yflux(DIMV(yflux),nc)
REAL_T h(BL_SPACEDIM)
c
REAL_T dhx, dhy
integer i,j,n
c
dhx = one/h(1)
dhy = one/h(2)
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)+1
xflux(i,j,n) = - dhx*( x(i,j,n) - x(i-1,j,n) )
end do
end do
end do
do n = 1, nc
do j = lo(2), hi(2)+1
do i = lo(1), hi(1)
yflux(i,j,n) = - dhy*( x(i,j,n) - x(i,j-1,n) )
end do
end do
end do
end
ccseapps-2.5/CCSEApps/mglib/LO_BCTYPES.H 0000644 0001750 0001750 00000002721 11634153073 020567 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _LO_BCTYPES_H_
#define _LO_BCTYPES_H_
/*
* $Id: LO_BCTYPES.H,v 1.1 1998/03/24 07:06:14 almgren Exp $
*/
#define LO_DIRICHLET 101
#define LO_NEUMANN 102
#define LO_REFLECT_ODD 103
#endif
ccseapps-2.5/CCSEApps/mglib/CGSolver.cpp 0000644 0001750 0001750 00000065675 11634153073 021164 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: CGSolver.cpp,v 1.32 2003/03/12 21:03:32 lijewski Exp $
//
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
int CGSolver::initialized = 0;
int CGSolver::def_maxiter = 40;
int CGSolver::def_verbose = 0;
CGSolver::Solver CGSolver::def_cg_solver = BiCGStab;
double CGSolver::def_unstable_criterion = 10.;
static
void
Spacer (std::ostream& os, int lev)
{
for (int k = 0; k < lev; k++)
{
os << " ";
}
}
void
CGSolver::initialize ()
{
ParmParse pp("cg");
pp.query("maxiter", def_maxiter);
pp.query("v", def_verbose);
pp.query("verbose", def_verbose);
pp.query("unstable_criterion",def_unstable_criterion);
int ii;
if (pp.query("cg_solver", ii))
{
switch (ii)
{
case 0: def_cg_solver = CG; break;
case 1: def_cg_solver = BiCGStab; break;
case 2: def_cg_solver = CG_Alt; break;
default:
BoxLib::Error("CGSolver::initialize(): bad cg_solver");
}
}
if (ParallelDescriptor::IOProcessor() && def_verbose)
{
std::cout << "CGSolver settings...\n";
std::cout << " def_maxiter = " << def_maxiter << '\n';
std::cout << " def_unstable_criterion = " << def_unstable_criterion << '\n';
std::cout << " def_cg_solver = " << def_cg_solver << '\n';
}
initialized = 1;
}
CGSolver::CGSolver (LinOp& _Lp,
bool _use_mg_precond,
int _lev)
:
isExpert(false),
Lp(_Lp),
mg_precond(0),
lev(_lev),
use_mg_precond(_use_mg_precond)
{
if (!initialized)
initialize();
maxiter = def_maxiter;
verbose = def_verbose;
cg_solver = def_cg_solver;
set_mg_precond();
}
void
CGSolver::set_mg_precond ()
{
delete mg_precond;
if (use_mg_precond)
{
mg_precond = new MultiGrid(Lp);
mg_precond->setNumIter(1);
}
}
CGSolver::~CGSolver ()
{
delete mg_precond;
}
static
Real
norm_inf (const MultiFab& res)
{
Real restot = 0.0;
for (MFIter mfi(res); mfi.isValid(); ++mfi)
{
restot = std::max(restot, res[mfi].norm(mfi.validbox(), 0));
}
ParallelDescriptor::ReduceRealMax(restot);
return restot;
}
int
CGSolver::solve (MultiFab& sol,
const MultiFab& rhs,
Real eps_rel,
Real eps_abs,
LinOp::BC_Mode bc_mode,
Solver solver)
{
if ( solver == Automatic ) solver = cg_solver;
if ( solver == CG ) return solve_cg(sol, rhs, eps_rel, eps_abs, bc_mode);
if ( solver == BiCGStab ) return solve_bicgstab(sol, rhs, eps_rel, eps_abs, bc_mode);
if ( solver == CG_Alt ) return solve_00(sol, rhs, eps_rel, eps_abs, bc_mode);
return solve_00(sol, rhs, eps_rel, eps_abs, bc_mode);
}
int
CGSolver::solve_00 (MultiFab& sol,
const MultiFab& rhs,
Real eps_rel,
Real eps_abs,
LinOp::BC_Mode bc_mode)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::solve_00()");
//
// algorithm:
//
// k=0;r=rhs-A*soln_0;
// while (||r_k||^2_2 > eps^2*||r_o||^2_2 && k < maxiter {
// k++
// solve Mz_k-1 = r_k-1 (if preconditioning, else z_k-1 = r_k-1)
// rho_k-1 = r_k-1^T z_k-1
// if (k=1) { p_1 = z_0 }
// else { beta = rho_k-1/rho_k-2; p = z + beta*p }
// w = Ap
// alpha = rho_k-1/p^tw
// x += alpha p
// r -= alpha w
// }
//
BL_ASSERT(sol.boxArray() == Lp.boxArray(lev));
BL_ASSERT(rhs.boxArray() == Lp.boxArray(lev));
int nghost = 1; int ncomp = sol.nComp();
MultiFab* s = new MultiFab(sol.boxArray(), ncomp, nghost, Fab_allocate);
MultiFab* r = new MultiFab(sol.boxArray(), ncomp, nghost, Fab_allocate);
MultiFab* z = new MultiFab(sol.boxArray(), ncomp, nghost, Fab_allocate);
MultiFab* w = new MultiFab(sol.boxArray(), ncomp, nghost, Fab_allocate);
MultiFab* p = new MultiFab(sol.boxArray(), ncomp, nghost, Fab_allocate);
//
// Copy initial guess into a temp multifab guaranteed to have ghost cells.
//
int srccomp=0; int destcomp=0; ncomp=1; nghost=0;
s->copy(sol,srccomp,destcomp,ncomp);
/*
This routine assumes the LinOp is linear, and that when bc_mode =
LinOp::Homogeneous_BC, LinOp::apply() on a zero vector will return a zero
vector. Given that, we define the problem we solve here from the
original equation:
Lp(sol) = rhs --> Lp(s) + Lp(sol,bc_mode=LinOp::Homogeneous_BC) = rhs
where s is set to the incoming solution guess. Rewriting,
Lp(sol,bc_mode=LinOp::Homogeneous_BC) = r [ = rhs - Lp(s) ].
CG needs the residual of this equation on our initial guess. But
because we made the above assumption,
r - Lp(sol,bc_mode=LinOp::Homogeneous_BC) = r = rhs - Lp(s)
Which is simply the residual of the original equation evaluated at
the initial guess. Thus we get by with only one call to Lp.residual.
Without this assumption, we'd need two.
*/
Lp.residual((*r), rhs, (*s), lev, bc_mode);
//
// Set initial guess for correction to 0.
//
sol.setVal(0.0);
//
// Set bc_mode=homogeneous
//
LinOp::BC_Mode temp_bc_mode=LinOp::Homogeneous_BC;
Real rnorm = norm_inf(*r);
Real rnorm0 = rnorm;
Real minrnorm = rnorm;
int ret = 0; // will return this value if all goes well
if (verbose > 0 && ParallelDescriptor::IOProcessor())
{
Spacer(std::cout, lev);
std::cout << "CGsolver: Initial error (error0) = " << rnorm0 << '\n';
}
Real beta, rho, rhoold = 0.0;
/*
The MultiFab copies used below to update z and p require nghost=0
to avoid the possibility of filling valid regions with uninitialized
data in the invalid regions of neighboring grids. The default
behavior in MultiFab copies will likely be changed in the future.
*/
//
// If eps_rel or eps_abs < 0: that test is effectively bypassed.
//
int nit = 1;
for (;
nit <= maxiter && rnorm > eps_rel*rnorm0 && rnorm > eps_abs;
++nit)
{
if (use_mg_precond)
{
//
// Solve Mz_k-1 = r_k-1 and rho_k-1 = r_k-1^T z_k-1
//
z->setVal(0.);
mg_precond->solve(*z, *r, eps_rel, eps_abs, temp_bc_mode);
}
else
{
//
// No preconditioner, z_k-1 = r_k-1 and rho_k-1 = r_k-1^T r_k-1.
//
srccomp=0; destcomp=0; ncomp=1;
z->copy((*r), srccomp, destcomp, ncomp);
}
rho = 0.0;
int ncomp = z->nComp();
const BoxArray& gbox = r->boxArray();
for (MFIter rmfi(*r); rmfi.isValid(); ++rmfi)
{
Real trho;
BL_ASSERT(rmfi.validbox() == gbox[rmfi.index()]);
FORT_CGXDOTY(&trho,(*z)[rmfi].dataPtr(),
ARLIM((*z)[rmfi].loVect()),ARLIM((*z)[rmfi].hiVect()),
(*r)[rmfi].dataPtr(),
ARLIM((*r)[rmfi].loVect()),ARLIM((*r)[rmfi].hiVect()),
rmfi.validbox().loVect(),rmfi.validbox().hiVect(),
&ncomp);
rho += trho;
}
ParallelDescriptor::ReduceRealSum(rho);
if (nit == 1)
{
//
// k=1, p_1 = z_0
//
srccomp=0; destcomp=0; ncomp=1; nghost=0;
p->copy(*z, srccomp, destcomp, ncomp);
}
else
{
//
// k>1, beta = rho_k-1/rho_k-2 and p = z + beta*p
//
beta = rho/rhoold;
advance(*p, beta, *z);
}
//
// w = Ap, and compute Transpose(p).w
//
Real pw = axp(*w, *p, temp_bc_mode);
//
// alpha = rho_k-1/p^tw
//
Real alpha;
if( pw != 0. ){
alpha = rho/pw;
}
else {
ret = 1;
break;
}
if (ParallelDescriptor::IOProcessor() && verbose > 2)
{
Spacer(std::cout, lev);
std::cout << "CGSolver_00:"
<< " nit " << nit
<< " pw " << pw
<< " rho " << rho
<< " alpha " << alpha;
if (nit == 1)
{
std::cout << " beta undefined ...";
}
else
{
std::cout << " beta " << beta << " ...";
}
}
//
// x += alpha p and r -= alpha w
//
rhoold = rho;
update(sol, alpha, *r, *p, *w);
rnorm = norm_inf(*r);
if (rnorm > def_unstable_criterion*minrnorm)
{
ret = 2;
break;
}
else if (rnorm < minrnorm)
{
minrnorm = rnorm;
}
if (ParallelDescriptor::IOProcessor())
{
if (verbose > 1 ||
(((eps_rel > 0. && rnorm < eps_rel*rnorm0) ||
(eps_abs > 0. && rnorm < eps_abs)) && verbose))
{
const Real rel_error = (rnorm0 != 0) ? rnorm/rnorm0 : 0;
Spacer(std::cout, lev);
std::cout << "CGSolver_00: Iteration "
<< std::setw(4) << nit
<< " error/error0 "
<< rel_error << '\n';
}
}
}
if (ParallelDescriptor::IOProcessor())
{
if (verbose > 0 ||
(((eps_rel > 0. && rnorm < eps_rel*rnorm0) ||
(eps_abs > 0. && rnorm < eps_abs)) && verbose))
{
const Real rel_error = (rnorm0 != 0) ? rnorm/rnorm0 : 0;
Spacer(std::cout, lev);
std::cout << "CGSolver_00: Final: Iteration "
<< std::setw(4) << nit
<< " error/error0 "
<< rel_error << '\n';
}
}
if (ret != 0 && isExpert == false)
{
BoxLib::Error("CGSolver_00:: apparent accuracy problem; try expert setting or change unstable_criterion");
}
if (ret==0 && rnorm > eps_rel*rnorm0 && rnorm > eps_abs)
{
BoxLib::Error("CGSolver_00:: failed to converge!");
}
//
// Omit ghost update since maybe not initialized in calling routine.
// BoxLib_1.99 has no MultiFab::plus(MultiFab&) member, which would
// operate only in valid regions; do explicitly. Add to boundary
// values stored in initialsolution.
//
if (ret == 0)
{
srccomp=0; ncomp=1; nghost=0;
sol.plus(*s,srccomp,ncomp,nghost);
}
delete s;
delete r;
delete w;
delete p;
delete z;
return ret;
}
void
CGSolver::advance (MultiFab& p,
Real beta,
const MultiFab& z)
{
//
// Compute p = z + beta p
//
const BoxArray& gbox = Lp.boxArray(lev);
int ncomp = p.nComp();
const BoxArray& zbox = z.boxArray();
for (MFIter pmfi(p); pmfi.isValid(); ++pmfi)
{
BL_ASSERT(zbox[pmfi.index()] == gbox[pmfi.index()]);
FORT_CGADVCP(p[pmfi].dataPtr(),
ARLIM(p[pmfi].loVect()), ARLIM(p[pmfi].hiVect()),
z[pmfi].dataPtr(),
ARLIM(z[pmfi].loVect()), ARLIM(z[pmfi].hiVect()),
&beta,
zbox[pmfi.index()].loVect(), zbox[pmfi.index()].hiVect(),
&ncomp);
}
}
void
CGSolver::update (MultiFab& sol,
Real alpha,
MultiFab& r,
const MultiFab& p,
const MultiFab& w)
{
//
// compute x =+ alpha p and r -= alpha w
//
const BoxArray& gbox = Lp.boxArray(lev);
int ncomp = r.nComp();
for (MFIter solmfi(sol); solmfi.isValid(); ++solmfi)
{
BL_ASSERT(solmfi.validbox() == gbox[solmfi.index()]);
FORT_CGUPDATE(sol[solmfi].dataPtr(),
ARLIM(sol[solmfi].loVect()), ARLIM(sol[solmfi].hiVect()),
r[solmfi].dataPtr(),
ARLIM(r[solmfi].loVect()), ARLIM(r[solmfi].hiVect()),
&alpha,
w[solmfi].dataPtr(),
ARLIM(w[solmfi].loVect()), ARLIM(w[solmfi].hiVect()),
p[solmfi].dataPtr(),
ARLIM(p[solmfi].loVect()), ARLIM(p[solmfi].hiVect()),
solmfi.validbox().loVect(), solmfi.validbox().hiVect(),
&ncomp);
}
}
Real
CGSolver::axp (MultiFab& w,
MultiFab& p,
LinOp::BC_Mode bc_mode)
{
//
// Compute w = A.p, and return Transpose(p).w
//
Real pw = 0.0;
const BoxArray& gbox = Lp.boxArray(lev);
Lp.apply(w, p, lev, bc_mode);
int ncomp = p.nComp();
for (MFIter pmfi(p); pmfi.isValid(); ++pmfi)
{
Real tpw;
BL_ASSERT(pmfi.validbox() == gbox[pmfi.index()]);
FORT_CGXDOTY(&tpw,
p[pmfi].dataPtr(),
ARLIM(p[pmfi].loVect()), ARLIM(p[pmfi].hiVect()),
w[pmfi].dataPtr(),
ARLIM(w[pmfi].loVect()), ARLIM(w[pmfi].hiVect()),
pmfi.validbox().loVect(), pmfi.validbox().hiVect(),
&ncomp);
pw += tpw;
}
ParallelDescriptor::ReduceRealSum(pw);
return pw;
}
static
void
sxay (MultiFab& ss, const MultiFab& xx, Real a, const MultiFab& yy)
{
const int ncomp = ss.nComp();
for (MFIter smfi(ss); smfi.isValid(); ++smfi)
{
FORT_CGSXAY(ss[smfi].dataPtr(),
ARLIM(ss[smfi].loVect()), ARLIM(ss[smfi].hiVect()),
xx[smfi].dataPtr(),
ARLIM(xx[smfi].loVect()), ARLIM(xx[smfi].hiVect()),
&a,
yy[smfi].dataPtr(),
ARLIM(yy[smfi].loVect()), ARLIM(yy[smfi].hiVect()),
smfi.validbox().loVect(), smfi.validbox().hiVect(),
&ncomp);
}
}
Real
dotxy (const MultiFab& r, const MultiFab& z)
{
BL_PROFILE("CGSolver::dotxy");
int ncomp = z.nComp();
Real rho = 0.0;
for (MFIter rmfi(r); rmfi.isValid(); ++rmfi)
{
Real trho;
FORT_CGXDOTY(&trho,
z[rmfi].dataPtr(),
ARLIM(z[rmfi].loVect()),ARLIM(z[rmfi].hiVect()),
r[rmfi].dataPtr(),
ARLIM(r[rmfi].loVect()),ARLIM(r[rmfi].hiVect()),
rmfi.validbox().loVect(),rmfi.validbox().hiVect(),
&ncomp);
rho += trho;
}
ParallelDescriptor::ReduceRealSum(rho);
return rho;
}
int
CGSolver::solve_bicgstab (MultiFab& sol,
const MultiFab& rhs,
Real eps_rel,
Real eps_abs,
LinOp::BC_Mode bc_mode)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::solve_bicgstab()");
const int nghost = 1;
const int ncomp = 1;
BL_ASSERT(sol.boxArray() == Lp.boxArray(lev));
BL_ASSERT(rhs.boxArray() == Lp.boxArray(lev));
BL_ASSERT(sol.nComp() == 1);
MultiFab sorig(sol.boxArray(), ncomp, nghost);
MultiFab s(sol.boxArray(), ncomp, nghost);
MultiFab sh(sol.boxArray(), ncomp, nghost);
MultiFab r(sol.boxArray(), ncomp, nghost);
MultiFab rh(sol.boxArray(), ncomp, nghost);
MultiFab p(sol.boxArray(), ncomp, nghost);
MultiFab ph(sol.boxArray(), ncomp, nghost);
MultiFab v(sol.boxArray(), ncomp, nghost);
MultiFab t(sol.boxArray(), ncomp, nghost);
if (verbose && false)
{
std::cout << "eps_rel = " << eps_rel << std::endl;
std::cout << "eps_abs = " << eps_abs << std::endl;
std::cout << "lp.norm = " << Lp.norm(0, lev) << std::endl;
std::cout << "sol.norm_inf = " << norm_inf(sol) << std::endl;
std::cout << "rhs.norm_inf = " << norm_inf(rhs) << std::endl;
}
sorig.copy(sol);
Lp.residual(r, rhs, sorig, lev, bc_mode);
rh.copy(r);
sol.setVal(0.0);
const LinOp::BC_Mode temp_bc_mode=LinOp::Homogeneous_BC;
Real rnorm = norm_inf(r);
const Real rnorm0 = rnorm;
const Real Lp_norm = Lp.norm(0, lev);
const Real rh_norm = rnorm0;
Real sol_norm = 0.0;
if (verbose > 0 && ParallelDescriptor::IOProcessor())
{
Spacer(std::cout, lev);
std::cout << "CGSolver_bicgstab: Initial error (error0) = " << rnorm0 << '\n';
}
int ret = 0; // will return this value if all goes well
Real rho_1 = 0, alpha = 0, omega = 0;
int nit = 1;
if ( rnorm == 0.0 || rnorm < eps_rel*(Lp_norm*sol_norm + rh_norm ) || rnorm < eps_abs )
{
if (verbose > 0 && ParallelDescriptor::IOProcessor())
{
Spacer(std::cout, lev);
std::cout << "CGSolver_bicgstab: niter = 0,"
<< ", rnorm = " << rnorm
<< ", eps_rel*(Lp_norm*sol_norm + rh_norm )" << eps_rel*(Lp_norm*sol_norm + rh_norm )
<< ", eps_abs = " << eps_abs << std::endl;
}
return 0;
}
for (; nit <= maxiter; ++nit)
{
Real rho = dotxy(rh, r);
if ( rho == 0 )
{
ret = 1;
break;
}
if ( nit == 1 )
{
p.copy(r);
}
else
{
Real beta = (rho/rho_1)*(alpha/omega);
sxay(p, p, -omega, v);
sxay(p, r, beta, p);
}
if ( use_mg_precond )
{
ph.setVal(0.0);
mg_precond->solve(ph, p, eps_rel, eps_abs, temp_bc_mode);
}
else
{
ph.copy(p);
}
Lp.apply(v, ph, lev, temp_bc_mode);
if ( Real rhTv = dotxy(rh, v) )
{
alpha = rho/rhTv;
}
else
{
ret = 2;
break;
}
sxay(sol, sol, alpha, ph);
sxay(s, r, -alpha, v);
rnorm = norm_inf(s);
#ifndef CG_USE_OLD_CONVERGENCE_CRITERIA
sol_norm = norm_inf(sol);
if ( rnorm < eps_rel*(Lp_norm*sol_norm + rh_norm ) || rnorm < eps_abs )
{
break;
}
#else
if ( rnorm < eps_rel*rnorm0 || rnorm < eps_abs )
{
break;
}
#endif
if (ParallelDescriptor::IOProcessor())
{
if (verbose > 1 ||
(((eps_rel > 0. && rnorm < eps_rel*rnorm0) ||
(eps_abs > 0. && rnorm < eps_abs)) && verbose))
{
Spacer(std::cout, lev);
std::cout << "CGSolver_bicgstab: Half Iter "
<< std::setw(4) << nit
<< " rel. err. "
<< rnorm/(Lp_norm*sol_norm+rh_norm) << '\n';
}
}
if ( use_mg_precond )
{
sh.setVal(0.0);
mg_precond->solve(sh, s, eps_rel, eps_abs, temp_bc_mode);
}
else
{
sh.copy(s);
}
Lp.apply(t, sh, lev, temp_bc_mode);
if ( Real tTt = dotxy(t,t) )
{
omega = dotxy(t,s)/tTt;
}
else
{
ret = 3;
break;
}
sxay(sol, sol, omega, sh);
sxay(r, s, -omega, t);
rnorm = norm_inf(r);
#ifndef CG_USE_OLD_CONVERGENCE_CRITERIA
sol_norm = norm_inf(sol);
if ( rnorm < eps_rel*(Lp_norm*sol_norm + rh_norm ) || rnorm < eps_abs )
{
break;
}
#else
if ( rnorm < eps_rel*rnorm0 || rnorm < eps_abs )
{
break;
}
#endif
if ( omega == 0 )
{
ret = 4;
break;
}
if (ParallelDescriptor::IOProcessor())
{
if (verbose > 1 ||
(((eps_rel > 0. && rnorm < eps_rel*rnorm0) ||
(eps_abs > 0. && rnorm < eps_abs)) && verbose))
{
Spacer(std::cout, lev);
std::cout << "CGSolver_bicgstab: Iteration "
<< std::setw(4) << nit
<< " rel. err. "
<< rnorm/(Lp_norm*sol_norm+rh_norm) << '\n';
}
}
rho_1 = rho;
}
// std::cout << "norm(R) = " << rnorm << endl;
// std::cout << "AX+B = " << Lp.norm(0,lev)*norm(sol) + norm(rhs) << endl;
if (ParallelDescriptor::IOProcessor())
{
if (verbose > 0 ||
(((eps_rel > 0. && rnorm < eps_rel*rnorm0) ||
(eps_abs > 0. && rnorm < eps_abs)) && verbose))
{
Spacer(std::cout, lev);
std::cout << "CGSolver_bicgstab: Final: Iteration "
<< std::setw(4) << nit
<< " rel. err. "
<< rnorm/(Lp_norm*sol_norm+rh_norm) << '\n';
}
}
if( ret != 0 && isExpert == false )
{
BoxLib::Error("CGSolver_bicgstab:: apparent accuracy problem; try expert setting or change unstable_criterion");
}
#ifndef CG_USE_OLD_CONVERGENCE_CRITERIA
if ( ret == 0 && rnorm > eps_rel*(Lp_norm*sol_norm + rh_norm ) && rnorm > eps_abs )
{
BoxLib::Error("CGSolver_bicgstab:: failed to converge!");
}
#else
if ( ret == 0 && rnorm > eps_rel*rnorm0 && rnorm > eps_abs)
{
BoxLib::Error("CGSolver_bicgstab:: failed to converge!");
}
#endif
if ( ret == 0 )
{
sol.plus(sorig, 0, 1, 0);
}
return ret;
}
int
CGSolver::solve_cg (MultiFab& sol,
const MultiFab& rhs,
Real eps_rel,
Real eps_abs,
LinOp::BC_Mode bc_mode)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::solve_cg()");
const int nghost = 1;
const int ncomp = sol.nComp();
BL_ASSERT(sol.boxArray() == Lp.boxArray(lev));
BL_ASSERT(rhs.boxArray() == Lp.boxArray(lev));
BL_ASSERT(ncomp == 1 );
MultiFab sorig(sol.boxArray(), ncomp, nghost);
MultiFab r(sol.boxArray(), ncomp, nghost);
MultiFab z(sol.boxArray(), ncomp, nghost);
MultiFab q(sol.boxArray(), ncomp, nghost);
MultiFab p(sol.boxArray(), ncomp, nghost);
sorig.copy(sol);
Lp.residual(r, rhs, sorig, lev, bc_mode);
sol.setVal(0.0);
const LinOp::BC_Mode temp_bc_mode=LinOp::Homogeneous_BC;
Real rnorm = norm_inf(r);
const Real rnorm0 = rnorm;
Real minrnorm = rnorm;
if (verbose > 0 && ParallelDescriptor::IOProcessor())
{
Spacer(std::cout, lev);
std::cout << "CGsolver_cg: Initial error (error0) = " << rnorm0 << '\n';
}
const Real Lp_norm = Lp.norm(0, lev);
const Real rh_norm = rnorm0;
Real sol_norm = 0.0;
int ret = 0; // will return this value if all goes well
Real rho_1 = 0;
int nit = 1;
if ( rnorm == 0.0 || rnorm < eps_rel*(Lp_norm*sol_norm + rh_norm ) || rnorm < eps_abs )
{
if (verbose > 0 && ParallelDescriptor::IOProcessor())
{
Spacer(std::cout, lev);
std::cout << "CGSolver_cg: niter = 0,"
<< ", rnorm = " << rnorm
<< ", eps_rel*(Lp_norm*sol_norm + rh_norm )" << eps_rel*(Lp_norm*sol_norm + rh_norm )
<< ", eps_abs = " << eps_abs << std::endl;
}
return 0;
}
for (; nit <= maxiter; ++nit)
{
if (use_mg_precond)
{
z.setVal(0.);
mg_precond->solve(z, r, eps_rel, eps_abs, temp_bc_mode);
}
else
{
z.copy(r);
}
Real rho = dotxy(z,r);
if (nit == 1)
{
p.copy(z);
}
else
{
Real beta = rho/rho_1;
sxay(p, z, beta, p);
}
Lp.apply(q, p, lev, temp_bc_mode);
Real alpha;
if ( Real pw = dotxy(p, q) )
{
alpha = rho/pw;
}
else
{
ret = 1;
break;
}
if (ParallelDescriptor::IOProcessor() && verbose > 2)
{
Spacer(std::cout, lev);
std::cout << "CGSolver_cg:"
<< " nit " << nit
<< " rho " << rho
<< " alpha " << alpha;
}
sxay(sol, sol, alpha, p);
sxay( r, r,-alpha, q);
rnorm = norm_inf(r);
sol_norm = norm_inf(sol);
#ifndef CG_USE_OLD_CONVERGENCE_CRITERIA
if ( rnorm < eps_rel*(Lp_norm*sol_norm + rh_norm) || rnorm < eps_abs )
{
break;
}
#else
if ( rnorm < eps_rel*rnorm0 || rnorm < eps_abs )
{
break;
}
#endif
if( rnorm > def_unstable_criterion*minrnorm )
{
ret = 2;
break;
}
else if( rnorm < minrnorm )
{
minrnorm = rnorm;
}
if (ParallelDescriptor::IOProcessor())
{
if (verbose > 1 ||
(((eps_rel > 0. && rnorm < eps_rel*rnorm0) ||
(eps_abs > 0. && rnorm < eps_abs)) && verbose))
{
Spacer(std::cout, lev);
std::cout << "CGSolver_cg: Iteration "
<< std::setw(4) << nit
<< " rel. err. "
<< rnorm/(Lp_norm*sol_norm+rh_norm) << '\n';
}
}
rho_1 = rho;
}
if (ParallelDescriptor::IOProcessor())
{
if (verbose > 0 ||
(((eps_rel > 0. && rnorm < eps_rel*rnorm0) ||
(eps_abs > 0. && rnorm < eps_abs)) && verbose))
{
Spacer(std::cout, lev);
std::cout << "CGSolver_cg: Final: Iteration "
<< std::setw(4) << nit
<< " rel. err. "
<< rnorm/(Lp_norm*sol_norm+rh_norm) << '\n';
}
}
if ( ret != 0 && !isExpert )
{
BoxLib::Error("CGSolver_cg:: apparent accuracy problem; try expert setting or change unstable_criterion");
}
#ifndef CG_USE_OLD_CONVERGENCE_CRITERIA
if ( ret == 0 && rnorm > eps_rel*(Lp_norm*sol_norm + rh_norm) && rnorm > eps_abs )
{
BoxLib::Error("CGSolver_cg:: failed to converge!");
}
#else
if ( ret == 0 && rnorm > eps_rel*rnorm0 && rnorm > eps_abs )
{
BoxLib::Error("CGSolver_cg:: failed to converge!");
}
#endif
if ( ret == 0 )
{
sol.plus(sorig, 0, 1, 0);
}
return ret;
}
ccseapps-2.5/CCSEApps/mglib/ABec_F.H 0000644 0001750 0001750 00000022325 11634153073 020125 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _AABBEC_F_H_
#define _AABBEC_F_H_
/*
** $Id: ABec_F.H,v 1.5 2002/04/26 22:10:02 lijewski Exp $
*/
#include
#if defined(BL_LANG_FORT)
#if (BL_SPACEDIM == 2)
#define FORT_GSRB gsrb2daabbec
#define FORT_CGPRECND cgprecnd2daabbec
#define FORT_ADOTX adotx2daabbec
#define FORT_NORMA norma2daabbec
#define FORT_FLUX flux2daabbec
#endif
#if (BL_SPACEDIM == 3)
#define FORT_GSRB gsrb3daabbec
#define FORT_CGPRECND cgprecnd3daabbec
#define FORT_ADOTX adotx3daabbec
#define FORT_NORMA norma3daabbec
#define FORT_FLUX flux3daabbec
#endif
#else
#if (BL_SPACEDIM == 2)
#if defined(BL_FORT_USE_UPPERCASE)
#define FORT_GSRB GSRB2DAABBEC
#define FORT_CGPRECND CGPRECND2DAABBEC
#define FORT_ADOTX ADOTX2DAABBEC
#define FORT_NORMA NORMA2DAABBEC
#define FORT_FLUX FLUX2DAABBEC
#elif defined(BL_FORT_USE_LOWERCASE)
#define FORT_GSRB gsrb2daabbec
#define FORT_CGPRECND cgprecnd2daabbec
#define FORT_ADOTX adotx2daabbec
#define FORT_NORMA norma2daabbec
#define FORT_FLUX flux2daabbec
#elif defined(BL_FORT_USE_UNDERSCORE)
#define FORT_GSRB gsrb2daabbec_
#define FORT_CGPRECND cgprecnd2daabbec_
#define FORT_ADOTX adotx2daabbec_
#define FORT_NORMA norma2daabbec_
#define FORT_FLUX flux2daabbec_
#endif
#endif
#if (BL_SPACEDIM == 3)
#if defined(BL_FORT_USE_UPPERCASE)
#define FORT_GSRB GSRB3DAABBEC
#define FORT_CGPRECND CGPRECND3DAABBEC
#define FORT_ADOTX ADOTX3DAABBEC
#define FORT_NORMA NORMA3DAABBEC
#define FORT_FLUX FLUX3DAABBEC
#elif defined(BL_FORT_USE_LOWERCASE)
#define FORT_GSRB gsrb3daabbec
#define FORT_CGPRECND cgprecnd3daabbec
#define FORT_ADOTX adotx3daabbec
#define FORT_NORMA norma3daabbec
#define FORT_FLUX flux3daabbec
#elif defined(BL_FORT_USE_UNDERSCORE)
#define FORT_GSRB gsrb3daabbec_
#define FORT_CGPRECND cgprecnd3daabbec_
#define FORT_ADOTX adotx3daabbec_
#define FORT_NORMA norma3daabbec_
#define FORT_FLUX flux3daabbec_
#endif
#endif
#include
extern "C"
{
#if (BL_SPACEDIM == 2)
void FORT_GSRB (
Real* phi , ARLIM_P(phi_lo), ARLIM_P(phi_hi),
const Real* rhs , ARLIM_P(rhs_lo), ARLIM_P(phi_hi),
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX , ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY , ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const Real* den0, ARLIM_P(den0_lo),ARLIM_P(den0_hi),
const int* m0 , ARLIM_P(m0_lo), ARLIM_P(m0_hi),
const Real* den1, ARLIM_P(den1_lo),ARLIM_P(den1_hi),
const int* m1 , ARLIM_P(m1_lo), ARLIM_P(m1_hi),
const Real* den2, ARLIM_P(den2_lo),ARLIM_P(den2_hi),
const int* m2 , ARLIM_P(m2_lo), ARLIM_P(m2_hi),
const Real* den3, ARLIM_P(den3_lo),ARLIM_P(den3_hi),
const int* m3 , ARLIM_P(m3_lo), ARLIM_P(m3_hi),
const int* lo, const int* hi, const int *nc,
const Real *h, const int* redblack
);
void FORT_CGPRECND(
Real *tmpz , ARLIM_P(tmpz_lo), ARLIM_P(tmpz_hi),
Real *rho,
const Real *tmpr, ARLIM_P(tmpr_lo), ARLIM_P(tmpr_hi),
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX, ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY, ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const int *lo, const int *hi, const int *nc,
const Real *h
);
void FORT_ADOTX(
Real *y , ARLIM_P(y_lo), ARLIM_P(y_hi),
const Real *x, ARLIM_P(x_lo), ARLIM_P(x_hi),
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX, ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY, ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const int *lo, const int *hi, const int *nc,
const Real *h
);
void FORT_NORMA(
Real* res ,
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX, ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY, ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const int *lo, const int *hi, const int *nc,
const Real *h
);
void FORT_FLUX(
const Real *x, ARLIM_P(x_lo), ARLIM_P(x_hi),
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX, ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY, ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const int *lo, const int *hi, const int *nc,
const Real *h,
const Real* xflux, ARLIM_P(xflux_lo), ARLIM_P(xflux_hi),
const Real* yflux, ARLIM_P(yflux_lo), ARLIM_P(yflux_hi)
);
#endif
#if (BL_SPACEDIM == 3)
void FORT_GSRB (
Real* phi, ARLIM_P(phi_lo), ARLIM_P(phi_hi),
const Real* rhs, ARLIM_P(rhs_lo), ARLIM_P(rhs_hi),
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX, ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY, ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const Real* bZ, ARLIM_P(bZ_lo), ARLIM_P(bZ_hi),
const Real* den0, ARLIM_P(den0_lo), ARLIM_P(den0_hi),
const int* m0 , ARLIM_P(m0_lo), ARLIM_P(m0_hi),
const Real* den1, ARLIM_P(den1_lo), ARLIM_P(den1_hi),
const int* m1 , ARLIM_P(m1_lo), ARLIM_P(m1_hi),
const Real* den2, ARLIM_P(den2_lo), ARLIM_P(den2_hi),
const int* m2 , ARLIM_P(m2_lo), ARLIM_P(m2_hi),
const Real* den3, ARLIM_P(den3_lo), ARLIM_P(den3_hi),
const int* m3 , ARLIM_P(m3_lo), ARLIM_P(m3_hi),
const Real* den4, ARLIM_P(den4_lo), ARLIM_P(den4_hi),
const int* m4 , ARLIM_P(m4_lo), ARLIM_P(m4_hi),
const Real* den5, ARLIM_P(den5_lo), ARLIM_P(den5_hi),
const int* m5 , ARLIM_P(m5_lo), ARLIM_P(m5_hi),
const int* lo, const int* hi, const int *nc,
const Real *h, const int* redblack
);
void FORT_CGPRECND(
Real *tmpz , ARLIM_P(tmpz_lo), ARLIM_P(tmpz_hi),
Real *rho,
const Real *tmpr, ARLIM_P(tmpr_lo), ARLIM_P(tmpr_hi),
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX, ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY, ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const Real* bZ, ARLIM_P(bZ_lo), ARLIM_P(bZ_hi),
const int *lo, const int *hi, const int *nc,
const Real *h
);
void FORT_ADOTX(
Real *y , ARLIM_P(y_lo), ARLIM_P(y_hi),
const Real *x, ARLIM_P(x_lo), ARLIM_P(x_hi),
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX, ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY, ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const Real* bZ, ARLIM_P(bZ_lo), ARLIM_P(bZ_hi),
const int *lo, const int *hi, const int *nc,
const Real *h
);
void FORT_NORMA(
Real* res ,
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX, ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY, ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const Real* bZ, ARLIM_P(bZ_lo), ARLIM_P(bZ_hi),
const int *lo, const int *hi, const int *nc,
const Real *h
);
void FORT_FLUX(
const Real *x, ARLIM_P(x_lo), ARLIM_P(x_hi),
const Real* alpha, const Real* beta,
const Real* a , ARLIM_P(a_lo), ARLIM_P(a_hi),
const Real* bX, ARLIM_P(bX_lo), ARLIM_P(bX_hi),
const Real* bY, ARLIM_P(bY_lo), ARLIM_P(bY_hi),
const Real* bZ, ARLIM_P(bZ_lo), ARLIM_P(bZ_hi),
const int *lo, const int *hi, const int *nc,
const Real *h,
Real* xflux, ARLIM_P(xflux_lo), ARLIM_P(xflux_hi),
Real* yflux, ARLIM_P(yflux_lo), ARLIM_P(yflux_hi),
Real* zflux, ARLIM_P(zflux_lo), ARLIM_P(zflux_hi)
);
#endif
}
#endif
#endif /*_AABBEC_F_H_*/
ccseapps-2.5/CCSEApps/mglib/InterpBndryData.cpp 0000644 0001750 0001750 00000020010 11634153073 022500 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: InterpBndryData.cpp,v 1.16 2002/11/12 17:08:48 lijewski Exp $
//
#include
#include
#include
#include
#include
static BDInterpFunc* bdfunc[2*BL_SPACEDIM];
static int bdfunc_set = 0;
static
void
bdfunc_init ()
{
Orientation xloface(0,Orientation::low);
Orientation xhiface(0,Orientation::high);
bdfunc[xloface] = FORT_BDINTERPXLO;
bdfunc[xhiface] = FORT_BDINTERPXHI;
#if (BL_SPACEDIM > 1)
Orientation yloface(1,Orientation::low);
Orientation yhiface(1,Orientation::high);
bdfunc[yloface] = FORT_BDINTERPYLO;
bdfunc[yhiface] = FORT_BDINTERPYHI;
#endif
#if (BL_SPACEDIM > 2)
Orientation zloface(2,Orientation::low);
Orientation zhiface(2,Orientation::high);
bdfunc[zloface] = FORT_BDINTERPZLO;
bdfunc[zhiface] = FORT_BDINTERPZHI;
#endif
}
#if (BL_SPACEDIM == 2)
#define NUMDERIV 2
#endif
#if (BL_SPACEDIM == 3)
#define NUMDERIV 5
#endif
#define DEF_LIMITS(fab,fabdat,fablo,fabhi) \
const int* fablo = (fab).loVect(); \
const int* fabhi = (fab).hiVect(); \
Real* fabdat = (fab).dataPtr();
#define DEF_CLIMITS(fab,fabdat,fablo,fabhi) \
const int* fablo = (fab).loVect(); \
const int* fabhi = (fab).hiVect(); \
const Real* fabdat = (fab).dataPtr();
InterpBndryData::InterpBndryData (const BoxArray& _grids,
int _ncomp,
const Geometry& geom)
:
BndryData(_grids,_ncomp,geom)
{}
//
// At the coarsest level the bndry values are taken from adjacent grids.
//
void
InterpBndryData::setBndryValues (const MultiFab& mf,
int mf_start,
int bnd_start,
int num_comp,
const BCRec& bc)
{
//
// Check that boxarrays are identical.
//
BL_ASSERT(grids.size());
BL_ASSERT(grids == mf.boxArray());
IntVect ref_ratio = IntVect::TheUnitVector();
for (int n = bnd_start; n < bnd_start+num_comp; ++n)
setBndryConds(bc, ref_ratio, n);
for (MFIter mfi(mf); mfi.isValid(); ++mfi)
{
BL_ASSERT(grids[mfi.index()] == mfi.validbox());
const Box& bx = grids[mfi.index()];
for (OrientationIter fi; fi; ++fi)
{
Orientation face(fi());
if (bx[face]==geom.Domain()[face] && !geom.isPeriodic(face.coordDir()))
{
//
// Physical bndry, copy from grid.
//
FArrayBox& bnd_fab = bndry[face][mfi.index()];
bnd_fab.copy(mf[mfi.index()],mf_start,bnd_start,num_comp);
}
}
}
}
//
// (1) set bndry type and location of bndry value on each face of
// each grid
// (2) set actual bndry value by:
// (A) Interpolate from crse bndryRegister at crse/fine interface
// (B) Copy from ghost region of MultiFab at physical bndry
//
void
InterpBndryData::setBndryValues (::BndryRegister& crse,
int c_start,
const MultiFab& fine,
int f_start,
int bnd_start,
int num_comp,
IntVect& ratio,
const BCRec& bc)
{
if (!bdfunc_set)
bdfunc_init();
//
// Check that boxarrays are identical.
//
BL_ASSERT(grids.size());
BL_ASSERT(grids == fine.boxArray());
//
// Set bndry types and bclocs.
//
setBndryConds(bc, ratio);
//
// First interpolate from coarse to fine on bndry.
//
const Box& fine_domain = geom.Domain();
//
// Mask turned off if covered by fine grid.
//
Real* derives = 0;
int tmplen = 0;
for (MFIter fine_mfi(fine); fine_mfi.isValid(); ++fine_mfi)
{
BL_ASSERT(grids[fine_mfi.index()] == fine_mfi.validbox());
const Box& fine_bx = fine_mfi.validbox();
Box crse_bx = BoxLib::coarsen(fine_bx,ratio);
const int* cblo = crse_bx.loVect();
const int* cbhi = crse_bx.hiVect();
int mxlen = crse_bx.longside() + 2;
if (pow(float(mxlen), float(BL_SPACEDIM-1)) > tmplen)
{
delete [] derives;
tmplen = mxlen;
#if (BL_SPACEDIM > 2)
tmplen *= mxlen;
#endif
derives = new Real[tmplen*NUMDERIV];
}
const int* lo = fine_bx.loVect();
const int* hi = fine_bx.hiVect();
const FArrayBox &fine_grd = fine[fine_mfi];
for (OrientationIter fi; fi; ++fi)
{
Orientation face(fi());
int dir = face.coordDir();
if (fine_bx[face] != fine_domain[face] || geom.isPeriodic(dir))
{
//
// Internal or periodic edge, interpolate from crse data.
//
const Mask& mask = masks[face][fine_mfi.index()];
const int* mlo = mask.loVect();
const int* mhi = mask.hiVect();
const int* mdat = mask.dataPtr();
const FArrayBox& crse_fab = crse[face][fine_mfi.index()];
const int* clo = crse_fab.loVect();
const int* chi = crse_fab.hiVect();
const Real* cdat = crse_fab.dataPtr(c_start);
FArrayBox& bnd_fab = bndry[face][fine_mfi.index()];
const int* blo = bnd_fab.loVect();
const int* bhi = bnd_fab.hiVect();
Real* bdat = bnd_fab.dataPtr(bnd_start);
int is_not_covered = BndryData::not_covered;
Box crsebnd = BoxLib::adjCell(crse_bx,face,1);
for (int k=0;k
#include "CG_F.H"
#include "ArrayLim.H"
c-----------------------------------------------------------------------
c
c CGUPDATE: Modify the input arrays as follows:
c
c phi = phi + a*pp
c rr = rr - a*ww through range lo:hi
c
c phi <=>
c rr <=>
c a <=
c ww <=
c pp <=
c
c-----------------------------------------------------------------------
subroutine FORT_CGUPDATE(
$ phi, DIMS(phi),
$ rr, DIMS(rr),
$ a,
$ ww, DIMS(ww),
$ pp, DIMS(pp),
$ lo, hi, nc
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(rr)
REAL_T rr(DIMV(rr),nc)
integer DIMDEC(ww)
REAL_T ww(DIMV(ww),nc)
integer DIMDEC(pp)
REAL_T pp(DIMV(pp),nc)
integer DIMDEC(phi)
REAL_T phi(DIMV(phi),nc)
REAL_T a
c ::: wyc change -- why was a a vector?
c REAL_T a(nc)
c
integer i,j,k,n
c
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i,j,k,n) = phi(i,j,k,n) + a * pp(i,j,k,n)
rr(i,j,k,n) = rr(i,j,k,n) - a * ww(i,j,k,n)
c ::: wyc change -- why was a a vector?
c phi(i,j,k,n) = phi(i,j,k,n) + a(n) * pp(i,j,k,n)
c rr(i,j,k,n) = rr(i,j,k,n) - a(n) * ww(i,j,k,n)
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c CGADVCP: Modify the input arrays as follows:
c
c pp = rr + b*pp through range lo:hi
c
c pp <=>
c rr <=>
c b <=
c
c-----------------------------------------------------------------------
subroutine FORT_CGADVCP(
$ pp, DIMS(pp),
$ rr, DIMS(rr),
$ b,
$ lo, hi, nc
$ )
c
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(rr)
REAL_T rr(DIMV(rr),nc)
integer DIMDEC(pp)
REAL_T pp(DIMV(pp),nc)
REAL_T b
c ::: wyc change
c REAL_T b(nc)
c
c
integer i,j,k,n
c
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
pp(i,j,k,n) = rr(i,j,k,n) + b*pp(i,j,k,n)
c pp(i,j,k,n) = rr(i,j,k,n) + b(n)*pp(i,j,k,n)
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c CGAXP: Modify the input as follows:
c
c pw = Transpose(pp) . ww through range lo:hi
c
c pw =>
c pp <=
c ww <=
c
c-----------------------------------------------------------------------
subroutine FORT_CGXDOTY(
$ pw,
$ pp, DIMS(pp),
$ ww, DIMS(ww),
$ lo, hi, nc
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(ww)
REAL_T ww(DIMV(ww),nc)
integer DIMDEC(pp)
REAL_T pp(DIMV(pp),nc)
REAL_T pw
c
integer i, j, k, n
c
pw = 0.0D0
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
pw = pw + pp(i,j,k,n)*ww(i,j,k,n)
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
subroutine FORT_CGSXAY(
$ ss, DIMS(ss),
$ xx, DIMS(xx),
$ a,
$ yy, DIMS(yy),
$ lo, hi, nc
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(ss)
REAL_T ss(DIMV(ss),nc)
integer DIMDEC(xx)
REAL_T xx(DIMV(xx),nc)
integer DIMDEC(yy)
REAL_T yy(DIMV(yy),nc)
REAL_T a
c
integer i, j, k, n
c
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
ss(i,j,k,n) = xx(i,j,k,n) + a*yy(i,j,k,n)
end do
end do
end do
end do
c
end
ccseapps-2.5/CCSEApps/mglib/MultiGrid.H 0000644 0001750 0001750 00000037403 11634153073 020771 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _MULTIGRID_H_
#define _MULTIGRID_H_
//
// $Id: MultiGrid.H,v 1.11 2001/08/01 21:51:04 lijewski Exp $
//
#include
#include
#include
#include
#include
#include
#include
#include
//@Man:
/*@Memo:
A MultiGrid solves the linear equation, L(phi)=rhs, for a LinOp L and
MultiFabs rhs and phi using a V-type cycle of the MultiGrid algorithm
*/
/*@Doc:
A MultiGrid object solves the linear equation, L(phi)=rhs for a LinOp
L, and MultiFabs phi and rhs. A MultiGrid is constructed with a
fully initialized 2D or 3D LinOp, and responds to "solve" requests of
various signatures, ultimately performing a recursive "relax"
operation over a hierachy of grid levels. The LinOp therefore must
employ "levels" of application, as well as be able to provide an
implementation of the Gauss-Seidel red-black iterations on all levels.
At the coarsest level, the user has the option of applying the
GSRB smoother a set number of iterations. Optionally, a Conjugate
Gradient solver, CGSolver, may be used to solve the coarsest system.
If the user chooses to use the conjugate gradient bottom solve,
the absolute and relative tolerances of this solve are independently
settable distinct from the tolerances of the mg solve. However,
it rarely makes sense to stop cg after a fixed number of iterations,
so that capability was omited, wrt the mg options. As a final
option, the user may choose to follow the cg solve with a fixed
number of relaxation passes (the relaxer within the class LinOp).
The solve request (implicitly) includes a flag as to whether the
system is to be solved with homogeneous boundary conditions or no.
If homogeneous BCs are requested, all boundary information within
the LinOp is used, except that the values of boundary FabSets are
zeroed.
Implementation Note:
This algorithm implements solution of equations in a way that
requires linearity of the operator. In "residual correction form",
equations are solved only for the "correction" to the initial guess
that is required to solve the desired system. In particular,
boundary conditions are assumed to be satisfied after a single
application of the linear operator (therefore, the correction is
homogeneous at the boundary). As a result, after putting the
problem in residual correction form, the entire system MG hierarchy
has homigeneous boundary conditions (thus avoiding the need to
interpolate BC values, and simplifying the logic of the coarse-fine
transfer operations). This solver therefore cannot incorporate
fully nonlinear systems.
Default settings:
There are a number of options in the multigrid algorithm details.
In addition to changing the actual smoothers employed, the user
has access to the following parameters (defaults shown in parentheses):
\begin{itemize}
\item nu\_1(2) Number of passes of the pre-smoother
\item nu\_2(2) Number of passes of the post-smoother
\item nu\_0(1) Number of passes of the coarse-grid smoother per
cycle
\item nu\_f(8) Number of passes of the bottom smoother (if not using
the conjugate-gradient bottom solve)
\item maxiter(40) Maximum number of full multigrid cycles allowed to
solve the system
\item numiter(-1) Number of full multigrid cycles to perform
(should be less than maxiter for fixed number of MG cycles;
value is ignored if < 0)
\item verbose(0) Verbosity (1-results, 2-progress)
\item usecg(1) Whether to use the conjugate-gradient solver for the
coarsest (bottom) solve of the multigrid hierarchy
\item atol\_b(-1.0) Absolute error tolerance (<0 => ignored) for cg
\item rtol\_b(.01) Relative error tolerance (<0 => ignored) for cg
\item nu\_b(0) Number of passes of the bottom smoother taken
{\it AFTER} the cg bottom solve (value ignored if <= 0)
\item numLevelsMAX(1024) maximum number of mg levels
\end{itemize}
This class does NOT provide a copy constructor or assignment operator.
*/
class MultiGrid
{
public:
//
//@ManDoc: constructor
//
MultiGrid (LinOp& _Lp);
//
//@ManDoc: destructor
//
virtual ~MultiGrid ();
//
//@ManDoc: solve the system to relative err eps\_rel, absolute err eps\_abs
//
virtual void solve (MultiFab& solution,
const MultiFab& _rhs,
Real eps_rel = -1.0,
Real eps_abs = -1.0,
LinOp::BC_Mode bc_mode=LinOp::Inhomogeneous_BC);
//
//@ManDoc: return the linear operator
//
LinOp& linOp ();
//
//@ManDoc: set the maximum permitted multigrid iterations
//
void setMaxIter (int _maxiter);
//
//@ManDoc: return the maximum permitted multigrid iterations
//
int getMaxIter () const;
//
//@ManDoc: set the number of multigrid iterations to perform
//
void setNumIter (int _numiter);
//
//@ManDoc: return the number of multigrid iterations
//
int getNumIter () const;
//
//@ManDoc: set the flag for whether to use CGSolver at coarsest level
//
void setUseCG (int _usecg);
//
//@ManDoc: return the flag for whether to use CGSolver at coarsest level
//
int getUseCG () const;
//
//@ManDoc: set/return the number of multigrid levels
//
int getNumLevels (int _numlevels);
//
//@ManDoc: return the number of multigrid levels
//
int getNumLevels () const;
//
//@ManDoc: set the verbosity value
//
void setVerbose (int _verbose);
//
//@ManDoc: return the verbosity value
//
int getVerbose ();
//
//@ManDoc: set the number of passes of the pre-smoother
//
void set_preSmooth (int pre_smooth);
//
//@ManDoc: set the number of passes of the post-smoother
//
void set_postSmooth (int post_smooth);
//
//@ManDoc: set the number of passes of the coarse-grid smoother/mg iteration
//
void set_cntRelax (int cnt_relax);
//
//@ManDoc: set the number of passes of the bottom mg relaxer
//
void set_finalSmooth (int final_smooth);
//
//@ManDoc: Return the number of pre-smooth iterations at the level
//
int preSmooth () const;
//
//@ManDoc: Return the number of post-smooth iterations at the level
//
int postSmooth () const;
//
//@ManDoc: Return the number of level relaxations (not implemented)
//
int cntRelax () const;
//
//@ManDoc: Return the number of smoothing passes at bottom of MG (if no cg)
//
int finalSmooth () const;
//
//@ManDoc: set the maximum permitted absolute tolerance (<0 bypasses test)
//
void set_atol_b (Real atol);
//
//@ManDoc: get the maximum permitted absolute tolerance
//
Real get_atol_b () const;
//
//@ManDoc: set the maximum permitted relative tolerance (<0 bypasses test)
//
void set_rtol_b (Real rtol);
//
//@ManDoc: get the maximum permitted relative tolerance
//
Real get_rtol_b () const;
//
//@ManDoc: set the number of post-cg relax passes
//
void set_nu_b (int _nu_b);
//
//@ManDoc: set the number of post-cg relax passes
//
int get_nu_b () const;
CGSolver::Solver getCGSolver() const;
void setCGSolver(CGSolver::Solver solver_);
void set_maxiter_b (int n);
//
//@ManDoc: get the maximum permitted relative tolerance
//
int get_maxiter_b () const;
protected:
//@ManMemo: Internal members
//
//@ManDoc: Solve the linear system to relative and absolute tolerance
//
virtual int solve_ (MultiFab& _sol,
Real _eps_rel,
Real _eps_abs,
LinOp::BC_Mode bc_mode,
int level);
//
//@ManDoc: Put the system in r-c form
//
void residualCorrectionForm (MultiFab& newrhs,
const MultiFab& oldrhs,
MultiFab& initialsolution,
const MultiFab& inisol,
LinOp::BC_Mode bc_mode,
int level);
//
//@ManDoc: Make space, set switches for new solution level
//
void prepareForLevel (int level);
//
//@ManDoc: Compute the number of multigrid levels, assuming ratio=2
//
int numLevels () const;
//
//@ManDoc: Return scalar estimate of error
//
virtual Real errorEstimate (int level,
LinOp::BC_Mode bc_mode);
//
//@ManDoc: Transfer MultiFab from fine to coarse level
//
void average (MultiFab& c,
const MultiFab& f);
//
//@ManDoc: Transfer MultiFab from coarse to fine level
//
void interpolate (MultiFab& f,
const MultiFab& c);
//
//@ManDoc: Perform a MG V-cycle
//
void relax (MultiFab& solL,
MultiFab& rhsL,
int level,
Real eps_rel,
Real eps_abs,
LinOp::BC_Mode bc_mode);
//
//@ManDoc: Perform relaxation at bottom of V-cycle
//
virtual void coarsestSmooth (MultiFab& solL,
MultiFab& rhsL,
int level,
Real eps_rel,
Real eps_abs,
LinOp::BC_Mode bc_mode,
int local_usecg);
//
//@ManDoc: default flag, whether to use CG at bottom of MG cycle
//
static int def_usecg;
//
//@ManDoc: set flags, etc
//
static void initialize ();
//
//@ManDoc: default number of level, pre-, post- and bottom smooths
//
static int def_nu_0, def_nu_1, def_nu_2, def_nu_f;
//
//@ManDoc: default number of post-cg relax passes
//
static int def_nu_b;
//
//@ManDoc: default maximum number of complete MG cycle iterations
//
static int def_maxiter;
//
//@ManDoc: default number of complete MG cycle iterations to perform
//
static int def_numiter;
//
//@ManDoc: default verbosity
//
static int def_verbose;
//
//@ManDoc: default relative, absolute tolerance for cg solve
//
static Real def_rtol_b, def_atol_b;
static int def_maxiter_b;
//
//@ManDoc: default maximum number of mg levels
//
static int def_numLevelsMAX;
//
//@ManDoc: default flag controlling the behaviour when the cg solver returns indicating unstable
//
static int def_smooth_on_cg_unstable;
//
static CGSolver::Solver def_cg_solver;
CGSolver::Solver cg_solver;
//
//@ManDoc: verbosity
//
int verbose;
//
//@ManDoc: Number of MG levels
//
int numlevels;
//
//@ManDoc: current maximum number of allowed iterations
//
int maxiter;
//
//@ManDoc: current number of iterations to take
//
int numiter;
//
//@ManDoc: current number of level, pre-, post- and bottom smooths
//
int nu_0, nu_1, nu_2, nu_f;
//
//@ManDoc: current number of post-cg relax passes
//
int nu_b;
//
//@ManDoc: current flag, whether to use CG at bottom of MG cycle
//
int usecg;
//
//@ManDoc: relative, absolute tolerance, maxiter for cg bottom solver.
//
Real rtol_b, atol_b;
int maxiter_b;
//
//@ManDoc: maximum number of mg levels
//
int numLevelsMAX;
//
//@ManDoc: flag controlling the behaviour when the cg solver returns indicating unstable
//
int smooth_on_cg_unstable;
//
//@ManDoc: internal temp data to store initial guess of solution
//
MultiFab* initialsolution;
//
//@ManDoc: internal temp data
//
Array< MultiFab* > res;
//
//@ManDoc: internal temp data
//
Array< MultiFab* > rhs;
//
//@ManDoc: internal temp data
//
Array< MultiFab* > cor;
//
//@ManDoc: internal reference to linear operator
//
LinOp &Lp;
private:
//
// Flag, whether initialized.
//
static bool initialized;
//
// Disallow copy constructor, assignment operator
//
MultiGrid (const MultiGrid&);
MultiGrid& operator= (const MultiGrid&);
};
inline
LinOp&
MultiGrid::linOp ()
{
return Lp;
}
inline
void
MultiGrid::setMaxIter (int _maxiter)
{
maxiter = _maxiter;
}
inline
int
MultiGrid::getMaxIter () const
{
return maxiter;
}
inline
void
MultiGrid::setNumIter (int _numiter)
{
numiter = _numiter;
}
inline
int
MultiGrid::getNumIter () const
{
return numiter;
}
inline
void
MultiGrid::setUseCG (int _usecg)
{
usecg = _usecg;
}
inline
int
MultiGrid::getUseCG () const
{
return usecg;
}
inline
int
MultiGrid::getNumLevels () const
{
return numlevels;
}
inline
void
MultiGrid::setVerbose (int _verbose)
{
verbose = _verbose;
}
inline
int
MultiGrid::getVerbose ()
{
return verbose;
}
inline
void
MultiGrid::set_preSmooth (int pre_smooth)
{
nu_1 = pre_smooth;
}
inline
void
MultiGrid::set_postSmooth (int post_smooth)
{
nu_2 = post_smooth;
}
inline
void
MultiGrid::set_cntRelax (int cnt_relax)
{
nu_0 = cnt_relax;
}
inline
void
MultiGrid::set_finalSmooth (int final_smooth)
{
nu_f = final_smooth;
}
inline
int
MultiGrid::preSmooth () const
{
return nu_1;
}
inline
int
MultiGrid::postSmooth () const
{
return nu_2;
}
inline
int
MultiGrid::cntRelax () const
{
return nu_0;
}
inline
int
MultiGrid::finalSmooth () const
{
return nu_f;
}
inline
void
MultiGrid::set_atol_b (Real atol)
{
atol_b = atol;
}
inline
Real
MultiGrid::get_atol_b () const
{
return atol_b;
}
inline
void
MultiGrid::set_rtol_b (Real rtol)
{
rtol_b = rtol;
}
inline
Real
MultiGrid::get_rtol_b () const
{
return rtol_b;
}
inline
void
MultiGrid::set_maxiter_b (int n)
{
maxiter_b = n;
}
inline
int
MultiGrid::get_maxiter_b () const
{
return maxiter_b;
}
inline
void
MultiGrid::set_nu_b (int _nu_b)
{
nu_b = _nu_b;
}
inline
int
MultiGrid::get_nu_b () const
{
return nu_b;
}
inline
void
MultiGrid::setCGSolver (CGSolver::Solver cg_solver_)
{
cg_solver = cg_solver_;
}
inline
CGSolver::Solver
MultiGrid::getCGSolver () const
{
return cg_solver;
}
inline
int
MultiGrid::getNumLevels (int _numlevels)
{
BL_ASSERT(_numlevels >= 0);
int oldnumlevels = numlevels;
numlevels = std::min(_numlevels, numLevels());
return oldnumlevels;
}
#endif /*_MULTIGRID_H_*/
ccseapps-2.5/CCSEApps/mglib/MG_2D.F 0000644 0001750 0001750 00000006001 11634153073 017705 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: MG_2D.F,v 1.3 1999/02/03 00:39:25 lijewski Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
#include
#include "MG_F.H"
#include "ArrayLim.H"
c-----------------------------------------------------------------------
subroutine FORT_AVERAGE (
$ c, DIMS(c),
$ f, DIMS(f),
$ lo, hi, nc
$ )
integer nc
integer DIMDEC(f)
integer DIMDEC(c)
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
REAL_T f(DIMV(f),nc)
REAL_T c(DIMV(c),nc)
c
integer i
integer j
integer n
REAL_T denom
parameter(denom=fourth)
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
c(i,j,n) = (
$ f(2*i+1,2*j+1,n) + f(2*i ,2*j+1,n)
$ + f(2*i+1,2*j,n ) + f(2*i ,2*j ,n))*denom
end do
end do
end do
c
end
c-----------------------------------------------------------------------
subroutine FORT_INTERP (
$ f, DIMS(f),
$ c, DIMS(c),
$ lo, hi, nc
$ )
integer nc
integer DIMDEC(f)
integer DIMDEC(c)
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
REAL_T f(DIMV(f),nc)
REAL_T c(DIMV(c),nc)
c
integer i
integer j
integer n
c
do n = 1, nc
do j = lo(2), hi(2)
cdir$ ivdep
do i = lo(1), hi(1)
f(2*i+1,2*j+1,n) = c(i,j,n) + f(2*i+1,2*j+1,n)
f(2*i ,2*j+1,n) = c(i,j,n) + f(2*i ,2*j+1,n)
f(2*i+1,2*j ,n) = c(i,j,n) + f(2*i+1,2*j ,n)
f(2*i ,2*j ,n) = c(i,j,n) + f(2*i ,2*j ,n)
end do
end do
end do
c
end
ccseapps-2.5/CCSEApps/mglib/BndryData.cpp 0000644 0001750 0001750 00000022553 11634153073 021334 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: BndryData.cpp,v 1.17 2002/11/26 22:47:22 lijewski Exp $
//
#include
#include
#include
#include
#include
// Mask info required for this many cells past grid edge
// (here, e.g. ref=4, crse stencil width=3, and let stencil slide 2 past grid edge)
int BndryData::NTangHalfWidth = 5;
BndryData::BndryData (const BoxArray& _grids,
int _ncomp,
const Geometry& _geom)
:
geom(_geom)
{
define(_grids,_ncomp,_geom);
}
void
BndryData::init (const BndryData& src)
{
//
// Got to save the geometric info.
//
geom = src.geom;
//
// Redefine grids and bndry array.
//
const int ngrd = grids.size();
const int ncomp = src.nComp();
for (OrientationIter fi; fi; ++fi)
{
const Orientation face = fi();
bcond[face].resize(ngrd);
for (int grd = 0; grd < ngrd; ++grd)
{
bcond[face][grd].resize(ncomp);
for (int n = 0; n < ncomp; ++n)
bcond[face][grd][n] = src.bcond[face][grd][n];
}
bcloc[face].resize(ngrd);
masks[face].resize(ngrd);
for (FabSetIter bfsi(bndry[face]); bfsi.isValid(); ++bfsi)
{
const int grd = bfsi.index();
bcloc[face][grd] = src.bcloc[face][grd];
const Mask& src_mask = src.masks[face][grd];
Mask* m = new Mask(src_mask.box(),src_mask.nComp());
m->copy(src_mask);
masks[face].set(grd,m);
}
}
}
BndryData::BndryData (const BndryData& src)
:
BndryRegister(src)
{
init(src);
}
BndryData&
BndryData::operator= (const BndryData& src)
{
BndryRegister::operator=(src);
clear_masks();
init(src);
return *this;
}
BndryData::~BndryData ()
{
//
// Masks was not allocated with PArrayManage -- manually dealloc.
//
clear_masks();
}
void
BndryData::clear_masks ()
{
for (OrientationIter oitr; oitr; oitr++)
{
const Orientation face = oitr();
for (int k = 0; k < masks[face].size(); k++)
{
if (masks[face].defined(k))
{
delete masks[face].remove(k);
}
}
}
}
void
BndryData::define (const BoxArray& _grids,
int _ncomp,
const Geometry& _geom)
{
geom = _geom;
BndryRegister::setBoxes(_grids);
const int ngrd = grids.size();
BL_ASSERT(ngrd > 0);
Array pshifts(27);
for (OrientationIter fi; fi; ++fi)
{
const Orientation face = fi();
const int coord_dir = face.coordDir();
masks[face].resize(ngrd);
bcloc[face].resize(ngrd);
bcond[face].resize(ngrd);
for (int ig = 0; ig < ngrd; ++ig)
{
bcond[face][ig].resize(_ncomp);
}
BndryRegister::define(face,IndexType::TheCellType(),0,1,0,_ncomp);
//
// Alloc mask and set to quad_interp value.
//
for (FabSetIter bfsi(bndry[face]); bfsi.isValid(); ++bfsi)
{
Box face_box = BoxLib::adjCell(grids[bfsi.index()], face, 1);
//
// Extend box in directions orthogonal to face normal.
//
for (int dir = 0; dir < BL_SPACEDIM; dir++)
{
if (dir == coord_dir)
continue;
face_box.grow(dir,NTangHalfWidth);
}
Mask* m = new Mask(face_box);
m->setVal(outside_domain,0);
Box dbox = geom.Domain() & face_box;
m->setVal(not_covered,dbox,0);
//
// Now have to set as not_covered the periodic translates as well.
//
if (geom.isAnyPeriodic())
{
geom.periodicShift(geom.Domain(), face_box, pshifts);
for (int iiv = 0; iiv < pshifts.size(); iiv++)
{
m->shift(pshifts[iiv]);
Box target = geom.Domain() & m->box();
m->setVal(not_covered,target,0);
m->shift(-pshifts[iiv]);
}
}
masks[face].set(bfsi.index(),m);
//
// Turn mask off on intersection with grids at this level.
//
for (int g = 0; g < ngrd; g++)
{
Box ovlp = grids[g] & face_box;
if (ovlp.ok())
{
m->setVal(covered,ovlp,0);
}
}
//
// Handle special cases if is periodic.
//
if (geom.isAnyPeriodic() && !geom.Domain().contains(face_box))
{
geom.periodicShift(geom.Domain(), face_box, pshifts);
for (int iiv = 0; iiv < pshifts.size(); iiv++)
{
m->shift(pshifts[iiv]);
for (int g = 0; g < ngrd; g++)
{
Box ovlp = grids[g] & m->box();
if (ovlp.ok())
{
m->setVal(covered,ovlp,0);
}
}
m->shift(-pshifts[iiv]);
}
}
}
}
}
std::ostream&
operator<< (std::ostream& os,
const BndryData& bd)
{
if (ParallelDescriptor::NProcs() != 1)
BoxLib::Abort("BndryData::operator<<(): not implemented in parallel");
const BoxArray& grds = bd.boxes();
const int ngrds = grds.size();
const int ncomp = bd.bcond[0][0].size();
os << "[BndryData with " << ngrds << " grids and " << ncomp << " comps:\n";
for (int grd = 0; grd < ngrds; grd++)
{
for (OrientationIter face; face; ++face)
{
Orientation f = face();
os << "::: face " << f << " of grid " << grds[grd] << "\nBC = ";
for (int i = 0; i < ncomp; ++i)
os << bd.bcond[f][grd][i] << ' ';
os << " LOC = " << bd.bcloc[f][grd] << '\n';
os << bd.masks[f][grd];
os << bd.bndry[f][grd];
}
os << "------------------------------------------------" << std::endl;
}
return os;
}
void
BndryData::writeOn (std::ostream& os) const
{
int ngrds = grids.size();
int ncomp = bcond[0][0].size();
os << ngrds << " " << ncomp << std::endl;
for (int grd = 0; grd < ngrds; grd++)
{
os << grids[grd] << std::endl;
}
os << geom << std::endl;
for (int grd = 0; grd < ngrds; grd++)
{
for (OrientationIter face; face; ++face)
{
Orientation f = face();
for (int cmp = 0; cmp < ncomp; cmp++)
os << bcond[f][grd][cmp] << " ";
os << std::endl;
os << bcloc[f][grd] << std::endl;
}
}
for (OrientationIter face; face; ++face)
{
Orientation f = face();
for (int grd = 0; grd < ngrds; grd++)
{
masks[f][grd].writeOn(os);
bndry[f][grd].writeOn(os);
}
}
}
void
BndryData::readFrom (std::istream& is)
{
int tmpNgrids, tmpNcomp;
is >> tmpNgrids >> tmpNcomp;
BoxArray tmpBa(tmpNgrids);
for (int grd = 0; grd < tmpNgrids; grd++)
{
Box readBox;
is >> readBox;
tmpBa.set(grd, readBox);
}
Geometry tmpGeom;
is >> tmpGeom;
define(tmpBa, tmpNcomp, tmpGeom);
for (int grd = 0; grd < tmpNgrids; grd++)
{
for (OrientationIter face; face; ++face)
{
Orientation f = face();
int intBc;
for (int cmp = 0; cmp < tmpNcomp; cmp++)
{
is >> intBc;
setBoundCond(f, grd, cmp, BoundCond(intBc));
}
Real realBcLoc;
is >> realBcLoc;
setBoundLoc(f, grd, realBcLoc);
}
}
for (OrientationIter face; face; ++face)
{
Orientation f = face();
for (int grd = 0; grd < tmpNgrids; grd++)
{
masks[f][grd].readFrom(is);
bndry[f][grd].readFrom(is);
}
}
}
ccseapps-2.5/CCSEApps/mglib/BoundCond.H 0000644 0001750 0001750 00000005400 11634153073 020734 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _BOUNDCOND_H_
#define _BOUNDCOND_H_
//
// $Id: BoundCond.H,v 1.8 2000/10/02 20:51:15 lijewski Exp $
//
#include
//@Man:
/*@Memo:
Maintain an identifier for boundary condition types.
*/
/*@Doc:
This is a placeholder for more extensive boundary condition
implementations, which might include stencils, etc. Presently,
boundary conditions are specified via an integer identifier.
This class maintains that integer.
*/
class BoundCond
{
public:
//
//@ManDoc: Initializes boundary condition type to default.
//
BoundCond () : bctype(-1) {}
//
//@ManDoc: Initializes boundary condition type to specified value.
//
BoundCond (int _bctype) : bctype(_bctype) {}
//
//@ManDoc: Copy constructor.
//
BoundCond (const BoundCond& rhs) : bctype(rhs.bctype) {}
//
//@ManDoc: Copy assignment operator.
//
BoundCond& operator= (const BoundCond& rhs)
{
if (!(this == &rhs))
{
bctype = rhs.bctype;
}
return *this;
}
//
//@ManDoc: Return index of boundary condition type.
//
operator int () const
{
BL_ASSERT(bctype != -1);
return bctype;
}
//
//@ManDoc: Set index of boundary condition type.
//
BoundCond& operator= (const int _bctype)
{
bctype = _bctype;
return *this;
}
private:
//
// Index of boundary condition type.
//
int bctype;
};
#endif /*_BOUNDCOND_H_*/
ccseapps-2.5/CCSEApps/mglib/Laplacian.H 0000644 0001750 0001750 00000007556 11634153073 020763 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _LAPLACIAN_H_
#define _LAPLACIAN_H_
//
// $Id: Laplacian.H,v 1.6 2000/10/02 20:51:16 lijewski Exp $
//
#include
//@Man:
/*@Memo:
A Laplacian tailors the description of a linear operator to apply
the second-order central difference approximation to the laplacian
differential operator on a cell-centered MultiFab of data
*/
/*@Doc:
A Laplacian tailors a LinOp (a virtual base class for general linear
operators) to compute the second-order central difference
approximation to the laplacian differential operator,
L(phi) = div(grad(phi)), on a cell-centered MultiFab, phi. This class
provides the necessary implementations for applying the operator and
for smoothing a guessed solution for the linear
equation system, L(phi) = rhs (where rhs is another cell-centered
MultiFab). These customizations are designed for 2D and 3D, with
uniform, constant mesh spacing in all directions.
Application of the operator and smoothing are
"level" operations, and therefore must access "hidden" level data
(such as boundary conditions, etc) as required, in concert with the
semantics of the underlying LinOp defintions. Accordingly, these
implementations are "protected" and called only by the publically
accessible members of the virtual base class, LinOp. Note that these
implementations may therefore assume that boundary (ghost) nodes and
other pertinent information are filled properly by the base class
functions prior to call.
This class does NOT provide a copy constructor or assignment operator.
*/
class Laplacian
:
public LinOp
{
public:
//
//@ManDoc: constructor (merely falls through to LinOp constructor)
//
Laplacian (const BndryData& bd,
Real _h)
:
LinOp(bd,_h) {}
//
//@ManDoc: destructor
//
~Laplacian() {}
//
//@ManDoc: Compute flux associated with the op
//
virtual void compFlux (D_DECL(MultiFab &xflux, MultiFab &yflux, MultiFab &zflux),
MultiFab& in, const BC_Mode& bc_mode);
virtual Real norm (int nm = 0, int level = 0);
protected:
//
//@ManDoc: compute out=L(in) at level=level
//
virtual void Fapply (MultiFab& out,
const MultiFab& in,
int level);
//
//@ManDoc: apply smoother to improve residual to L(solnL)=rhsL
//
virtual void Fsmooth (MultiFab& solnL,
const MultiFab& rhsL,
int level,
int rgbflag);
};
#endif /*_LAPLACIAN_H_*/
ccseapps-2.5/CCSEApps/mglib/ABec_UTIL.F 0000644 0001750 0001750 00000004336 11634153073 020515 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: ABec_UTIL.F,v 1.3 2003/02/18 20:54:40 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
c-----------------------------------------------------------------------
c
c Tridiagonal solve
c
subroutine tridiag(a,b,c,r,u,n)
integer n
integer nmax
REAL_T a(n)
REAL_T b(n)
REAL_T c(n)
REAL_T r(n)
REAL_T u(n)
parameter (nmax = 4098)
integer j
REAL_T bet
REAL_T gam(nmax)
if (n .gt. nmax ) call bl_error('tridiag: size exceeded')
if (b(1) .eq. 0) call bl_error('tridiag: CANT HAVE B(1) = ZERO')
bet = b(1)
u(1) = r(1)/bet
do j = 2,n
gam(j) = c(j-1)/bet
bet = b(j) - a(j)*gam(j)
if (bet .eq. 0) call bl_error('tridiag: TRIDIAG FAILED')
u(j) = (r(j)-a(j)*u(j-1))/bet
end do
do j = n-1,1,-1
u(j) = u(j) - gam(j+1)*u(j+1)
end do
return
end
ccseapps-2.5/CCSEApps/mglib/INTERPBNDRYDATA_2D.F 0000644 0001750 0001750 00000056677 11634153073 021664 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: INTERPBNDRYDATA_2D.F,v 1.3 2002/10/19 18:33:57 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include "BC_TYPES.H"
#include "REAL.H"
#include "CONSTANTS.H"
#include "INTERPBNDRYDATA_F.H"
#include "ArrayLim.H"
#define USE_REORG_VERSION
#define SDIM 2
#define NUMDERIV 2
#define XDER 1
#define X2DER 2
c ---------------------------------------------------------------
c :: FORT_BDINTERPXLO : Interpolation on Xlo Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(2) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array
c ---------------------------------------------------------------
subroutine FORT_BDINTERPXLO (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(2), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(mask)
integer DIMDEC(crse)
integer DIMDEC(cb)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM2(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, ainterp
integer i, j, ic, jc, off, n
integer jclo, jchi, ratioy
#ifndef USE_REORG_VERSION
ratioy = ratios(2)
jclo = ARG_L2(cb)
jchi = ARG_H2(cb)
ic = ARG_L1(cb)-1
i = lo(1)-1
do n = 1, nvar
c ::::: define interp coefs
do jc = jclo, jchi
j = ratioy*jc
derives(jc,XDER) = half * (crse(ic,jc+1,n) - crse(ic,jc-1,n))
derives(jc,X2DER) = crse(ic,jc+1,n)
& - crse(ic,jc ,n) * two
& + crse(ic,jc-1,n)
if (mask(i,j-1) .ne. not_covered) then
derives(jc,XDER) = crse(ic,jc+1,n) - crse(ic,jc ,n)
derives(jc,X2DER) = zero
c Can we do better by sliding stencil up?
if (mask(i,j+2*ratioy) .eq. not_covered) then
derives(jc,XDER) = half*(-three*crse(ic,jc,n)
& + four*crse(ic,jc+1,n)
& - crse(ic,jc+2,n))
derives(jc,X2DER) = crse(ic,jc+2,n)
& - crse(ic,jc+1,n) * two
& + crse(ic ,jc,n)
end if
end if
if (mask(i,j+ratioy) .ne. not_covered) then
derives(jc,XDER) = crse(ic,jc ,n) - crse(ic,jc-1,n)
derives(jc,X2DER) = zero
c Can we do better by sliding stencil down?
if (mask(i,j+ratioy) .eq. not_covered) then
derives(jc,XDER) = half*(three*crse(ic,jc,n)
& - four*crse(ic,jc-1,n)
& + crse(ic,jc-2,n))
derives(jc,X2DER) = crse(ic,jc,n)
& - crse(ic,jc-1,n) * two
& + crse(ic,jc-2,n)
end if
end if
if (mask(i,j-1) .ne. not_covered .and.
$ mask(i,j+ratioy) .ne. not_covered) then
derives(jc,XDER) = zero
end if
end do
c ::::: interpolate to fine grid
do off = 0, ratioy - 1
xx = (dble(off - ratioy/2) + half)/ratioy
do jc = jclo, jchi
j = ratioy*jc + off
bdry(i,j,n) = crse(ic,jc,n)
& + derives(jc,XDER) *xx
& + half*derives(jc,X2DER)*xx**2
end do
end do
end do
#else
integer Norder, NN, m
parameter (Norder = 3)
REAL_T x(Norder), y(Norder), c(Norder), xInt
ratioy = ratios(2)
jclo = ARG_L2(cb)
jchi = ARG_H2(cb)
ic = ARG_L1(cb)-1
i = lo(1)-1
do n=1,nvar
do jc=jclo,jchi
j = ratioy*jc
NN = 1
y(NN) = crse(ic,jc,n)
x(NN) = zero
if (mask(i,j-1).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic,jc-1,n)
x(NN) = -one
else if (mask(i,j+2*ratioy).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic,jc+2,n)
x(NN) = two
endif
if (mask(i,j+ratioy).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic,jc+1,n)
x(NN) = one
else if (mask(i,j-ratioy-1).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic,jc-2,n)
x(NN) = -two
endif
if ( (mask(i,j-1).ne.not_covered).and.
& (mask(i,j+ratioy).ne.not_covered) ) NN = 1
do off = 0,ratioy-1
xInt = (dble(off - ratioy/2) + half)/ratioy
call polyInterpCoeff(xInt, x, NN, c)
bdry(i,j+off,n) = zero
do m=1,NN
bdry(i,j+off,n) = bdry(i,j+off,n) + c(m)*y(m)
end do
end do
end do
end do
#endif
return
end
c ---------------------------------------------------------------
c :: FORT_BDINTERPXHI : Interpolation on Xhi Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(2) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array
c ---------------------------------------------------------------
subroutine FORT_BDINTERPXHI (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(2), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(mask)
integer DIMDEC(cb)
integer DIMDEC(crse)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM2(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, ainterp
integer i, j, ic, jc, off, n
integer jclo, jchi, ratioy
#ifndef USE_REORG_VERSION
ratioy = ratios(2)
jclo = ARG_L2(cb)
jchi = ARG_H2(cb)
ic = ARG_H1(cb)+1
i = hi(1)+1
do n = 1, nvar
c ::::: define interp coefs
do jc = jclo, jchi
j = ratioy*jc
derives(jc,XDER) = half * (crse(ic,jc+1,n) - crse(ic,jc-1,n))
derives(jc,X2DER) = crse(ic,jc+1,n)
& - crse(ic,jc ,n) * two
& + crse(ic,jc-1,n)
if (mask(i,j-1) .ne. not_covered) then
derives(jc,XDER) = crse(ic,jc+1,n) - crse(ic,jc ,n)
derives(jc,X2DER) = zero
c Can we do better by sliding stencil up?
if (mask(i,j+2*ratioy) .eq. not_covered) then
derives(jc,XDER) = half*(-three*crse(ic,jc,n)
& + four*crse(ic,jc+1,n)
& - crse(ic,jc+2,n))
derives(jc,X2DER) = crse(ic,jc+2,n)
& - crse(ic,jc+1,n) * two
& + crse(ic ,jc,n)
end if
end if
if (mask(i,j+ratioy) .ne. not_covered) then
derives(jc,XDER) = crse(ic,jc ,n) - crse(ic,jc-1,n)
derives(jc,X2DER) = zero
c Can we do better by sliding stencil down?
if (mask(i,j+ratioy) .eq. not_covered) then
derives(jc,XDER) = half*(three*crse(ic,jc,n)
& - four*crse(ic,jc-1,n)
& + crse(ic,jc-2,n))
derives(jc,X2DER) = crse(ic,jc,n)
& - crse(ic,jc-1,n) * two
& + crse(ic,jc-2,n)
end if
end if
if (mask(i,j-1) .ne. not_covered .and.
$ mask(i,j+ratioy) .ne. not_covered) then
derives(jc,XDER) = zero
derives(jc,X2DER) = zero
end if
end do
c ::::: interpolate to fine grid
do off = 0, ratioy - 1
xx = (dble(off - ratioy/2) + half)/ratioy
do jc = jclo, jchi
j = ratioy*jc + off
bdry(i,j,n) = crse(ic,jc,n)
& + derives(jc,XDER) *xx
& + half*derives(jc,X2DER)*xx**2
end do
end do
end do
#else
integer Norder, NN, m
parameter (Norder = 3)
REAL_T x(Norder), y(Norder), c(Norder), xInt
ratioy = ratios(2)
jclo = ARG_L2(cb)
jchi = ARG_H2(cb)
ic = ARG_H1(cb)+1
i = hi(1)+1
do n=1,nvar
do jc=jclo,jchi
j = ratioy*jc
NN = 1
y(NN) = crse(ic,jc,n)
x(NN) = zero
if (mask(i,j-1).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic,jc-1,n)
x(NN) = -one
else if (mask(i,j+2*ratioy).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic,jc+2,n)
x(NN) = two
endif
if (mask(i,j+ratioy).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic,jc+1,n)
x(NN) = one
else if (mask(i,j-ratioy-1).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic,jc-2,n)
x(NN) = -two
endif
if ( (mask(i,j-1).ne.not_covered).and.
& (mask(i,j+ratioy).ne.not_covered) ) NN = 1
do off = 0,ratioy-1
xInt = (dble(off - ratioy/2) + half)/ratioy
call polyInterpCoeff(xInt, x, NN, c)
bdry(i,j+off,n) = zero
do m=1,NN
bdry(i,j+off,n) = bdry(i,j+off,n) + c(m)*y(m)
end do
end do
end do
end do
#endif
return
end
c ---------------------------------------------------------------
c :: FORT_BDINTERPYLO : Interpolation on Ylo Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(2) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array
c ---------------------------------------------------------------
subroutine FORT_BDINTERPYLO (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(2), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(mask)
integer DIMDEC(cb)
integer DIMDEC(crse)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM1(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, ainterp
integer i, j, ic, jc, off, n
integer iclo, ichi, ratiox
#ifndef USE_REORG_VERSION
ratiox = ratios(1)
iclo = ARG_L1(cb)
ichi = ARG_H1(cb)
jc = ARG_L2(cb)-1
j = lo(2)-1
do n = 1, nvar
c ::::: define interp coefs
do ic = iclo, ichi
i = ratiox*ic
derives(ic,XDER) = half * (crse(ic+1,jc,n) - crse(ic-1,jc,n))
derives(ic,X2DER) = crse(ic+1,jc,n)
& - crse(ic ,jc,n) * two
& + crse(ic-1,jc,n)
if (mask(i-1,j) .ne. not_covered) then
derives(ic,XDER) = crse(ic+1,jc,n) - crse(ic ,jc,n)
derives(ic,X2DER) = zero
c Can we do better by sliding stencil to the right
if (mask(i+2*ratiox,j) .eq. not_covered) then
derives(ic,XDER) = half*(-three*crse(ic,jc,n)
& + four*crse(ic+1,jc,n)
& - crse(ic+2,jc,n))
derives(ic,X2DER) = crse(ic+2,jc,n)
& - crse(ic+1,jc,n) * two
& + crse(ic ,jc,n)
end if
end if
if (mask(i+ratiox,j) .ne. not_covered) then
derives(ic,XDER) = crse(ic ,jc,n) - crse(ic-1,jc,n)
derives(ic,X2DER) = zero
end if
c Can we do better by sliding stencil to the left
if (mask(i-ratiox,j) .eq. not_covered) then
derives(ic,XDER) = half*(three*crse(ic,jc,n)
& - four*crse(ic-1,jc,n)
& + crse(ic-2,jc,n))
derives(ic,X2DER) = crse(ic,jc,n)
& - crse(ic-1,jc,n) * two
& + crse(ic-2,jc,n)
end if
if (mask(i-1,j) .ne. not_covered .and.
$ mask(i+ratiox,j) .ne. not_covered) then
derives(ic,XDER) = zero
derives(ic,X2DER) = zero
end if
end do
c ::::: interpolate to fine grid
do off = 0, ratiox - 1
xx = (dble(off - ratiox/2) + half)/ratiox
do ic = iclo, ichi
i = ratiox*ic + off
bdry(i,j,n) = crse(ic,jc,n)
& + derives(ic,XDER) *xx
& + half*derives(ic,X2DER)*xx**2
end do
end do
end do
#else
integer Norder, NN, m
parameter (Norder = 3)
REAL_T x(Norder), y(Norder), c(Norder), xInt
ratiox = ratios(1)
iclo = ARG_L1(cb)
ichi = ARG_H1(cb)
jc = ARG_L2(cb)-1
j = lo(2)-1
do n=1,nvar
do ic=iclo,ichi
i = ratiox*ic
NN = 1
y(NN) = crse(ic,jc,n)
x(NN) = zero
if (mask(i-1,j).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic-1,jc,n)
x(NN) = -one
else if (mask(i+2*ratiox,j).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic+2,jc,n)
x(NN) = two
endif
if (mask(i+ratiox,j).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic+1,jc,n)
x(NN) = one
else if (mask(i-ratiox-1,j).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic-2,jc,n)
x(NN) = -two
endif
if ( (mask(i-1,j).ne.not_covered).and.
& (mask(i+ratiox,j).ne.not_covered) ) NN = 1
do off = 0,ratiox-1
xInt = (dble(off - ratiox/2) + half)/ratiox
call polyInterpCoeff(xInt, x, NN, c)
bdry(i+off,j,n) = zero
do m=1,NN
bdry(i+off,j,n) = bdry(i+off,j,n) + c(m)*y(m)
end do
end do
end do
end do
#endif
return
end
c ---------------------------------------------------------------
c :: FORT_BDINTERPYHI : Interpolation on Yhi Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(2) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array
c ---------------------------------------------------------------
subroutine FORT_BDINTERPYHI (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(2), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(mask)
integer DIMDEC(cb)
integer DIMDEC(crse)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM1(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, ainterp
integer i, j, ic, jc, off, n
integer iclo, ichi, ratiox
#ifndef USE_REORG_VERSION
ratiox = ratios(1)
iclo = ARG_L1(cb)
ichi = ARG_H1(cb)
jc = ARG_H2(cb)+1
j = hi(2)+1
do n = 1, nvar
c ::::: define interp coefs
do ic = iclo, ichi
i = ratiox*ic
derives(ic,XDER) = half * (crse(ic+1,jc,n) - crse(ic-1,jc,n))
derives(ic,X2DER) = crse(ic+1,jc,n)
& - crse(ic ,jc,n) * two
& + crse(ic-1,jc,n)
if (mask(i-1,j) .ne. not_covered) then
derives(ic,XDER) = crse(ic+1,jc,n) - crse(ic ,jc,n)
derives(ic,X2DER) = zero
c Can we do better by sliding stencil to the right
if (mask(i+2*ratiox,j) .eq. not_covered) then
derives(ic,XDER) = half*(-three*crse(ic,jc,n)
& + four*crse(ic+1,jc,n)
& - crse(ic+2,jc,n))
derives(ic,X2DER) = crse(ic+2,jc,n)
& - crse(ic+1,jc,n) * two
& + crse(ic ,jc,n)
end if
end if
if (mask(i+ratiox,j) .ne. not_covered) then
derives(ic,XDER) = crse(ic ,jc,n) - crse(ic-1,jc,n)
derives(ic,X2DER) = zero
c Can we do better by sliding stencil to the left
if (mask(i-ratiox,j) .eq. not_covered) then
derives(ic,XDER) = half*(three*crse(ic,jc,n)
& - four*crse(ic-1,jc,n)
& + crse(ic-2,jc,n))
derives(ic,X2DER) = crse(ic,jc,n)
& - crse(ic-1,jc,n) * two
& + crse(ic-2,jc,n)
end if
end if
if (mask(i-1,j) .ne. not_covered .and.
$ mask(i+ratiox,j) .ne. not_covered) then
derives(ic,XDER) = zero
derives(ic,X2DER) = zero
end if
end do
c ::::: interpolate to fine grid
do off = 0, ratiox - 1
xx = (dble(off - ratiox/2) + half)/ratiox
do ic = iclo, ichi
i = ratiox*ic + off
bdry(i,j,n) = crse(ic,jc,n)
& + derives(ic,XDER) *xx
& + half*derives(ic,X2DER)*xx**2
end do
end do
end do
#else
integer Norder, NN, m
parameter (Norder = 3)
REAL_T x(Norder), y(Norder), c(Norder), xInt
ratiox = ratios(1)
iclo = ARG_L1(cb)
ichi = ARG_H1(cb)
jc = ARG_H2(cb)+1
j = hi(2)+1
do n=1,nvar
do ic=iclo,ichi
i = ratiox*ic
NN = 1
y(NN) = crse(ic,jc,n)
x(NN) = zero
if (mask(i-1,j).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic-1,jc,n)
x(NN) = -one
else if (mask(i+2*ratiox,j).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic+2,jc,n)
x(NN) = two
endif
if (mask(i+ratiox,j).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic+1,jc,n)
x(NN) = one
else if (mask(i-ratiox-1,j).eq.not_covered) then
NN=NN+1
y(NN) = crse(ic-2,jc,n)
x(NN) = -two
endif
if ( (mask(i-1,j).ne.not_covered).and.
& (mask(i+ratiox,j).ne.not_covered) ) NN = 1
do off = 0,ratiox-1
xInt = (dble(off - ratiox/2) + half)/ratiox
call polyInterpCoeff(xInt, x, NN, c)
bdry(i+off,j,n) = zero
do m=1,NN
bdry(i+off,j,n) = bdry(i+off,j,n) + c(m)*y(m)
end do
end do
end do
end do
#endif
return
end
ccseapps-2.5/CCSEApps/mglib/ABec_3D.F 0000644 0001750 0001750 00000051055 11634153073 020206 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: ABec_3D.F,v 1.8 2002/11/27 21:54:35 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
#include "ABec_F.H"
#include "ArrayLim.H"
#include "CONSTANTS.H"
c-----------------------------------------------------------------------
c
c Gauss-Seidel Red-Black (GSRB):
c Apply the GSRB relaxation to the state phi for the equation
c L(phi) = alpha*a(x)*phi(x) - beta*Div(b(x)Grad(phi(x))) = rhs(x)
c central differenced, according to the arrays of boundary
c masks (m#) and auxiliary data (f#).
c
c In general, if the linear operator L=gamma*y-rho, the GS relaxation
c is y = (R - rho)/gamma. Near a boundary, the ghost data is filled
c using a polynomial interpolant based on the "old" phi values, so
c L=(gamma-delta)*y - rho + delta*yOld. The resulting iteration is
c
c y = (R - delta*yOld + rho)/(gamma - delta)
c
c This expression is valid additionally in the interior provided
c delta->0 there. delta is constructed by summing all the
c contributions to the central stencil element coming from boundary
c interpolants. The f#s contain the corresponding coefficient of
c the interpolating polynomial. The masks are set > 0 if the boundary
c value was filled with an interpolant involving the central stencil
c element.
c
c-----------------------------------------------------------------------
subroutine FORT_GSRB (
$ phi,DIMS(phi),
$ rhs,DIMS(rhs),
$ alpha, beta,
$ a, DIMS(a),
$ bX, DIMS(bX),
$ bY, DIMS(bY),
$ bZ, DIMS(bZ),
$ f0, DIMS(f0),
$ m0, DIMS(m0),
$ f1, DIMS(f1),
$ m1, DIMS(m1),
$ f2, DIMS(f2),
$ m2, DIMS(m2),
$ f3, DIMS(f3),
$ m3, DIMS(m3),
$ f4, DIMS(f4),
$ m4, DIMS(m4),
$ f5, DIMS(f5),
$ m5, DIMS(m5),
$ lo,hi,nc,
$ h,redblack
$ )
REAL_T alpha, beta
integer DIMDEC(phi)
integer DIMDEC(rhs)
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
integer DIMDEC(bZ)
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM)
integer nc
integer redblack
integer DIMDEC(f0)
REAL_T f0(DIMV(f0))
integer DIMDEC(f1)
REAL_T f1(DIMV(f1))
integer DIMDEC(f2)
REAL_T f2(DIMV(f2))
integer DIMDEC(f3)
REAL_T f3(DIMV(f3))
integer DIMDEC(f4)
REAL_T f4(DIMV(f4))
integer DIMDEC(f5)
REAL_T f5(DIMV(f5))
integer DIMDEC(m0)
integer m0(DIMV(m0))
integer DIMDEC(m1)
integer m1(DIMV(m1))
integer DIMDEC(m2)
integer m2(DIMV(m2))
integer DIMDEC(m3)
integer m3(DIMV(m3))
integer DIMDEC(m4)
integer m4(DIMV(m4))
integer DIMDEC(m5)
integer m5(DIMV(m5))
REAL_T h(BL_SPACEDIM)
REAL_T phi(DIMV(phi),nc)
REAL_T rhs(DIMV(rhs),nc)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
REAL_T bZ(DIMV(bZ))
c
integer i, j, k, ioff, n
c
REAL_T dhx, dhy, dhz, cf0, cf1, cf2, cf3, cf4, cf5
REAL_T delta, gamma, rho, rho_xy, rho_yz, rho_xz
c
integer do_line
integer LSDIM
parameter (LSDIM=127)
REAL_T a_ls(0:LSDIM)
REAL_T b_ls(0:LSDIM)
REAL_T c_ls(0:LSDIM)
REAL_T r_ls(0:LSDIM)
REAL_T u_ls(0:LSDIM)
integer ilen,jlen,klen
ilen = hi(1)-lo(1)+1
jlen = hi(2)-lo(2)+1
klen = hi(3)-lo(3)+1
#if 0
if (klen .gt. ilen .and. klen .gt. jlen) then
do_line = 3
if (klen .gt. LSDIM) then
print *,'TOO BIG FOR LINE SOLVE IN GSRB: klen = ',klen
call bl_error("stop")
endif
else if (jlen .gt. ilen .and. jlen .gt. klen) then
do_line = 2
if (jlen .gt. LSDIM) then
print *,'JLEN TOO BIG FOR LINE SOLVE IN GSRB: jlen = ',jlen
call bl_error("stop")
endif
else if (ilen .gt. jlen .and. ilen .gt. klen) then
do_line = 1
if (ilen .gt. LSDIM) then
print *,'ILEN TOO BIG FOR LINE SOLVE IN GSRB: ilen = ',ilen
call bl_error("stop")
endif
else
do_line = 0
endif
#endif
do_line = 0
dhx = beta/h(1)**2
dhy = beta/h(2)**2
dhz = beta/h(3)**2
do n = 1, nc
if (do_line .eq. 0) then
do k = lo(3), hi(3)
do j = lo(2), hi(2)
ioff = MOD(j + k + redblack,2)
do i = lo(1) + ioff,hi(1),2
c
cf0 = cvmgt(f0(lo(1),j,k), 0.0D0,
$ (i .eq. lo(1)) .and. (m0(lo(1)-1,j,k).gt.0))
cf1 = cvmgt(f1(i,lo(2),k), 0.D00,
$ (j .eq. lo(2)) .and. (m1(i,lo(2)-1,k).gt.0))
cf2 = cvmgt(f2(i,j,lo(3)), 0.0D0,
$ (k .eq. lo(3)) .and. (m2(i,j,lo(3)-1).gt.0))
cf3 = cvmgt(f3(hi(1),j,k), 0.0D0,
$ (i .eq. hi(1)) .and. (m3(hi(1)+1,j,k).gt.0))
cf4 = cvmgt(f4(i,hi(2),k), 0.0D0,
$ (j .eq. hi(2)) .and. (m4(i,hi(2)+1,k).gt.0))
cf5 = cvmgt(f5(i,j,hi(3)), 0.0D0,
$ (k .eq. hi(3)) .and. (m5(i,j,hi(3)+1).gt.0))
c
delta = dhx*(bX(i,j,k)*cf0 + bX(i+1,j,k)*cf3)
$ + dhy*(bY(i,j,k)*cf1 + bY(i,j+1,k)*cf4)
$ + dhz*(bZ(i,j,k)*cf2 + bZ(i,j,k+1)*cf5)
c
gamma = alpha*a(i,j,k)
$ + dhx*(bX(i,j,k)+bX(i+1,j,k))
$ + dhy*(bY(i,j,k)+bY(i,j+1,k))
$ + dhz*(bZ(i,j,k)+bZ(i,j,k+1))
c
rho = dhx*( bX(i ,j,k)*phi(i-1,j,k,n)
$ + bX(i+1,j,k)*phi(i+1,j,k,n) )
$ + dhy*( bY(i,j ,k)*phi(i,j-1,k,n)
$ + bY(i,j+1,k)*phi(i,j+1,k,n) )
$ + dhz*( bZ(i,j,k )*phi(i,j,k-1,n)
$ + bZ(i,j,k+1)*phi(i,j,k+1,n) )
c
phi(i,j,k,n) = (rhs(i,j,k,n)+rho-phi(i,j,k,n)*delta)
$ / (gamma - delta)
c
end do
end do
end do
else if (do_line .eq. 3) then
do j = lo(2), hi(2)
ioff = MOD(j + redblack,2)
do i = lo(1) + ioff,hi(1),2
c
do k = lo(3),hi(3)
cf0 = cvmgt(f0(lo(1),j,k), 0.0D0,
$ (i .eq. lo(1)) .and. (m0(lo(1)-1,j,k).gt.0))
cf1 = cvmgt(f1(i,lo(2),k), 0.0D0,
$ (j .eq. lo(2)) .and. (m1(i,lo(2)-1,k).gt.0))
cf2 = cvmgt(f2(i,j,lo(3)), 0.0D0,
$ (k .eq. lo(3)) .and. (m2(i,j,lo(3)-1).gt.0))
cf3 = cvmgt(f3(hi(1),j,k), 0.0D0,
$ (i .eq. hi(1)) .and. (m3(hi(1)+1,j,k).gt.0))
cf4 = cvmgt(f4(i,hi(2),k), 0.0D0,
$ (j .eq. hi(2)) .and. (m4(i,hi(2)+1,k).gt.0))
cf5 = cvmgt(f5(i,j,hi(3)), 0.0D0,
$ (k .eq. hi(3)) .and. (m5(i,j,hi(3)+1).gt.0))
c
delta = dhx*(bX(i,j,k)*cf0 + bX(i+1,j,k)*cf3)
$ + dhy*(bY(i,j,k)*cf1 + bY(i,j+1,k)*cf4)
$ + dhz*(bZ(i,j,k)*cf2 + bZ(i,j,k+1)*cf5)
c
gamma = alpha*a(i,j,k)
$ + dhx*(bX(i,j,k)+bX(i+1,j,k))
$ + dhy*(bY(i,j,k)+bY(i,j+1,k))
$ + dhz*(bZ(i,j,k)+bZ(i,j,k+1))
c
rho_xy = dhx*( bX(i ,j,k)*phi(i-1,j,k,n)
$ + bX(i+1,j,k)*phi(i+1,j,k,n) )
$ + dhy*( bY(i,j ,k)*phi(i,j-1,k,n)
$ + bY(i,j+1,k)*phi(i,j+1,k,n) )
a_ls(k-lo(3)) = -dhz*bZ(i,j,k)
b_ls(k-lo(3)) = gamma - delta
c_ls(k-lo(3)) = -dhz*bZ(i,j,k+1)
r_ls(k-lo(3)) = rhs(i,j,k,n) + rho_xy - phi(i,j,k,n)*delta
if (k .eq. lo(3))
$ r_ls(k-lo(3)) = r_ls(k-lo(3)) + dhz*bZ(i,j,k)*phi(i,j,k-1,n)
if (k .eq. hi(3))
$ r_ls(k-lo(3)) = r_ls(k-lo(3)) + dhz*bZ(i,j,k+1)*phi(i,j,k+1,n)
end do
c
call tridiag(a_ls,b_ls,c_ls,r_ls,u_ls,klen)
do k = lo(3),hi(3)
phi(i,j,k,n) = u_ls(k-lo(3))
end do
c
end do
end do
else if (do_line .eq. 2) then
do k = lo(3), hi(3)
ioff = MOD(k + redblack,2)
do i = lo(1) + ioff,hi(1),2
c
do j = lo(2),hi(2)
cf0 = cvmgt(f0(lo(1),j,k), 0.0D0,
$ (i .eq. lo(1)) .and. (m0(lo(1)-1,j,k).gt.0))
cf1 = cvmgt(f1(i,lo(2),k), 0.0D0,
$ (j .eq. lo(2)) .and. (m1(i,lo(2)-1,k).gt.0))
cf2 = cvmgt(f2(i,j,lo(3)), 0.0D0,
$ (k .eq. lo(3)) .and. (m2(i,j,lo(3)-1).gt.0))
cf3 = cvmgt(f3(hi(1),j,k), 0.0D0,
$ (i .eq. hi(1)) .and. (m3(hi(1)+1,j,k).gt.0))
cf4 = cvmgt(f4(i,hi(2),k), 0.0D0,
$ (j .eq. hi(2)) .and. (m4(i,hi(2)+1,k).gt.0))
cf5 = cvmgt(f5(i,j,hi(3)), 0.0D0,
$ (k .eq. hi(3)) .and. (m5(i,j,hi(3)+1).gt.0))
c
delta = dhx*(bX(i,j,k)*cf0 + bX(i+1,j,k)*cf3)
$ + dhy*(bY(i,j,k)*cf1 + bY(i,j+1,k)*cf4)
$ + dhz*(bZ(i,j,k)*cf2 + bZ(i,j,k+1)*cf5)
c
gamma = alpha*a(i,j,k)
$ + dhx*(bX(i,j,k)+bX(i+1,j,k))
$ + dhy*(bY(i,j,k)+bY(i,j+1,k))
$ + dhz*(bZ(i,j,k)+bZ(i,j,k+1))
c
rho_xz = dhx*( bX(i ,j,k)*phi(i-1,j,k,n)
$ + bX(i+1,j,k)*phi(i+1,j,k,n) )
$ + dhz*( bZ(i,j,k )*phi(i,j,k-1,n)
$ + bZ(i,j,k+1)*phi(i,j,k+1,n) )
a_ls(j-lo(2)) = -dhy*bY(i,j,k)
b_ls(j-lo(2)) = gamma - delta
c_ls(j-lo(2)) = -dhy*bY(i,j+1,k)
r_ls(j-lo(2)) = rhs(i,j,k,n) + rho_xz - phi(i,j,k,n)*delta
if (j .eq. lo(2))
$ r_ls(j-lo(2)) = r_ls(j-lo(2)) + dhy*bY(i,j,k)*phi(i,j-1,k,n)
if (j .eq. hi(2))
$ r_ls(j-lo(2)) = r_ls(j-lo(2)) + dhy*bY(i,j+1,k)*phi(i,j+1,k,n)
end do
c
call tridiag(a_ls,b_ls,c_ls,r_ls,u_ls,jlen)
do j = lo(2),hi(2)
phi(i,j,k,n) = u_ls(j-lo(2))
end do
c
end do
end do
else if (do_line .eq. 1) then
do k = lo(3), hi(3)
ioff = MOD(k + redblack,2)
do j = lo(2) + ioff,hi(2),2
c
do i = lo(1),hi(1)
cf0 = cvmgt(f0(lo(1),j,k), 0.0D0,
$ (i .eq. lo(1)) .and. (m0(lo(1)-1,j,k).gt.0))
cf1 = cvmgt(f1(i,lo(2),k), 0.0D0,
$ (j .eq. lo(2)) .and. (m1(i,lo(2)-1,k).gt.0))
cf2 = cvmgt(f2(i,j,lo(3)), 0.0D0,
$ (k .eq. lo(3)) .and. (m2(i,j,lo(3)-1).gt.0))
cf3 = cvmgt(f3(hi(1),j,k), 0.0D0,
$ (i .eq. hi(1)) .and. (m3(hi(1)+1,j,k).gt.0))
cf4 = cvmgt(f4(i,hi(2),k), 0.0D0,
$ (j .eq. hi(2)) .and. (m4(i,hi(2)+1,k).gt.0))
cf5 = cvmgt(f5(i,j,hi(3)), 0.0D0,
$ (k .eq. hi(3)) .and. (m5(i,j,hi(3)+1).gt.0))
c
delta = dhx*(bX(i,j,k)*cf0 + bX(i+1,j,k)*cf3)
$ + dhy*(bY(i,j,k)*cf1 + bY(i,j+1,k)*cf4)
$ + dhz*(bZ(i,j,k)*cf2 + bZ(i,j,k+1)*cf5)
c
gamma = alpha*a(i,j,k)
$ + dhx*(bX(i,j,k)+bX(i+1,j,k))
$ + dhy*(bY(i,j,k)+bY(i,j+1,k))
$ + dhz*(bZ(i,j,k)+bZ(i,j,k+1))
c
rho_yz = dhy*( bY(i,j ,k)*phi(i,j-1,k,n)
$ + bY(i,j+1,k)*phi(i,j+1,k,n) )
$ + dhz*( bZ(i,j,k )*phi(i,j,k-1,n)
$ + bZ(i,j,k+1)*phi(i,j,k+1,n) )
a_ls(i-lo(1)) = -dhx*bX(i,j,k)
b_ls(i-lo(1)) = gamma - delta
c_ls(i-lo(1)) = -dhx*bX(i+1,j,k)
r_ls(i-lo(1)) = rhs(i,j,k,n) + rho_yz - phi(i,j,k,n)*delta
if (i .eq. lo(1))
$ r_ls(i-lo(1)) = r_ls(i-lo(1)) + dhx*bX(i,j,k)*phi(i-1,j,k,n)
if (i .eq. hi(1))
$ r_ls(i-lo(1)) = r_ls(i-lo(1)) + dhx*bX(i+1,j,k)*phi(i+1,j,k,n)
end do
c
call tridiag(a_ls,b_ls,c_ls,r_ls,u_ls,ilen)
do i = lo(1),hi(1)
phi(i,j,k,n) = u_ls(i-lo(1))
end do
c
end do
end do
endif
end do
c
end
c-----------------------------------------------------------------------
c
c Solve Preconditioned system here
c
subroutine FORT_CGPRECND(
$ zz,DIMS(zz),
$ rho,
$ rr,DIMS(rr),
$ alpha, beta,
$ a, DIMS(a),
$ bX,DIMS(bX),
$ bY,DIMS(bY),
$ bZ,DIMS(bZ),
$ lo,hi,nc,
$ h
$ )
REAL_T alpha, beta
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(zz)
integer DIMDEC(rr)
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
integer DIMDEC(bZ)
REAL_T zz(DIMV(zz),nc)
REAL_T rr(DIMV(rr),nc)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
REAL_T bZ(DIMV(bZ))
REAL_T h(BL_SPACEDIM), rho
c
integer i,j, k, n
REAL_T de, dhx, dhy, dhz
c
rho = 0.0D0
dhx = beta/h(1)**2
dhy = beta/h(2)**2
dhz = beta/h(3)**2
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
de = 1.0D0/(alpha*a(i,j,k)
$ + dhx*(bX(i+1,j,k)+bX(i,j,k))
$ + dhy*(bY(i,j+1,k)+bY(i,j,k))
$ + dhz*(bZ(i,j,k+1)+bZ(i,j,k))
$ )
zz(i,j,k,n) = rr(i,j,k,n)*de
rho = rho + zz(i,j,k,n)*rr(i,j,k,n)
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c Fill in a matrix x vector operator here
c
subroutine FORT_ADOTX(
$ y,DIMS(y),
$ x,DIMS(x),
$ alpha, beta,
$ a, DIMS(a),
$ bX,DIMS(bX),
$ bY,DIMS(bY),
$ bZ,DIMS(bZ),
$ lo,hi,nc,
$ h
$ )
REAL_T alpha, beta
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(y)
integer DIMDEC(x)
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
integer DIMDEC(bZ)
REAL_T y(DIMV(y),nc)
REAL_T x(DIMV(x),nc)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
REAL_T bZ(DIMV(bZ))
REAL_T h(BL_SPACEDIM)
c
integer i,j,k,n
REAL_T dhx,dhy,dhz
c
dhx = beta/h(1)**2
dhy = beta/h(2)**2
dhz = beta/h(3)**2
c
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
y(i,j,k,n) = alpha*a(i,j,k)*x(i,j,k,n)
$ - dhx*
$ ( bX(i+1,j,k)*( x(i+1,j,k,n) - x(i ,j,k,n) )
$ - bX(i ,j,k)*( x(i ,j,k,n) - x(i-1,j,k,n) ) )
$ - dhy*
$ ( bY(i,j+1,k)*( x(i,j+1,k,n) - x(i,j ,k,n) )
$ - bY(i,j ,k)*( x(i,j ,k,n) - x(i,j-1,k,n) ) )
$ - dhz*
$ ( bZ(i,j,k+1)*( x(i,j,k+1,n) - x(i,j,k ,n) )
$ - bZ(i,j,k )*( x(i,j,k ,n) - x(i,j,k-1,n) ) )
end do
end do
end do
end do
end
c-----------------------------------------------------------------------
c
c Fill in a matrix x vector operator here
c
subroutine FORT_NORMA(
& res,
$ alpha, beta,
$ a, DIMS(a),
$ bX,DIMS(bX),
$ bY,DIMS(bY),
$ bZ,DIMS(bZ),
$ lo,hi,nc,
$ h
$ )
REAL_T alpha, beta, res
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
integer DIMDEC(bZ)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
REAL_T bZ(DIMV(bZ))
REAL_T h(BL_SPACEDIM)
c
integer i,j,k,n
REAL_T dhx,dhy,dhz
c
dhx = beta/h(1)**2
dhy = beta/h(2)**2
dhz = beta/h(3)**2
c
res = 0.0D0
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
res = max(res,
& abs(alpha*a(i,j,k)
& + dhx*(bX(i+1,j,k) + bX(i,j,k))
& + dhy*(bY(i,j+1,k) + bY(i,j,k))
$ - dhz*(bZ(i,j,k+1) + bZ(i,j,k)))
& + abs( -dhx*bX(i+1,j,k)) + abs( -dhx*bX(i,j,k))
& + abs( -dhy*bY(i,j+1,k)) + abs( -dhy*bY(i,j,k))
& + abs( -dhz*bZ(i,j,k+1)) + abs( -dhz*bZ(i,j,k)))
end do
end do
end do
end do
end
c-----------------------------------------------------------------------
c
c Fill in fluxes
c
subroutine FORT_FLUX(
$ x,DIMS(x),
$ alpha, beta,
$ a, DIMS(a),
$ bX,DIMS(bX),
$ bY,DIMS(bY),
$ bZ,DIMS(bZ),
$ lo,hi,nc,
$ h,
$ xflux,DIMS(xflux),
$ yflux,DIMS(yflux),
$ zflux,DIMS(zflux)
$ )
implicit none
REAL_T alpha, beta
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(x)
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
integer DIMDEC(bZ)
integer DIMDEC(xflux)
integer DIMDEC(yflux)
integer DIMDEC(zflux)
REAL_T x(DIMV(x),nc)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
REAL_T bZ(DIMV(bZ))
REAL_T xflux(DIMV(xflux),nc)
REAL_T yflux(DIMV(yflux),nc)
REAL_T zflux(DIMV(zflux),nc)
REAL_T h(BL_SPACEDIM)
c
REAL_T dhx, dhy, dhz
integer i,j,k,n
c
dhx = one/h(1)
dhy = one/h(2)
dhz = one/h(3)
c
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)+1
xflux(i,j,k,n) = - dhx*bX(i,j,k)*( x(i,j,k,n) - x(i-1,j,k,n) )
end do
end do
end do
end do
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)+1
do i = lo(1), hi(1)
yflux(i,j,k,n) = - dhy*bY(i,j,k)*( x(i,j,k,n) - x(i,j-1,k,n) )
end do
end do
end do
end do
do n = 1, nc
do k = lo(3), hi(3)+1
do j = lo(2), hi(2)
do i = lo(1), hi(1)
zflux(i,j,k,n) = - dhz*bZ(i,j,k)*( x(i,j,k,n) - x(i,j,k-1,n) )
end do
end do
end do
end do
end
ccseapps-2.5/CCSEApps/mglib/LinOp.H 0000644 0001750 0001750 00000030651 11634153073 020110 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _LINOP_H_
#define _LINOP_H_
//
// $Id: LinOp.H,v 1.15 2001/08/01 21:51:04 lijewski Exp $
//
#include
#include
#include
#include
#include
#include
#include
//@Man:
/*@Memo:
A LinOp is a virtual base class for general linear operators capable
of acting on MultiFabs. All implementation and access functions are
designed to make a LinOp object useful for representing and solving
a set of linear equations on a union of rectangles in 2D or 3D.
*/
/*@Doc:
A LinOp contains all the information necessary to construct and
maintain a linear operator which acts on a cell-centered MultiFab. It
is a virtual base class, and therefore cannot itself be
instantiated. The virtual functions implement "apply"
and "smooth" operators (for the internal nodes), and therefore
determine the mathematical character of the operator. LinOp,
on the other hand, determines the implementation,
filling ghost cells and creating coarsened versions
of the domain and operator, etc. necessary for solving linear systems.
LinOp is designed specifically for representing discrete approximations
to partial differential operators. It requires a BndryData object,
which maintains ghost cell data surrounding each rectangle in the
domain, as well as position and boundary condition type
specifiers. It also requires a (vector/scalar) grid spacing. On
levels above the base level, LinOp internally recognizes adjacent
domain rectangles (using methods similar to those in the BndryData
class) and when applying boundary conditions (filling ghost cell
regions) will give preference to "valid" data (i.e. ghost cells
covered by adjacent grids are filled with the corresponding data from
the interior of that adjacent grid rather than via the auxiliary
boundary instructions).
A LinOp constructs a set of "levels", which are useful for linear
solution methods such as multigrid. On each grid, a new level is
created by uniformly coarsening the grid structure by a factor of
two in each coordinate direction (and then allocating and initializing
any internal data necessary--new level grid spacing, for example).
A LinOp can fill boundary ghost cells, compute a "norm" and coordinate
the "apply" and "smooth" operations at each level.
Note that there are the same number of levels on each grid in the
LinOp's domain.
If a boundary type specifier indicates the type "BndryData::
LO\_DIRICHLET", the ghost cells not covered by adjacent grids are
filled on demand by a polynomial interpolant (of settable order) to
compute the value specified in the BndryData FabSets along the edge
of the grid boxes. A value is put into the ghost cell of the input
multifab that can be assumed to exist outside the domain, at equal
spacing with the rest of the nodes.
"BndryData::LO\_NEUMANN" conditions result in ghost cells filled by
second order extrapolation, and results in again filling the
ghost cell with a value appropriate for application in a constant
spacing cell-centered discretization.
The order of the interpolant is set
by default in this class to 2, which is compatible with most
simple algebraic relaxation methods for linear systems based on
numerical PDE's. The interpolant can be queried/set via member
functions, and is applied uniformly over the domain. The boundary
location is specified as a distance from the wall of the grid block,
and is given in the same units that the grid spacing, h, is specified.
All the member functions of LinOp which interact directly with the
apply() member take a BC\_Mode flag. The BC\_mode can be either
Homogeneous\_BC, or Inhomogeneous\_BC. It is a strict requirement of
the linear operator that LinOp::apply(out,in,level,bc\_mode=Homogeneous\_BC)
acting on in=0 returns out=0.
This class does NOT provide a copy constructor or assignment operator.
*/
class LinOp
{
public:
enum BC_Mode { Homogeneous_BC = 0, Inhomogeneous_BC };
//
//@ManDoc: allocate a LinOp for this box array, boundary and (uniform) spacing info
//
LinOp (const BndryData& mgb,
const Real _h);
//
//@ManDoc: allocate a LinOp for this box array, boundary data and spacing array info
//
LinOp (const BndryData& mgb,
const Real* _h);
//
//@ManDoc: alocate a LinOp w/level structure beginning at the
// specified level of this LinOp
//
LinOp (const LinOp& _Lp,
int level);
//
//@ManDoc: destructor
//
virtual ~LinOp ();
//
//@ManDoc: applies level LinOp to "in", returns "out", uses BC\_mode flag
//
virtual void apply (MultiFab& out,
MultiFab& in,
int level = 0,
LinOp::BC_Mode bc_mode = LinOp::Inhomogeneous_BC);
//
//@ManDoc: fills level boundary cells using BC\_mode flag, int. BC data if reqd
//
void applyBC (MultiFab& inout,
int src_comp,
int num_comp,
int level = 0,
LinOp::BC_Mode bc_mode = LinOp::Inhomogeneous_BC);
//
//@ManDoc: compute the level residual = rhsL - L(solnL)
//
virtual void residual (MultiFab& residL,
const MultiFab& rhsL,
MultiFab& solnL,
int level = 0,
LinOp::BC_Mode bc_mode = LinOp::Inhomogeneous_BC);
//
//@ManDoc: smooth the level system L(solnL)=rhsL
//
void smooth (MultiFab& solnL,
const MultiFab& rhsL,
int level = 0,
LinOp::BC_Mode bc_mode = LinOp::Inhomogeneous_BC);
//
// Estimate the norm of the operator
//
virtual Real norm (int nm = 0, int level = 0);
//
//@ManDoc: Compute flux associated with the op
//
virtual void compFlux (D_DECL(MultiFab &xflux, MultiFab &yflux, MultiFab &zflux),
MultiFab& in, const BC_Mode& bc_mode=Inhomogeneous_BC) = 0;
//
//@ManDoc: return the boundary data object
//
const BndryData& bndryData () const;
//
//@ManDoc: set the boundary data object
//
void bndryData (const BndryData& bd);
//
//@ManDoc: return the box array
//
const BoxArray& boxArray (int level = 0) const;
//
//@ManDoc: return the number of grids
//
int numGrids () const;
//
//@ManDoc: return the number of levels
//
int numLevels () const;
//
//@ManDoc: return the order of the boundary condition interpolant
//
int maxOrder () const;
//
//@ManDoc: set the order of the boundary condition interpolant
//
int maxOrder (int maxorder_);
//
//@ManDoc: construct/allocate internal data necessary for adding a new level
//
virtual void prepareForLevel (int level);
//
//@ManDoc: Output operator internal to an ASCII stream
//
friend std::ostream& operator<< (std::ostream& os, const LinOp& lp);
protected:
//
//@ManDoc: Remove internal data necessary for a level and all higher.
//
virtual void clearToLevel (int level) {}
//
//@ManDoc: Virtual to apply the level operator to the internal nodes of
// "in", return result in "out"
//
virtual void Fapply (MultiFab& out,
const MultiFab& in,
int level) = 0;
//
//@ManDoc: Virtual to carry out the level smoothing operation for
// L(solnL)=rhsL on internal nodes. Modify solnL in place.
//
virtual void Fsmooth (MultiFab& solnL,
const MultiFab& rhsL,
int level,
int rgbflag) = 0;
//
//@ManDoc: build coefficients at coarser level by interpolating "fine"
// (builds in appropriate node/cell centering)
//
void makeCoefficients (MultiFab& crs,
const MultiFab& fine,
int level);
//
//@ManDoc: Initialize LinOp internal data.
//
static void initialize ();
//
//@ManDoc: Helper function for object construction.
//
void initConstruct (const Real* _h);
//
//@ManDoc: Array (on level) of Tuples (on dimension) of grid spacings
//
std::vector< Tuple< Real, BL_SPACEDIM > > h;
//
//@ManDoc: Array (on level) of BoxArray's of LinOp's domain
//
std::vector< BoxArray > gbox;
//
//@ManDoc: Array (on level) of pointers to BndryRegisters along each grid
// for scratch data required to modify internal stencil on boundary
//
std::vector< CpClassPtr > undrrelxr;
//
//@ManDoc: Array (on level) of Arrays (on grid) of Arrays (on orientation)
// of pointers to Masks for whether boundary Fabs are covered,
// not\_covered, outside\_domain
//
// FIXME: This should really be an array of integer BndryRegisters
//
Array< Array< Array< Mask*> > > maskvals;
//
//@ManDoc: boundary data class
//
BndryData bgb;
//
//@ManDoc: Array (on level) of geometry objects. Needed for determining
// whether stuff intersects on periodic domains
//
std::vector< Geometry > geomarray;
//
//@ManDoc: flag (=1 if use harmonic averaged interpolation for coefficients,
// =0 is arithmetic averaging)
//
int harmavg;
//
//@ManDoc: flag (>0 is verbose execution)
//
int verbose;
//
//@ManDoc: maximum interpolation order used for constructing Dirichlet
// ghost node values
//
int maxorder;
//
//@ManDoc: flag (=1 if internal data initialized)
//
static bool initialized;
//
//@ManDoc: default value for harm\_avg
//
static int def_harmavg;
//
//@ManDoc: default value for verbose
//
static int def_verbose;
//
//@ManDoc: default maximum BC interpolant order
//
static int def_maxorder;
private:
//
// Not implemented.
//
LinOp (const LinOp& rhs);
void operator = (const LinOp& rhs);
};
inline
const BndryData&
LinOp::bndryData () const
{
return bgb;
}
inline
void
LinOp::bndryData (const BndryData& bd)
{
BL_ASSERT(gbox[0] == bd.boxes());
bgb = bd;
}
inline
int
LinOp::numLevels () const
{
return h.size();
}
inline
const BoxArray&
LinOp::boxArray (int level) const
{
BL_ASSERT(level < numLevels());
return gbox[level];
}
inline
int
LinOp::numGrids () const
{
return gbox[0].size();
}
inline
int
LinOp::maxOrder () const
{
return maxorder;
}
inline
int
LinOp::maxOrder (int maxorder_)
{
BL_ASSERT(maxorder_ >= 2);
maxorder_ = (maxorder_ < 2 ? 2 : maxorder_ );
int omaxorder = maxorder;
maxorder = maxorder_;
return omaxorder;
}
#endif /*_LINOP_H_*/
ccseapps-2.5/CCSEApps/mglib/INTERPBNDRYDATA_F.H 0000644 0001750 0001750 00000007145 11634153073 021570 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _INTERPBNDRY_F_H_
#define _INTERPBNDRY_F_H_
/*
** $Id: INTERPBNDRYDATA_F.H,v 1.3 2002/04/26 22:10:02 lijewski Exp $
*/
#ifdef BL_LANG_FORT
# define FORT_BDINTERPXLO bdintrpxlo
# define FORT_BDINTERPXHI bdintrpxhi
# if (BL_SPACEDIM > 1)
# define FORT_BDINTERPYLO bdintrpylo
# define FORT_BDINTERPYHI bdintrpyhi
# endif
# if (BL_SPACEDIM > 2)
# define FORT_BDINTERPZLO bdintrpzlo
# define FORT_BDINTERPZHI bdintrpzhi
# endif
#else
# if defined(BL_FORT_USE_UPPERCASE)
# define FORT_BDINTERPXLO BDINTRPXLO
# define FORT_BDINTERPXHI BDINTRPXHI
# if (BL_SPACEDIM > 1)
# define FORT_BDINTERPYLO BDINTRPYLO
# define FORT_BDINTERPYHI BDINTRPYHI
# endif
# if (BL_SPACEDIM > 2)
# define FORT_BDINTERPZLO BDINTRPZLO
# define FORT_BDINTERPZHI BDINTRPZHI
# endif
# elif defined(BL_FORT_USE_LOWERCASE)
# define FORT_BDINTERPXLO bdintrpxlo
# define FORT_BDINTERPXHI bdintrpxhi
# if (BL_SPACEDIM > 1)
# define FORT_BDINTERPYLO bdintrpylo
# define FORT_BDINTERPYHI bdintrpyhi
# endif
# if (BL_SPACEDIM > 2)
# define FORT_BDINTERPZLO bdintrpzlo
# define FORT_BDINTERPZHI bdintrpzhi
# endif
# elif defined(BL_FORT_USE_UNDERSCORE)
# define FORT_BDINTERPXLO bdintrpxlo_
# define FORT_BDINTERPXHI bdintrpxhi_
# if (BL_SPACEDIM > 1)
# define FORT_BDINTERPYLO bdintrpylo_
# define FORT_BDINTERPYHI bdintrpyhi_
# endif
# if (BL_SPACEDIM > 2)
# define FORT_BDINTERPZLO bdintrpzlo_
# define FORT_BDINTERPZHI bdintrpzhi_
# endif
#endif
#include
typedef void BDInterpFunc(Real* bndr, ARLIM_P(blo), ARLIM_P(bhi),
const int* lo, const int* hi,
ARLIM_P(cblo), ARLIM_P(cbhi),
const int* nvar, const int* ratio,
const int* not_covered,
const int* mask, ARLIM_P(mlo), ARLIM_P(mhi),
const Real* crse, ARLIM_P(clo), ARLIM_P(chi),
Real* derives);
extern "C"
{
BDInterpFunc FORT_BDINTERPXLO;
BDInterpFunc FORT_BDINTERPXHI;
#if (BL_SPACEDIM > 1)
BDInterpFunc FORT_BDINTERPYLO;
BDInterpFunc FORT_BDINTERPYHI;
#endif
#if (BL_SPACEDIM > 2)
BDInterpFunc FORT_BDINTERPZLO;
BDInterpFunc FORT_BDINTERPZHI;
#endif
}
#endif
#endif /*_INTERPBNDRY_F_H_*/
ccseapps-2.5/CCSEApps/mglib/LO_3D.F 0000644 0001750 0001750 00000072742 11634153073 017734 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: LO_3D.F,v 1.4 2002/11/27 21:54:35 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
#include
#include "LO_BCTYPES.H"
#include "LO_F.H"
#include "ArrayLim.H"
c-----------------------------------------------------------------------
subroutine FORT_RESIDL (
$ res, DIMS(res),
$ rhs, DIMS(rhs),
$ phi, DIMS(phi),
$ lo, hi, nc
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(phi)
REAL_T phi(DIMV(phi),nc)
integer DIMDEC(rhs)
REAL_T rhs(DIMV(rhs),nc)
integer DIMDEC(res)
REAL_T res(DIMV(res),nc)
c
integer i
integer j
integer k
integer n
c
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
res(i,j,k,n) = rhs(i,j,k,n) - phi(i,j,k,n)
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
subroutine FORT_HARMONIC_AVERAGEEC (
$ c, DIMS(c),
$ f, DIMS(f),
$ lo, hi, nc,
$ cdir
$ )
c
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer cdir
integer DIMDEC(f)
REAL_T f(DIMV(f),nc)
integer DIMDEC(c)
REAL_T c(DIMV(c),nc)
c
REAL_T factor
parameter(factor=four)
integer n
integer i
integer j
integer k
c
if ( cdir .eq. 0 ) then
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)+1
c
c(i,j,k,n) = factor/(
$ + 1.0D0/f(2*i,2*j ,2*k ,n)
$ + 1.0D0/f(2*i,2*j+1,2*k ,n)
$ + 1.0D0/f(2*i,2*j ,2*k+1,n)
$ + 1.0D0/f(2*i,2*j+1,2*k+1,n) )
c
end do
end do
end do
end do
else if (cdir .eq. 1 ) then
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)+1
do i = lo(1), hi(1)
c
c(i,j,k,n) = factor/(
$ + 1.0D0/f(2*i ,2*j,2*k ,n)
$ + 1.0D0/f(2*i+1,2*j,2*k ,n)
$ + 1.0D0/f(2*i ,2*j,2*k+1,n)
$ + 1.0D0/f(2*i+1,2*j,2*k+1,n) )
c
end do
end do
end do
end do
else if (cdir .eq. 2 ) then
do n = 1, nc
do k = lo(3), hi(3)+1
do j = lo(2), hi(2)
do i = lo(1), hi(1)
c
c(i,j,k,n) = factor/(
$ + 1.0D0/f(2*i ,2*j ,2*k,n)
$ + 1.0D0/f(2*i+1,2*j ,2*k,n)
$ + 1.0D0/f(2*i ,2*j+1,2*k,n)
$ + 1.0D0/f(2*i+1,2*j+1,2*k,n) )
c
end do
end do
end do
end do
end if
c
end
c-----------------------------------------------------------------------
subroutine FORT_AVERAGEEC (
$ c, DIMS(c),
$ f, DIMS(f),
$ lo, hi, nc,
$ cdir
$ )
c
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer cdir
integer DIMDEC(f)
REAL_T f(DIMV(f),nc)
integer DIMDEC(c)
REAL_T c(DIMV(c),nc)
c
integer n
integer i
integer j
integer k
REAL_T factor
parameter(factor = fourth)
c
if ( cdir .eq. 0 ) then
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)+1
c
c(i,j,k,n) = factor*(
$ + f(2*i,2*j ,2*k ,n)
$ + f(2*i,2*j+1,2*k ,n)
$ + f(2*i,2*j ,2*k+1,n)
$ + f(2*i,2*j+1,2*k+1,n) )
c
end do
end do
end do
end do
else if (cdir .eq. 1 ) then
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)+1
do i = lo(1), hi(1)
c
c(i,j,k,n) = factor*(
$ + f(2*i ,2*j,2*k ,n)
$ + f(2*i+1,2*j,2*k ,n)
$ + f(2*i ,2*j,2*k+1,n)
$ + f(2*i+1,2*j,2*k+1,n) )
c
end do
end do
end do
end do
else if (cdir .eq. 2 ) then
do n = 1, nc
do k = lo(3), hi(3)+1
do j = lo(2), hi(2)
do i = lo(1), hi(1)
c
c(i,j,k,n) = factor*(
$ + f(2*i ,2*j ,2*k,n)
$ + f(2*i+1,2*j ,2*k,n)
$ + f(2*i ,2*j+1,2*k,n)
$ + f(2*i+1,2*j+1,2*k,n) )
c
end do
end do
end do
end do
end if
c
end
c-----------------------------------------------------------------------
subroutine FORT_AVERAGECC (
$ c, DIMS(c),
$ f, DIMS(f),
$ lo, hi, nc
$ )
c
integer nc
integer DIMDEC(f)
integer DIMDEC(c)
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
REAL_T f(DIMV(f),nc)
REAL_T c(DIMV(c),nc)
c
integer i
integer j
integer k
integer n
REAL_T factor
parameter(factor=eighth)
c
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
c
c(i,j,k,n) = factor*(
$ + f(2*i+1,2*j+1,2*k ,n)
$ + f(2*i ,2*j+1,2*k ,n)
$ + f(2*i+1,2*j ,2*k ,n)
$ + f(2*i ,2*j ,2*k ,n)
$ + f(2*i+1,2*j+1,2*k+1,n)
$ + f(2*i ,2*j+1,2*k+1,n)
$ + f(2*i+1,2*j ,2*k+1,n)
$ + f(2*i ,2*j ,2*k+1,n) )
c
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
subroutine FORT_APPLYBC (
$ flagden, flagbc, maxorder,
$ phi, DIMS(phi),
$ cdir, bct, bcl,
$ bcval, DIMS(bcval),
$ mask, DIMS(mask),
$ den, DIMS(den),
$ lo, hi, nc,
$ h
$ )
c
c If the boundary is of Neumann type, set the ghost cell value to
c that of the outermost point in the valid data (2nd order accurate)
c and then fill the "den" array with the value "1"
c
c
c If flagbc==1:
c
c If the boundary is of Dirichlet type, construct a polynomial
c interpolation through the boundary location and internal points
c (at locations x(-1:len-2) that generates the ghost cell value (at
c location xInt). Then fill the ghost cell with the interpolated value.
c If flagden==1, load the "den" array with the interpolation
c coefficient corresponding to outermost point in the valid region
c ( the coef(0) corresponding to the location x(0) )
c
c Note:
c The bc type = LO_REFLECT_ODD is a special type of dirichlet condition,
c in that we want a "zeroth" order interpolant to fill the ghost cell.
c If this were treated in the normal way, then ALL boundaries would be
c low order.
c
integer maxorder
integer nc, cdir, flagden, flagbc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(phi)
REAL_T phi(DIMV(phi),nc)
integer DIMDEC(den)
REAL_T den(DIMV(den))
integer DIMDEC(bcval)
REAL_T bcval(DIMV(bcval),nc)
integer DIMDEC(mask)
integer mask(DIMV(mask))
integer bct
REAL_T bcl
REAL_T h(BL_SPACEDIM)
c
integer i
integer j
integer k
integer n
logical is_dirichlet
logical is_neumann
logical is_odd
REAL_T xb
c
integer lenx
integer leny
integer lenz
integer m
c
integer Lmaxorder
integer maxmaxorder
parameter(maxmaxorder=4)
REAL_T x(-1:maxmaxorder-2)
REAL_T coef(-1:maxmaxorder-2)
REAL_T xInt
c
is_dirichlet(i) = ( i .eq. LO_DIRICHLET )
is_neumann(i) = (i .eq. LO_NEUMANN)
c
if ( maxorder .eq. -1 ) then
Lmaxorder = maxmaxorder
else
Lmaxorder = MIN(maxorder,maxmaxorder)
end if
lenx = MIN(hi(1)-lo(1), Lmaxorder-2)
leny = MIN(hi(2)-lo(2), Lmaxorder-2)
lenz = MIN(hi(3)-lo(3), Lmaxorder-2)
c
c TODO:
c In order for this to work with growing multigrid, must
c sort xa[] because it is possible for the xb value to lay
c within this range.
c
c The Left face of the grid
c
if(cdir .eq. 0) then
if (is_neumann(bct)) then
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(lo(1)-1,j,k,n) = cvmgt(
$ phi(lo(1),j,k,n),
$ phi(lo(1)-1,j,k,n),
$ mask(lo(1)-1,j,k) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1) then
do k = lo(3), hi(3)
do j = lo(2), hi(2)
den(lo(1),j,k) = 1.0D0
end do
end do
end if
else if (is_dirichlet(bct)) then
do m=0,lenx
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(1)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, lenx+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(lo(1)-1, j, k, n) = cvmgt(
$ bcval(lo(1)-1,j,k,n)*coef(-1),
$ phi(lo(1)-1, j,k, n),
$ mask(lo(1)-1,j,k) .gt. 0)
end do
end do
else
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(lo(1)-1, j, k, n) = cvmgt(
$ 0.0D0,
$ phi(lo(1)-1, j, k, n),
$ mask(lo(1)-1,j, k) .gt. 0)
end do
end do
end if
do m = 0, lenx
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(lo(1)-1,j,k,n) = cvmgt(
$ phi(lo(1)-1,j,k,n)
$ + phi(lo(1)+m, j, k, n)*coef(m),
$ phi(lo(1)-1,j,k,n),
$ mask(lo(1)-1,j,k) .gt. 0)
end do
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do j = lo(2), hi(2)
den(lo(1),j,k) = cvmgt(coef(0), 0.0D0,
$ mask(lo(1)-1,j,k) .gt. 0)
end do
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(lo(1)-1, j, k, n) = cvmgt(
$ -phi(lo(1),j,k,n),
$ phi(lo(1)-1,j,k,n),
$ mask(lo(1)-1,j,k) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do j = lo(2), hi(2)
den(lo(1),j,k) = cvmgt(-1.0D0, 0.0D0,
$ mask(lo(1)-1,j,k) .gt. 0)
end do
end do
end if
else
print *,'UNKNOWN BC ON LEFT FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
c The Right face of the grid
c
if(cdir .eq. 3) then
if(is_neumann(bct)) then
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(hi(1)+1,j,k,n) = cvmgt(
$ phi(hi(1), j, k, n),
$ phi(hi(1)+1, j, k, n),
$ mask(hi(1)+1,j,k) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do j = lo(2), hi(2)
den(hi(1),j,k) = 1.0D0
end do
end do
end if
else if (is_dirichlet(bct)) then
do m=0,lenx
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(1)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, lenx+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(hi(1)+1,j,k,n) = cvmgt(
$ bcval(hi(1)+1,j,k,n)*coef(-1),
$ phi(hi(1)+1,j,k,n),
$ mask(hi(1)+1,j,k) .gt. 0)
end do
end do
else
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(hi(1)+1,j,k,n) = cvmgt(
$ 0.0D0,
$ phi(hi(1)+1,j,k,n),
$ mask(hi(1)+1,j,k) .gt. 0)
end do
end do
end if
do m = 0, lenx
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(hi(1)+1,j,k,n) = cvmgt(
$ phi(hi(1)+1,j,k,n)
$ + phi(hi(1)-m,j,k,n)*coef(m),
$ phi(hi(1)+1,j,k,n),
$ mask(hi(1)+1,j,k) .gt. 0)
end do
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do j = lo(2), hi(2)
den(hi(1),j,k) = cvmgt(coef(0), 0.0D0,
$ mask(hi(1)+1,j,k) .gt. 0)
end do
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
phi(hi(1)+1, j, k, n) = cvmgt(
$ -phi(hi(1),j,k,n),
$ phi(hi(1)+1,j,k,n),
$ mask(hi(1)+1,j,k) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do j = lo(2), hi(2)
den(hi(1),j,k) = cvmgt(-1.0D0, 0.0D0,
$ mask(hi(1)+1,j,k) .gt. 0)
end do
end do
end if
else
print *,'UNKNOWN BC ON RIGHT FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
c The Bottom of the Grid
c
if(cdir .eq. 1) then
if(is_neumann(bct)) then
do n = 1, nc
do k = lo(3), hi(3)
do i = lo(1),hi(1)
phi(i,lo(2)-1,k,n) = cvmgt(
$ phi(i,lo(2),k,n),
$ phi(i,lo(2)-1,k,n),
$ mask(i,lo(2)-1,k) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do i = lo(1),hi(1)
den(i,lo(2),k) = 1.0D0
end do
end do
end if
else if (is_dirichlet(bct)) then
do m=0,leny
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(2)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, leny+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do k = lo(3), hi(3)
do i = lo(1), hi(1)
phi(i,lo(2)-1,k,n) = cvmgt(
$ bcval(i,lo(2)-1,k,n)*coef(-1),
$ phi(i,lo(2)-1,k,n),
$ mask(i,lo(2)-1,k) .gt. 0)
end do
end do
else
do k = lo(3), hi(3)
do i = lo(1), hi(1)
phi(i,lo(2)-1,k,n) = cvmgt(
$ 0.0D0,
$ phi(i,lo(2)-1,k,n),
$ mask(i,lo(2)-1,k) .gt. 0)
end do
end do
end if
do m = 0, leny
do k = lo(3), hi(3)
do i = lo(1), hi(1)
phi(i, lo(2)-1, k, n) = cvmgt(
$ phi(i, lo(2)-1,k,n)
$ + phi(i, lo(2)+m, k,n)*coef(m),
$ phi(i, lo(2)-1, k, n),
$ mask(i, lo(2)-1, k) .gt. 0)
end do
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do i = lo(1), hi(1)
den(i, lo(2),k) = cvmgt(coef(0), 0.0D0,
$ mask(i, lo(2)-1,k) .gt. 0)
end do
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do k = lo(3), hi(3)
do i = lo(1), hi(1)
phi(i, lo(2)-1, k, n) = cvmgt(
$ -phi(i,lo(2),k,n),
$ phi(i,lo(2)-1,k,n),
$ mask(i,lo(2)-1,k) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do i = lo(1), hi(1)
den(i,lo(2),k) = cvmgt(-1.0D0, 0.0D0,
$ mask(i,lo(2)-1,k) .gt. 0)
end do
end do
end if
else
print *,'UNKNOWN BC ON BOTTOM FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
c The top of the grid
c
if (cdir .eq. 4) then
if(is_neumann(bct)) then
do n = 1, nc
do k = lo(3), hi(3)
do i = lo(1), hi(1)
phi(i,hi(2)+1,k,n) = cvmgt(
$ phi(i,hi(2),k,n),
$ phi(i,hi(2)+1,k,n),
$ mask(i,hi(2)+1,k) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do i = lo(1), hi(1)
den(i,hi(2),k) = 1.0D0
end do
end do
end if
else if (is_dirichlet(bct)) then
do m=0,leny
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(2)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, leny+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do k = lo(3), hi(3)
do i = lo(1), hi(1)
phi(i,hi(2)+1,k,n) = cvmgt(
$ bcval(i,hi(2)+1,k,n)*coef(-1),
$ phi(i,hi(2)+1,k,n),
$ mask(i,hi(2)+1,k) .gt. 0)
end do
end do
else
do k = lo(3), hi(3)
do i = lo(1), hi(1)
phi(i,hi(2)+1,k,n) = cvmgt(
$ 0.0D0,
$ phi(i,hi(2)+1,k,n),
$ mask(i,hi(2)+1,k) .gt. 0)
end do
end do
end if
do m = 0, leny
do k = lo(3), hi(3)
do i = lo(1), hi(1)
phi(i, hi(2)+1,k,n) = cvmgt(
$ phi(i,hi(2)+1,k,n)
$ + phi(i, hi(2)-m,k,n)*coef(m),
$ phi(i,hi(2)+1,k,n),
$ mask(i,hi(2)+1,k) .gt. 0)
end do
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do i = lo(1), hi(1)
den(i,hi(2),k) = cvmgt(coef(0), 0.0D0,
$ mask(i,hi(2)+1,k) .gt. 0)
end do
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do k = lo(3), hi(3)
do i = lo(1), hi(1)
phi(i, hi(2)+1, k, n) = cvmgt(
$ -phi(i,hi(2),k,n),
$ phi(i,hi(2)+1,k,n),
$ mask(i,hi(2)+1,k) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do k = lo(3), hi(3)
do i = lo(1), hi(1)
den(i,hi(2),k) = cvmgt(-1.0D0, 0.0D0,
$ mask(i,hi(2)+1,k) .gt. 0)
end do
end do
end if
else
print *,'UNKNOWN BC ON TOP FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
c The Front of the Grid
c
if(cdir .eq. 2) then
if(is_neumann(bct)) then
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1),hi(1)
phi(i,j,lo(3)-1,n) = cvmgt(
$ phi(i,j,lo(3),n),
$ phi(i,j,lo(3)-1,n),
$ mask(i,j,lo(3)-1) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
do i = lo(1),hi(1)
den(i,j,lo(3)) = 1.0D0
end do
end do
end if
else if (is_dirichlet(bct)) then
do m=0,lenz
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(3)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, lenz+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i,j,lo(3)-1,n) = cvmgt(
$ bcval(i,j,lo(3)-1,n)*coef(-1),
$ phi(i,j,lo(3)-1,n),
$ mask(i,j,lo(3)-1) .gt. 0)
end do
end do
else
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i,j,lo(3)-1,n) = cvmgt(
$ 0.0D0,
$ phi(i,j,lo(3)-1,n),
$ mask(i,j,lo(3)-1) .gt. 0)
end do
end do
end if
do m = 0, lenz
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i, j, lo(3)-1, n) = cvmgt(
$ phi(i, j, lo(3)-1,n)
$ + phi(i, j, lo(3)+m, n)*coef(m),
$ phi(i, j, lo(3)-1,n),
$ mask(i, j, lo(3)-1) .gt. 0)
end do
end do
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
do i = lo(1), hi(1)
den(i, j, lo(3)) = cvmgt(coef(0), 0.0D0,
$ mask(i, j, lo(3)-1) .gt. 0)
end do
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i, j, lo(3)-1, n) = cvmgt(
$ -phi(i,j,lo(3),n),
$ phi(i,j,lo(3)-1,n),
$ mask(i,j,lo(3)-1) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
do i = lo(1), hi(1)
den(i,j,lo(3)) = cvmgt(-1.0D0, 0.0D0,
$ mask(i,j,lo(3)-1) .gt. 0)
end do
end do
end if
else
print *,'UNKNOWN BC ON FRONT FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
c The back of the grid
c
if (cdir .eq. 5) then
if(is_neumann(bct)) then
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i,j, hi(3)+1,n) = cvmgt(
$ phi(i,j, hi(3),n),
$ phi(i,j, hi(3)+1,n),
$ mask(i,j, hi(3)+1) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
do i = lo(1), hi(1)
den(i,j, hi(3)) = 1.0D0
end do
end do
end if
else if (is_dirichlet(bct)) then
do m=0,lenz
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(3)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, lenz+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i,j, hi(3)+1,n) = cvmgt(
$ bcval(i,j, hi(3)+1,n)*coef(-1),
$ phi(i,j, hi(3)+1,n),
$ mask(i,j, hi(3)+1) .gt. 0)
end do
end do
else
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i,j, hi(3)+1,n) = cvmgt(
$ 0.0D0,
$ phi(i,j, hi(3)+1,n),
$ mask(i,j, hi(3)+1) .gt. 0)
end do
end do
end if
do m = 0, lenz
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i, j, hi(3)+1,n) = cvmgt(
$ phi(i,j, hi(3)+1,n)
$ + phi(i, j, hi(3)-m,n)*coef(m),
$ phi(i,j, hi(3)+1,n),
$ mask(i,j, hi(3)+1) .gt. 0)
end do
end do
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
do i = lo(1), hi(1)
den(i,j, hi(3)) = cvmgt(coef(0), 0.0D0,
$ mask(i,j, hi(3)+1) .gt. 0)
end do
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i, j, hi(3)+1, n) = cvmgt(
$ -phi(i,j,hi(3),n),
$ phi(i,j,hi(3)+1,n),
$ mask(i,j,hi(3)+1) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
do i = lo(1), hi(1)
den(i,j,hi(3)) = cvmgt(-1.0D0, 0.0D0,
$ mask(i,j,hi(3)+1) .gt. 0)
end do
end do
end if
else
print *,'UNKNOWN BC ON BACK FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
end
ccseapps-2.5/CCSEApps/mglib/LO_2D.F 0000644 0001750 0001750 00000044016 11634153073 017724 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: LO_2D.F,v 1.5 2002/11/27 21:54:35 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
#include
#include "LO_BCTYPES.H"
#include "LO_F.H"
#include "ArrayLim.H"
c-----------------------------------------------------------------------
subroutine FORT_RESIDL (
$ res, DIMS(res),
$ rhs, DIMS(rhs),
$ phi, DIMS(phi),
$ lo, hi, nc
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(phi)
REAL_T phi(DIMV(phi),nc)
integer DIMDEC(rhs)
REAL_T rhs(DIMV(rhs),nc)
integer DIMDEC(res)
REAL_T res(DIMV(res),nc)
c
integer i
integer j
integer n
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
res(i,j,n) = rhs(i,j,n) - phi(i,j,n)
end do
end do
end do
c
end
c-----------------------------------------------------------------------
subroutine FORT_HARMONIC_AVERAGEEC (
$ c, DIMS(c),
$ f, DIMS(f),
$ lo, hi, nc,
$ cdir
$ )
c
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer cdir
integer DIMDEC(f)
REAL_T f(DIMV(f),nc)
integer DIMDEC(c)
REAL_T c(DIMV(c),nc)
c
REAL_T factor, den
parameter(factor=2.00D0)
integer n
integer i
integer j
c
if ( cdir .eq. 0 ) then
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)+1
den = f(2*i,2*j,n) + f(2*i,2*j+1,n)
if (den .ne. 0.0D0) then
c(i,j,n) = factor*f(2*i,2*j,n)*f(2*i,2*j+1,n)/den
else
c(i,j,n) = 0.0D0
end if
end do
end do
end do
else if (cdir .eq. 1 ) then
do n = 1, nc
do j = lo(2), hi(2)+1
do i = lo(1), hi(1)
den = f(2*i,2*j,n) + f(2*i+1,2*j,n)
if (den .ne. 0.0D0) then
c(i,j,n) = factor*f(2*i,2*j,n)*f(2*i+1,2*j,n)/den
else
c(i,j,n) = 0.0D0
end if
end do
end do
end do
end if
c
end
c-----------------------------------------------------------------------
subroutine FORT_AVERAGEEC (
$ c, DIMS(c),
$ f, DIMS(f),
$ lo, hi, nc,
$ cdir
$ )
c
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer cdir
integer DIMDEC(f)
REAL_T f(DIMV(f),nc)
integer DIMDEC(c)
REAL_T c(DIMV(c),nc)
c
integer n
integer i
integer j
REAL_T denom
parameter(denom=half)
c
if (cdir .eq. 0 ) then
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)+1
c(i,j,n) = (f(2*i,2*j,n) + f(2*i,2*j+1,n))*denom
end do
end do
end do
else if (cdir .eq. 1) then
do n = 1, nc
do j = lo(2), hi(2)+1
do i = lo(1), hi(1)
c(i,j,n) = (f(2*i,2*j,n) + f(2*i+1,2*j,n))*denom
end do
end do
end do
end if
c
end
c-----------------------------------------------------------------------
subroutine FORT_AVERAGECC (
$ c, DIMS(c),
$ f, DIMS(f),
$ lo, hi, nc
$ )
c
integer nc
integer DIMDEC(f)
integer DIMDEC(c)
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
REAL_T f(DIMV(f),nc)
REAL_T c(DIMV(c),nc)
c
integer i
integer j
integer n
REAL_T denom
parameter(denom=fourth)
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
c(i,j,n) = (
$ f(2*i+1,2*j+1,n) + f(2*i ,2*j+1,n)
$ + f(2*i+1,2*j ,n) + f(2*i ,2*j ,n))*denom
end do
end do
end do
c
end
c-----------------------------------------------------------------------
subroutine FORT_APPLYBC (
$ flagden, flagbc, maxorder,
$ phi, DIMS(phi),
$ cdir, bct, bcl,
$ bcval, DIMS(bcval),
$ mask, DIMS(mask),
$ den, DIMS(den),
$ lo, hi, nc,
$ h
$ )
c
c If the boundary is of Neumann type, set the ghost cell value to
c that of the outermost point in the valid data (2nd order accurate)
c and then fill the "den" array with the value "1"
c
c
c If flagbc==1:
c
c If the boundary is of Dirichlet type, construct a polynomial
c interpolation through the boundary location and internal points
c (at locations x(-1:len-2) that generates the ghost cell value (at
c location xInt). Then fill the ghost cell with the interpolated value.
c If flagden==1, load the "den" array with the interpolation
c coefficient corresponding to outermost point in the valid region
c ( the coef(0) corresponding to the location x(0) )
c
c Note:
c The bc type = LO_REFLECT_ODD is a special type of boundary condition.
c
integer maxorder
integer nc, cdir, flagden, flagbc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(phi)
REAL_T phi(DIMV(phi),nc)
integer DIMDEC(den)
REAL_T den(DIMV(den))
integer DIMDEC(bcval)
REAL_T bcval(DIMV(bcval),nc)
integer DIMDEC(mask)
integer mask(DIMV(mask))
integer bct
REAL_T bcl
REAL_T h(BL_SPACEDIM)
c
integer i
integer j
integer n
logical is_dirichlet
logical is_neumann
logical is_odd
REAL_T xb
c
integer lenx
integer leny
integer m
c
integer Lmaxorder
integer maxmaxorder
parameter(maxmaxorder=4)
REAL_T x(-1:maxmaxorder-2)
REAL_T coef(-1:maxmaxorder-2)
REAL_T xInt
c
is_dirichlet(i) = ( i .eq. LO_DIRICHLET )
is_neumann(i) = ( i .eq. LO_NEUMANN )
c
if ( maxorder .eq. -1 ) then
Lmaxorder = maxmaxorder
else
Lmaxorder = MIN(maxorder,maxmaxorder)
end if
lenx = MIN(hi(1)-lo(1), Lmaxorder-2)
leny = MIN(hi(2)-lo(2), Lmaxorder-2)
c
c TODO:
c In order for this to work with growing multigrid, must
c sort xa[] because it is possible for the xb value to lay
c within this range.
c
c The Left face of the grid
c
if(cdir .eq. 0) then
if (is_neumann(bct)) then
do n = 1, nc
do j = lo(2), hi(2)
phi(lo(1)-1,j,n) = cvmgt(
$ phi(lo(1),j,n),
$ phi(lo(1)-1,j,n),
$ mask(lo(1)-1,j) .gt. 0)
end do
end do
if ( flagden .eq. 1) then
do j = lo(2), hi(2)
den(lo(1),j) = 1.0D0
end do
end if
else if (is_dirichlet(bct)) then
do m=0,lenx
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(1)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, lenx+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do j = lo(2), hi(2)
phi(lo(1)-1, j, n) = cvmgt(
$ bcval(lo(1)-1,j,n)*coef(-1),
$ phi(lo(1)-1, j, n),
$ mask(lo(1)-1,j) .gt. 0)
end do
else
do j = lo(2), hi(2)
phi(lo(1)-1, j, n) = cvmgt(
$ 0.0D0,
$ phi(lo(1)-1, j, n),
$ mask(lo(1)-1,j) .gt. 0)
end do
end if
do m = 0, lenx
do j = lo(2), hi(2)
phi(lo(1)-1,j,n) = cvmgt(
$ phi(lo(1)-1,j,n)
$ + phi(lo(1)+m, j, n)*coef(m),
$ phi(lo(1)-1,j,n),
$ mask(lo(1)-1,j) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
den(lo(1),j) = cvmgt(coef(0), 0.0D0,
$ mask(lo(1)-1,j) .gt. 0)
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do j = lo(2), hi(2)
phi(lo(1)-1, j, n) = cvmgt(
$ -phi(lo(1),j,n),
$ phi(lo(1)-1, j, n),
$ mask(lo(1)-1,j) .gt. 0)
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
den(lo(1),j) = cvmgt(-1.0D0, 0.0D0,
$ mask(lo(1)-1,j) .gt. 0)
end do
end if
else
print *,'UNKNOWN BC ON LEFT FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
c The Right face of the grid
c
if(cdir .eq. 2) then
if(is_neumann(bct)) then
do n = 1, nc
do j = lo(2), hi(2)
phi(hi(1)+1,j,n) = cvmgt(
$ phi(hi(1), j, n),
$ phi(hi(1)+1, j, n),
$ mask(hi(1)+1,j) .gt. 0)
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
den(hi(1),j) = 1.0D0
end do
end if
else if (is_dirichlet(bct)) then
do m=0,lenx
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(1)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, lenx+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do j = lo(2), hi(2)
phi(hi(1)+1,j,n) = cvmgt(
$ bcval(hi(1)+1,j,n)*coef(-1),
$ phi(hi(1)+1,j,n),
$ mask(hi(1)+1,j) .gt. 0)
end do
else
do j = lo(2), hi(2)
phi(hi(1)+1,j,n) = cvmgt(
$ 0.0D0,
$ phi(hi(1)+1,j,n),
$ mask(hi(1)+1,j) .gt. 0)
end do
end if
do m = 0, lenx
do j = lo(2), hi(2)
phi(hi(1)+1,j,n) = cvmgt(
$ phi(hi(1)+1,j,n)
$ + phi(hi(1)-m,j,n)*coef(m),
$ phi(hi(1)+1,j,n),
$ mask(hi(1)+1,j) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
den(hi(1),j) = cvmgt(coef(0), 0.0D0,
$ mask(hi(1)+1,j) .gt. 0)
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do j = lo(2), hi(2)
phi(hi(1)+1, j, n) = cvmgt(
$ -phi(hi(1),j,n),
$ phi(hi(1)+1, j, n),
$ mask(hi(1)+1,j) .gt. 0)
end do
end do
if ( flagden .eq. 1 ) then
do j = lo(2), hi(2)
den(hi(1),j) = cvmgt(-1.0D0, 0.0D0,
$ mask(hi(1)+1,j) .gt. 0)
end do
end if
else
print *,'UNKNOWN BC ON RIGHT FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
c The Bottom of the Grid
c
if(cdir .eq. 1) then
if(is_neumann(bct)) then
do n = 1, nc
do i = lo(1),hi(1)
phi(i,lo(2)-1,n) = cvmgt(
$ phi(i,lo(2),n),
$ phi(i,lo(2)-1,n),
$ mask(i,lo(2)-1) .gt. 0)
end do
end do
if ( flagden .eq. 1 ) then
do i = lo(1),hi(1)
den(i,lo(2)) = 1.0D0
end do
end if
else if (is_dirichlet(bct)) then
do m=0,leny
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(2)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, leny+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do i = lo(1), hi(1)
phi(i,lo(2)-1,n) = cvmgt(
$ bcval(i,lo(2)-1,n)*coef(-1),
$ phi(i,lo(2)-1,n),
$ mask(i,lo(2)-1) .gt. 0)
end do
else
do i = lo(1), hi(1)
phi(i,lo(2)-1,n) = cvmgt(
$ 0.0D0,
$ phi(i,lo(2)-1,n),
$ mask(i,lo(2)-1) .gt. 0)
end do
end if
do m = 0, leny
do i = lo(1), hi(1)
phi(i, lo(2)-1, n) = cvmgt(
$ phi(i, lo(2)-1,n)
$ + phi(i, lo(2)+m,n)*coef(m),
$ phi(i, lo(2)-1, n),
$ mask(i, lo(2)-1) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do i = lo(1), hi(1)
den(i, lo(2)) = cvmgt(coef(0), 0.0D0,
$ mask(i, lo(2)-1) .gt. 0)
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do i = lo(1), hi(1)
phi(i,lo(2)-1,n) = cvmgt(
$ -phi(i,lo(2),n),
$ phi(i,lo(2)-1,n),
$ mask(i,lo(2)-1) .gt. 0)
end do
end do
if ( flagden .eq. 1 ) then
do i = lo(1), hi(1)
den(i,lo(2)) = cvmgt(-1.0D0, 0.0D0,
$ mask(i,lo(2)-1) .gt. 0)
end do
end if
else
print *,'UNKNOWN BC ON BOTTOM FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
c The top of the grid
c
if (cdir .eq. 3) then
if(is_neumann(bct)) then
do n = 1, nc
do i = lo(1), hi(1)
phi(i,hi(2)+1,n) = cvmgt(
$ phi(i,hi(2),n),
$ phi(i,hi(2)+1,n),
$ mask(i,hi(2)+1) .gt. 0)
end do
end do
if ( flagden .eq. 1 ) then
do i = lo(1), hi(1)
den(i,hi(2)) = 1.0D0
end do
end if
else if (is_dirichlet(bct)) then
if ( bct .eq. LO_REFLECT_ODD ) leny = 0
do m=0,leny
x(m) = m + 0.5D0
end do
x(-1) = - bcl/h(2)
xInt = - 0.5D0
call polyInterpCoeff(xInt, x, leny+2, coef)
do n = 1, nc
if ( flagbc .eq. 1 ) then
do i = lo(1), hi(1)
phi(i,hi(2)+1,n) = cvmgt(
$ bcval(i,hi(2)+1,n)*coef(-1),
$ phi(i,hi(2)+1,n),
$ mask(i,hi(2)+1) .gt. 0)
end do
else
do i = lo(1), hi(1)
phi(i,hi(2)+1,n) = cvmgt(
$ 0.0D0,
$ phi(i,hi(2)+1,n),
$ mask(i,hi(2)+1) .gt. 0)
end do
end if
do m = 0, leny
do i = lo(1), hi(1)
phi(i, hi(2)+1,n) = cvmgt(
$ phi(i,hi(2)+1,n)
$ + phi(i, hi(2)-m,n)*coef(m),
$ phi(i,hi(2)+1,n),
$ mask(i,hi(2)+1) .gt. 0)
end do
end do
end do
if ( flagden .eq. 1 ) then
do i = lo(1), hi(1)
den(i,hi(2)) = cvmgt(coef(0), 0.0D0,
$ mask(i,hi(2)+1) .gt. 0)
end do
end if
else if ( bct .eq. LO_REFLECT_ODD ) then
do n = 1, nc
do i = lo(1), hi(1)
phi(i,hi(2)+1,n) = cvmgt(
$ -phi(i,hi(2),n),
$ phi(i,hi(2)+1,n),
$ mask(i,hi(2)+1) .gt. 0)
end do
end do
if ( flagden .eq. 1 ) then
do i = lo(1), hi(1)
den(i,hi(2)) = cvmgt(-1.0D0, 0.0D0,
$ mask(i,hi(2)+1) .gt. 0)
end do
end if
else
print *,'UNKNOWN BC ON TOP FACE IN APPLYBC'
call bl_error("stop")
end if
end if
c
end
ccseapps-2.5/CCSEApps/mglib/CG_2D.F 0000644 0001750 0001750 00000012400 11634153073 017673 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c $Id: CG_2D.F,v 1.5 2002/08/29 22:14:39 car Exp $
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
#include "CG_F.H"
#include "ArrayLim.H"
c-----------------------------------------------------------------------
c
c CGUPDATE: Modify the input arrays as follows:
c
c phi = phi + a*pp
c rr = rr - a*ww through range lo:hi
c
c phi <=>
c rr <=>
c a <=
c ww <=
c pp <=
c
c-----------------------------------------------------------------------
subroutine FORT_CGUPDATE(
$ phi, DIMS(phi),
$ rr, DIMS(rr),
$ a,
$ ww, DIMS(ww),
$ pp, DIMS(pp),
$ lo, hi, nc
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(rr)
REAL_T rr(DIMV(rr),nc)
integer DIMDEC(ww)
REAL_T ww(DIMV(ww),nc)
integer DIMDEC(pp)
REAL_T pp(DIMV(pp),nc)
integer DIMDEC(phi)
REAL_T phi(DIMV(phi),nc)
REAL_T a
c ... wyc change --- why was a a vector?
c REAL_T a(nc)
c
integer i,j,n
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
phi(i,j,n) = phi(i,j,n) + a * pp(i,j,n)
rr(i,j,n) = rr(i,j,n) - a * ww(i,j,n)
c .... wyc change --- why was a a vector?
c phi(i,j,n) = phi(i,j,n) + a(n) * pp(i,j,n)
c rr(i,j,n) = rr(i,j,n) - a(n) * ww(i,j,n)
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c CGADVCP: Modify the input arrays as follows:
c
c pp = rr + b*pp through range lo:hi
c
c pp <=>
c rr <=>
c b <=
c
c-----------------------------------------------------------------------
subroutine FORT_CGADVCP(
$ pp, DIMS(pp),
$ rr, DIMS(rr),
$ b,
$ lo, hi, nc
$ )
c
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(rr)
REAL_T rr(DIMV(rr),nc)
integer DIMDEC(pp)
REAL_T pp(DIMV(pp),nc)
REAL_T b
c ... wyc change
c REAL_T b(nc)
c
integer i,j,n
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
pp(i,j,n) = rr(i,j,n) + b*pp(i,j,n)
c ... wyc change ...
c pp(i,j,n) = rr(i,j,n) + b(n)*pp(i,j,n)
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c CGXDOTY: Modify the input as follows:
c
c pw = Transpose(pp) . ww through range lo:hi
c
c pw =>
c pp <=
c ww <=
c
c-----------------------------------------------------------------------
subroutine FORT_CGXDOTY(
$ pw,
$ pp, DIMS(pp),
$ ww, DIMS(ww),
$ lo, hi, nc
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(ww)
REAL_T ww(DIMV(ww),nc)
integer DIMDEC(pp)
REAL_T pp(DIMV(pp),nc)
REAL_T pw
c
integer i, j, n
c
pw = 0.0D0
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
pw = pw + pp(i,j,n)*ww(i,j,n)
end do
end do
end do
c
end
c-----------------------------------------------------------------------
subroutine FORT_CGSXAY(
$ ss, DIMS(ss),
$ xx, DIMS(xx),
$ a,
$ yy, DIMS(yy),
$ lo, hi, nc
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(ss)
REAL_T ss(DIMV(ss),nc)
integer DIMDEC(xx)
REAL_T xx(DIMV(xx),nc)
integer DIMDEC(yy)
REAL_T yy(DIMV(yy),nc)
REAL_T a
c
integer i, j, n
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
ss(i,j,n) = xx(i,j,n) + a*yy(i,j,n)
end do
end do
end do
c
end
ccseapps-2.5/CCSEApps/mglib/INTERPBNDRYDATA_3D.F 0000644 0001750 0001750 00000074407 11634153073 021654 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: INTERPBNDRYDATA_3D.F,v 1.2 2002/10/19 18:33:57 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include "BC_TYPES.H"
#include "REAL.H"
#include "CONSTANTS.H"
#include "INTERPBNDRYDATA_F.H"
#include "ArrayLim.H"
#define SDIM 3
#define NUMDERIV 5
#define XDER 1
#define YDER 2
#define X2DER 3
#define Y2DER 4
#define XYDER 5
c ---------------------------------------------------------------
c :: FORT_BDINTERPXLO : Interpolation on Xlo Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(3) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array for derivatives
c ---------------------------------------------------------------
subroutine FORT_BDINTERPXLO (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(3), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(cb)
integer DIMDEC(mask)
integer DIMDEC(crse)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM23(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, yy, ainterp
integer i, j, k, ic, jc, kc, joff, koff, n
integer jclo, jchi, kclo, kchi, ratioy, ratioz
ratioy = ratios(2)
ratioz = ratios(3)
kclo = ARG_L3(cb)
kchi = ARG_H3(cb)
jclo = ARG_L2(cb)
jchi = ARG_H2(cb)
ic = ARG_L1(cb)-1
i = lo(1)-1
do n = 1, nvar
c ::::: define interp coefs
do kc = kclo, kchi
k = ratioz*kc
do jc = jclo, jchi
j = ratioy*jc
derives(jc,kc,XDER) = half*(crse(ic,jc+1,kc,n) - crse(ic,jc-1,kc,n))
derives(jc,kc,X2DER) = half*(crse(ic,jc+1,kc,n) - two*crse(ic,jc,kc,n)
& + crse(ic,jc-1,kc,n))
derives(jc,kc,YDER) = half*(crse(ic,jc,kc+1,n) - crse(ic,jc,kc-1,n))
derives(jc,kc,Y2DER) = half*(crse(ic,jc,kc+1,n) - two*crse(ic,jc,kc,n)
& + crse(ic,jc,kc-1,n))
derives(jc,kc,XYDER) = forth*(crse(ic,jc+1,kc+1,n) - crse(ic,jc-1,kc+1,n)
& + crse(ic,jc-1,kc-1,n) - crse(ic,jc+1,kc-1,n))
if (mask(i,j-1,k) .ne. not_covered) then
derives(jc,kc,XDER) = crse(ic,jc+1,kc,n) - crse(ic,jc,kc,n)
derives(jc,kc,X2DER) = zero
end if
if (mask(i,j+ratioy,k) .ne. not_covered) then
derives(jc,kc,XDER) = crse(ic,jc,kc,n) - crse(ic,jc-1,kc,n)
derives(jc,kc,X2DER) = zero
end if
if (mask(i,j-1,k) .ne. not_covered .and.
$ mask(i,j+ratioy,k) .ne. not_covered) then
derives(jc,kc,XDER) = zero
end if
if (mask(i,j,k-1) .ne. not_covered) then
derives(jc,kc,YDER) = crse(ic,jc,kc+1,n) - crse(ic,jc,kc,n)
derives(jc,kc,Y2DER) = zero
end if
if (mask(i,j,k+ratioz) .ne. not_covered) then
derives(jc,kc,YDER) = crse(ic,jc,kc,n) - crse(ic,jc,kc-1,n)
derives(jc,kc,Y2DER) = zero
end if
if (mask(i,j,k-1) .ne. not_covered .and.
$ mask(i,j,k+ratioz) .ne. not_covered) then
derives(jc,kc,YDER) = zero
end if
if (
$ ( mask(i,j+ratioy,k+ratioz) .ne. not_covered ) .or.
$ ( mask(i,j-1,k+ratioz) .ne. not_covered ) .or.
$ ( mask(i,j+ratioy,k-1) .ne. not_covered ) .or.
$ ( mask(i,j-1,k-1) .ne. not_covered ) ) then
derives(jc,kc,XYDER) = zero
end if
end do
end do
c ::::: interpolate to fine grid
do koff = 0, ratioz - 1
yy = (dble(koff - ratioz/2) + half)/ratioz
do kc = kclo,kchi
k = ratioz*kc + koff
do joff = 0, ratioy - 1
xx = (dble(joff - ratioy/2) + half)/ratioy
do jc = jclo, jchi
j = ratioy*jc + joff
bdry(i,j,k,n) = crse(ic,jc,kc,n) + xx*derives(jc,kc,XDER)
& + derives(jc,kc,X2DER)*xx**2 + yy*derives(jc,kc,YDER)
& + derives(jc,kc,Y2DER)*yy**2 + xx*yy*derives(jc,kc,XYDER)
end do
end do
end do
end do
end do
return
end
c ---------------------------------------------------------------
c :: FORT_BDINTERPXHI : Interpolation on Xhi Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(3) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array for derivatives
c ---------------------------------------------------------------
subroutine FORT_BDINTERPXHI (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(3), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(cb)
integer DIMDEC(mask)
integer DIMDEC(crse)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM23(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, yy, ainterp
integer i, j, k, ic, jc, kc, joff, koff, n
integer jclo, jchi, kclo, kchi, ratioy, ratioz
ratioy = ratios(2)
ratioz = ratios(3)
kclo = ARG_L3(cb)
kchi = ARG_H3(cb)
jclo = ARG_L2(cb)
jchi = ARG_H2(cb)
ic = ARG_H1(cb)+1
i = hi(1)+1
do n = 1, nvar
c ::::: define interp coefs
do kc = kclo, kchi
k = ratioz*kc
do jc = jclo, jchi
j = ratioy*jc
derives(jc,kc,XDER) = half*(crse(ic,jc+1,kc,n) - crse(ic,jc-1,kc,n))
derives(jc,kc,X2DER) = half*(crse(ic,jc+1,kc,n) - two*crse(ic,jc,kc,n)
& + crse(ic,jc-1,kc,n))
derives(jc,kc,YDER) = half*(crse(ic,jc,kc+1,n) - crse(ic,jc,kc-1,n))
derives(jc,kc,Y2DER) = half*(crse(ic,jc,kc+1,n) - two*crse(ic,jc,kc,n)
& + crse(ic,jc,kc-1,n))
derives(jc,kc,XYDER) = forth*(crse(ic,jc+1,kc+1,n) - crse(ic,jc-1,kc+1,n)
& + crse(ic,jc-1,kc-1,n) - crse(ic,jc+1,kc-1,n))
if (mask(i,j-1,k) .ne. not_covered) then
derives(jc,kc,XDER) = crse(ic,jc+1,kc,n) - crse(ic,jc,kc,n)
derives(jc,kc,X2DER) = zero
end if
if (mask(i,j+ratioy,k) .ne. not_covered) then
derives(jc,kc,XDER) = crse(ic,jc,kc,n) - crse(ic,jc-1,kc,n)
derives(jc,kc,X2DER) = zero
end if
if (mask(i,j-1,k) .ne. not_covered .and.
$ mask(i,j+ratioy,k) .ne. not_covered) then
derives(jc,kc,XDER) = zero
end if
if (mask(i,j,k-1) .ne. not_covered) then
derives(jc,kc,YDER) = crse(ic,jc,kc+1,n) - crse(ic,jc,kc,n)
derives(jc,kc,Y2DER) = zero
end if
if (mask(i,j,k+ratioz) .ne. not_covered) then
derives(jc,kc,YDER) = crse(ic,jc,kc,n) - crse(ic,jc,kc-1,n)
derives(jc,kc,Y2DER) = zero
end if
if (mask(i,j,k-1) .ne. not_covered .and.
$ mask(i,j,k+ratioz) .ne. not_covered) then
derives(jc,kc,YDER) = zero
end if
if (
$ ( mask(i,j+ratioy,k+ratioz) .ne. not_covered ) .or.
$ ( mask(i,j-1,k+ratioz) .ne. not_covered ) .or.
$ ( mask(i,j+ratioy,k-1) .ne. not_covered ) .or.
$ ( mask(i,j-1,k-1) .ne. not_covered ) ) then
derives(jc,kc,XYDER) = zero
end if
end do
end do
c ::::: interpolate to fine grid
do koff = 0, ratioz - 1
yy = (dble(koff - ratioz/2) + half)/ratioz
do kc = kclo,kchi
k = ratioz*kc + koff
do joff = 0, ratioy - 1
xx = (dble(joff - ratioy/2) + half)/ratioy
do jc = jclo, jchi
j = ratioy*jc + joff
bdry(i,j,k,n) = crse(ic,jc,kc,n) + xx*derives(jc,kc,XDER)
& + derives(jc,kc,X2DER)*xx**2 + yy*derives(jc,kc,YDER)
& + derives(jc,kc,Y2DER)*yy**2 + xx*yy*derives(jc,kc,XYDER)
end do
end do
end do
end do
end do
return
end
c ---------------------------------------------------------------
c :: FORT_BDINTERPYLO : Interpolation on Ylo Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(3) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array for derivatives
c ---------------------------------------------------------------
subroutine FORT_BDINTERPYLO (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(3), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(cb)
integer DIMDEC(mask)
integer DIMDEC(crse)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM13(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, yy, ainterp
integer i, j, k, ic, jc, kc, ioff, koff, n
integer iclo, ichi, kclo, kchi, ratiox, ratioz
ratiox = ratios(1)
ratioz = ratios(3)
kclo = ARG_L3(cb)
kchi = ARG_H3(cb)
iclo = ARG_L1(cb)
ichi = ARG_H1(cb)
jc = ARG_L2(cb)-1
j = lo(2)-1
do n = 1, nvar
c ::::: define interp coefs
do kc = kclo, kchi
k = ratioz*kc
do ic = iclo, ichi
i = ratiox*ic
derives(ic,kc,XDER) = half*(crse(ic+1,jc,kc,n) - crse(ic-1,jc,kc,n))
derives(ic,kc,X2DER) = half*(crse(ic+1,jc,kc,n) - two*crse(ic,jc,kc,n)
& + crse(ic-1,jc,kc,n))
derives(ic,kc,YDER) = half*(crse(ic,jc,kc+1,n) - crse(ic,jc,kc-1,n))
derives(ic,kc,Y2DER) = half*(crse(ic,jc,kc+1,n) - two*crse(ic,jc,kc,n)
& + crse(ic,jc,kc-1,n))
derives(ic,kc,XYDER) = forth*(crse(ic+1,jc,kc+1,n) - crse(ic-1,jc,kc+1,n)
& + crse(ic-1,jc,kc-1,n) - crse(ic+1,jc,kc-1,n))
if (mask(i-1,j,k) .ne. not_covered) then
derives(ic,kc,XDER) = crse(ic+1,jc,kc,n) - crse(ic,jc,kc,n)
derives(ic,kc,X2DER) = zero
end if
if (mask(i+ratiox,j,k) .ne. not_covered) then
derives(ic,kc,XDER) = crse(ic,jc,kc,n) - crse(ic-1,jc,kc,n)
derives(ic,kc,X2DER) = zero
end if
if (mask(i-1,j,k) .ne. not_covered .and.
$ mask(i+ratiox,j,k) .ne. not_covered) then
derives(ic,kc,XDER) = zero
end if
if (mask(i,j,k-1) .ne. not_covered) then
derives(ic,kc,YDER) = crse(ic,jc,kc+1,n) - crse(ic,jc,kc,n)
derives(ic,kc,Y2DER) = zero
end if
if (mask(i,j,k+ratioz) .ne. not_covered) then
derives(ic,kc,YDER) = crse(ic,jc,kc,n) - crse(ic,jc,kc-1,n)
derives(ic,kc,Y2DER) = zero
end if
if (mask(i,j,k-1) .ne. not_covered .and.
$ mask(i,j,k+ratioz) .ne. not_covered) then
derives(ic,kc,YDER) = zero
end if
if (
$ ( mask(i+ratiox,j,k+ratioz) .ne. not_covered ) .or.
$ ( mask(i-1,j,k+ratioz) .ne. not_covered ) .or.
$ ( mask(i+ratiox,j,k-1) .ne. not_covered ) .or.
$ ( mask(i-1,j,k-1) .ne. not_covered ) ) then
derives(ic,kc,XYDER) = zero
end if
end do
end do
c ::::: interpolate to fine grid
do koff = 0, ratioz - 1
yy = (dble(koff - ratioz/2) + half)/ratioz
do kc = kclo,kchi
k = ratioz*kc + koff
do ioff = 0, ratiox - 1
xx = (dble(ioff - ratiox/2) + half)/ratiox
do ic = iclo, ichi
i = ratiox*ic + ioff
bdry(i,j,k,n) = crse(ic,jc,kc,n) + xx*derives(ic,kc,XDER)
& + derives(ic,kc,X2DER)*xx**2 + yy*derives(ic,kc,YDER)
& + derives(ic,kc,Y2DER)*yy**2 + xx*yy*derives(ic,kc,XYDER)
end do
end do
end do
end do
end do
return
end
c ---------------------------------------------------------------
c :: FORT_BDINTERPYHI : Interpolation on Yhi Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(3) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array for derivatives
c ---------------------------------------------------------------
subroutine FORT_BDINTERPYHI (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(3), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(cb)
integer DIMDEC(mask)
integer DIMDEC(crse)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM13(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, yy, ainterp
integer i, j, k, ic, jc, kc, ioff, koff, n
integer iclo, ichi, kclo, kchi, ratiox, ratioz
ratiox = ratios(1)
ratioz = ratios(3)
kclo = ARG_L3(cb)
kchi = ARG_H3(cb)
iclo = ARG_L1(cb)
ichi = ARG_H1(cb)
jc = ARG_H2(cb)+1
j = hi(2)+1
do n = 1, nvar
c ::::: define interp coefs
do kc = kclo, kchi
k = ratioz*kc
do ic = iclo, ichi
i = ratiox*ic
derives(ic,kc,XDER) = half*(crse(ic+1,jc,kc,n) - crse(ic-1,jc,kc,n))
derives(ic,kc,X2DER) = half*(crse(ic+1,jc,kc,n) - two*crse(ic,jc,kc,n)
& + crse(ic-1,jc,kc,n))
derives(ic,kc,YDER) = half*(crse(ic,jc,kc+1,n) - crse(ic,jc,kc-1,n))
derives(ic,kc,Y2DER) = half*(crse(ic,jc,kc+1,n) - two*crse(ic,jc,kc,n)
& + crse(ic,jc,kc-1,n))
derives(ic,kc,XYDER) = forth*(crse(ic+1,jc,kc+1,n) - crse(ic-1,jc,kc+1,n)
& + crse(ic-1,jc,kc-1,n) - crse(ic+1,jc,kc-1,n))
if (mask(i-1,j,k) .ne. not_covered) then
derives(ic,kc,XDER) = crse(ic+1,jc,kc,n) - crse(ic,jc,kc,n)
derives(ic,kc,X2DER) = zero
end if
if (mask(i+ratiox,j,k) .ne. not_covered) then
derives(ic,kc,XDER) = crse(ic,jc,kc,n) - crse(ic-1,jc,kc,n)
derives(ic,kc,X2DER) = zero
end if
if (mask(i-1,j,k) .ne. not_covered .and.
$ mask(i+ratiox,j,k) .ne. not_covered) then
derives(ic,kc,XDER) = zero
end if
if (mask(i,j,k-1) .ne. not_covered) then
derives(ic,kc,YDER) = crse(ic,jc,kc+1,n) - crse(ic,jc,kc,n)
derives(ic,kc,Y2DER) = zero
end if
if (mask(i,j,k+ratioz) .ne. not_covered) then
derives(ic,kc,YDER) = crse(ic,jc,kc,n) - crse(ic,jc,kc-1,n)
derives(ic,kc,Y2DER) = zero
end if
if (mask(i,j,k-1) .ne. not_covered .and.
$ mask(i,j,k+ratioz) .ne. not_covered) then
derives(ic,kc,YDER) = zero
end if
if (
$ ( mask(i+ratiox,j,k+ratioz) .ne. not_covered ) .or.
$ ( mask(i-1,j,k+ratioz) .ne. not_covered ) .or.
$ ( mask(i+ratiox,j,k-1) .ne. not_covered ) .or.
$ ( mask(i-1,j,k-1) .ne. not_covered ) ) then
derives(ic,kc,XYDER) = zero
end if
end do
end do
c ::::: interpolate to fine grid
do koff = 0, ratioz - 1
yy = (dble(koff - ratioz/2) + half)/ratioz
do kc = kclo,kchi
k = ratioz*kc + koff
do ioff = 0, ratiox - 1
xx = (dble(ioff - ratiox/2) + half)/ratiox
do ic = iclo, ichi
i = ratiox*ic + ioff
bdry(i,j,k,n) = crse(ic,jc,kc,n) + xx*derives(ic,kc,XDER)
& + derives(ic,kc,X2DER)*xx**2 + yy*derives(ic,kc,YDER)
& + derives(ic,kc,Y2DER)*yy**2 + xx*yy*derives(ic,kc,XYDER)
end do
end do
end do
end do
end do
return
end
c ---------------------------------------------------------------
c :: FORT_BDINTERPZLO : Interpolation on Zlo Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(3) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array for derivatives
c ---------------------------------------------------------------
subroutine FORT_BDINTERPZLO (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(3), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(cb)
integer DIMDEC(mask)
integer DIMDEC(crse)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM12(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, yy, ainterp
integer i, j, k, ic, jc, kc, ioff, joff, n
integer iclo, ichi, jclo, jchi, ratiox, ratioy
ratiox = ratios(1)
ratioy = ratios(2)
jclo = ARG_L2(cb)
jchi = ARG_H2(cb)
iclo = ARG_L1(cb)
ichi = ARG_H1(cb)
kc = ARG_L3(cb)-1
k = lo(3)-1
do n = 1, nvar
c ::::: define interp coefs
do jc = jclo, jchi
j = ratioy*jc
do ic = iclo, ichi
i = ratiox*ic
derives(ic,jc,XDER) = half*(crse(ic+1,jc,kc,n) - crse(ic-1,jc,kc,n) )
derives(ic,jc,X2DER) = half*(crse(ic+1,jc,kc,n) - two*crse(ic,jc,kc,n) + crse(ic-1,jc,kc,n) )
derives(ic,jc,YDER) = half*(crse(ic,jc+1,kc,n) - crse(ic,jc-1,kc,n) )
derives(ic,jc,Y2DER) = half*(crse(ic,jc+1,kc,n) - two*crse(ic,jc,kc,n) + crse(ic,jc-1,kc,n) )
derives(ic,jc,XYDER) = forth*(crse(ic+1,jc+1,kc,n) - crse(ic-1,jc+1,kc,n)
& + crse(ic-1,jc-1,kc,n) - crse(ic+1,jc-1,kc,n))
if (mask(i-1,j,k) .ne. not_covered) then
derives(ic,jc,XDER) = crse(ic+1,jc,kc,n) - crse(ic,jc,kc,n)
derives(ic,jc,X2DER) = zero
end if
if (mask(i+ratiox,j,k) .ne. not_covered) then
derives(ic,jc,XDER) = crse(ic,jc,kc,n) - crse(ic-1,jc,kc,n)
derives(ic,jc,X2DER) = zero
end if
if (mask(i-1,j,k) .ne. not_covered .and.
$ mask(i+ratiox,j,k) .ne. not_covered) then
derives(ic,jc,XDER) = zero
end if
if (mask(i,j-1,k) .ne. not_covered) then
derives(ic,jc,YDER) = crse(ic,jc+1,kc,n) - crse(ic,jc,kc,n)
derives(ic,jc,Y2DER) = zero
end if
if (mask(i,j+ratioy,k) .ne. not_covered) then
derives(ic,jc,YDER) = crse(ic,jc,kc,n) - crse(ic,jc-1,kc,n)
derives(ic,jc,Y2DER) = zero
end if
if (mask(i,j-1,k) .ne. not_covered .and.
$ mask(i,j+ratioy,k) .ne. not_covered) then
derives(ic,jc,YDER) = zero
end if
if (
$ ( mask(i+ratiox,j+ratioy,k) .ne. not_covered ) .or.
$ ( mask(i-1,j+ratioy,k) .ne. not_covered ) .or.
$ ( mask(i+ratiox,j-1,k) .ne. not_covered ) .or.
$ ( mask(i-1,j-1,k) .ne. not_covered ) ) then
derives(ic,jc,XYDER) = zero
end if
end do
end do
c ::::: interpolate to fine grid
do joff = 0, ratioy - 1
yy = (dble(joff - ratioy/2) + half)/ratioy
do jc = jclo,jchi
j = ratioy*jc + joff
do ioff = 0, ratiox - 1
xx = (dble(ioff - ratiox/2) + half)/ratiox
do ic = iclo, ichi
i = ratiox*ic + ioff
bdry(i,j,k,n) = crse(ic,jc,kc,n) + xx*derives(ic,jc,XDER)
& + derives(ic,jc,X2DER)*xx**2 + yy*derives(ic,jc,YDER)
& + derives(ic,jc,Y2DER)*yy**2 + xx*yy*derives(ic,jc,XYDER)
end do
end do
end do
end do
end do
return
end
c ---------------------------------------------------------------
c :: FORT_BDINTERPZHI : Interpolation on Zhi Face
c :: Quadratic Interpolation from crse data
c :: in directions transverse to face of grid
c ::
c :: Inputs/Outputs:
c :: bdry <= fine grid bndry data strip
c :: DIMS(bdry) => index limits of bdry
c :: lo,hi => index limits of grd interior
c :: DIMS(cb) => index limits of coarsened grid interior
c :: nvar => number of variables to interpolate
c :: ratios(3) => refinement ratios
c :: not_covered => mask is set to this value if cell is not
c :: covered by another fine grid and not outside the domain.
c :: mask => fine grid mask bndry strip
c :: DIMS(mask) => index limits of mask array
c :: crse => crse grid bndry data strip
c :: DIMS(crse) => index limits of crse array
c :: derives => crse grid tmp array for derivatives
c ---------------------------------------------------------------
subroutine FORT_BDINTERPZHI (bdry,DIMS(bdry),
& lo,hi,DIMS(cb),nvar,ratios,not_covered,
& mask,DIMS(mask),crse,DIMS(crse),derives)
integer nvar, ratios(3), not_covered
integer lo(SDIM), hi(SDIM)
integer DIMDEC(bdry)
integer DIMDEC(cb)
integer DIMDEC(mask)
integer DIMDEC(crse)
REAL_T bdry(DIMV(bdry),nvar)
REAL_T derives(DIM12(cb),NUMDERIV)
integer mask(DIMV(mask))
REAL_T crse(DIMV(crse),nvar)
REAL_T xx, yy, ainterp
integer i, j, k, ic, jc, kc, ioff, joff, n
integer iclo, ichi, jclo, jchi, ratiox, ratioy
ratiox = ratios(1)
ratioy = ratios(2)
jclo = ARG_L2(cb)
jchi = ARG_H2(cb)
iclo = ARG_L1(cb)
ichi = ARG_H1(cb)
kc = ARG_H3(cb)+1
k = hi(3)+1
do n = 1, nvar
c ::::: define interp coefs
do jc = jclo, jchi
j = ratioy*jc
do ic = iclo, ichi
i = ratiox*ic
derives(ic,jc,XDER) = half*(crse(ic+1,jc,kc,n) - crse(ic-1,jc,kc,n))
derives(ic,jc,X2DER) = half*(crse(ic+1,jc,kc,n) - two*crse(ic,jc,kc,n)
& + crse(ic-1,jc,kc,n))
derives(ic,jc,YDER) = half*(crse(ic,jc+1,kc,n) - crse(ic,jc-1,kc,n))
derives(ic,jc,Y2DER) = half*(crse(ic,jc+1,kc,n) - two*crse(ic,jc,kc,n)
& + crse(ic,jc-1,kc,n))
derives(ic,jc,XYDER) = forth*(crse(ic+1,jc+1,kc,n) - crse(ic-1,jc+1,kc,n)
& + crse(ic-1,jc-1,kc,n) - crse(ic+1,jc-1,kc,n))
if (mask(i-1,j,k) .ne. not_covered) then
derives(ic,jc,XDER) = crse(ic+1,jc,kc,n) - crse(ic,jc,kc,n)
derives(ic,jc,X2DER) = zero
end if
if (mask(i+ratiox,j,k) .ne. not_covered) then
derives(ic,jc,XDER) = crse(ic,jc,kc,n) - crse(ic-1,jc,kc,n)
derives(ic,jc,X2DER) = zero
end if
if (mask(i-1,j,k) .ne. not_covered .and.
$ mask(i+ratiox,j,k) .ne. not_covered) then
derives(ic,jc,XDER) = zero
end if
if (mask(i,j-1,k) .ne. not_covered) then
derives(ic,jc,YDER) = crse(ic,jc+1,kc,n) - crse(ic,jc,kc,n)
derives(ic,jc,Y2DER) = zero
end if
if (mask(i,j+ratioy,k) .ne. not_covered) then
derives(ic,jc,YDER) = crse(ic,jc,kc,n) - crse(ic,jc-1,kc,n)
derives(ic,jc,Y2DER) = zero
end if
if (mask(i,j-1,k) .ne. not_covered .and.
$ mask(i,j+ratioy,k) .ne. not_covered) then
derives(ic,jc,YDER) = zero
end if
if (
$ ( mask(i+ratiox,j+ratioy,k) .ne. not_covered ) .or.
$ ( mask(i-1,j+ratioy,k) .ne. not_covered ) .or.
$ ( mask(i+ratiox,j-1,k) .ne. not_covered ) .or.
$ ( mask(i-1,j-1,k) .ne. not_covered ) ) then
derives(ic,jc,XYDER) = zero
end if
end do
end do
c ::::: interpolate to fine grid
do joff = 0, ratioy - 1
yy = (dble(joff - ratioy/2) + half)/ratioy
do jc = jclo,jchi
j = ratioy*jc + joff
do ioff = 0, ratiox - 1
xx = (dble(ioff - ratiox/2) + half)/ratiox
do ic = iclo, ichi
i = ratiox*ic + ioff
bdry(i,j,k,n) = crse(ic,jc,kc,n) + xx*derives(ic,jc,XDER)
& + derives(ic,jc,X2DER)*xx**2 + yy*derives(ic,jc,YDER)
& + derives(ic,jc,Y2DER)*yy**2 + xx*yy*derives(ic,jc,XYDER)
end do
end do
end do
end do
end do
return
end
#undef NUMDERIV
#undef XDER
#undef YDER
#undef X2DER
#undef Y2DER
#undef XYDER
ccseapps-2.5/CCSEApps/mglib/LP_3D.F 0000644 0001750 0001750 00000021252 11634153073 017723 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: LP_3D.F,v 1.4 2002/08/29 22:14:39 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
#include
#include "LP_F.H"
#include "ArrayLim.H"
c-----------------------------------------------------------------------
c
c Gauss-Seidel Red-Black (GSRB):
c Apply the GSRB relaxation to the state phi for the equation
c L(phi) = Div(Grad(phi(x))) = rhs(x) central differenced, according
c to the arrays of boundary masks (m#) and auxiliary data (f#).
c
c In general, if the linear operator L=gamma*y-rho, the GS relaxation
c is y = (R - rho)/gamma. Near a boundary, the ghost data is filled
c using a polynomial interpolant based on the "old" phi values, so
c L=(gamma-delta)*y - rho + delta*yOld. The resulting iteration is
c
c y = (R - delta*yOld + rho)/(gamma - delta)
c
c This expression is valid additionally in the interior provided
c delta->0 there. delta is constructed by summing all the
c contributions to the central stencil element coming from boundary
c interpolants. The f#s contain the corresponding coefficient of
c the interpolating polynomial. The masks are set > 0 if the boundary
c value was filled with an interpolant involving the central stencil
c element.
c
c-----------------------------------------------------------------------
subroutine FORT_GSRB (
$ phi, DIMS(phi),
$ rhs, DIMS(rhs),
$ f0, DIMS(f0), m0, DIMS(m0),
$ f1, DIMS(f1), m1, DIMS(m1),
$ f2, DIMS(f2), m2, DIMS(m2),
$ f3, DIMS(f3), m3, DIMS(m3),
$ f4, DIMS(f4), m4, DIMS(m4),
$ f5, DIMS(f5), m5, DIMS(m5),
$ lo, hi, nc,
$ h, redblack
$ )
integer nc
integer DIMDEC(phi)
REAL_T phi(DIMV(phi),nc)
integer DIMDEC(rhs)
REAL_T rhs(DIMV(rhs),nc)
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM)
integer redblack
integer DIMDEC(f0)
integer DIMDEC(f1)
integer DIMDEC(f2)
integer DIMDEC(f3)
integer DIMDEC(f4)
integer DIMDEC(f5)
REAL_T f0(DIMV(f0))
REAL_T f1(DIMV(f1))
REAL_T f2(DIMV(f2))
REAL_T f3(DIMV(f3))
REAL_T f4(DIMV(f4))
REAL_T f5(DIMV(f5))
integer DIMDEC(m0)
integer DIMDEC(m1)
integer DIMDEC(m2)
integer DIMDEC(m3)
integer DIMDEC(m4)
integer DIMDEC(m5)
integer m0(DIMV(m0))
integer m1(DIMV(m1))
integer m2(DIMV(m2))
integer m3(DIMV(m3))
integer m4(DIMV(m4))
integer m5(DIMV(m5))
REAL_T h
c
integer i, j, k, ioff, n
c
REAL_T cf0, cf1, cf2, cf3, cf4, cf5
REAL_T delta, gamma, rho
c
gamma = 6.0D0
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
ioff = MOD(j + k + redblack,2)
do i = lo(1) + ioff,hi(1),2
c
cf0 = cvmgt(f0(lo(1),j,k), 0.0D0,
$ (i .eq. lo(1)) .and. (m0(lo(1)-1,j,k).gt.0))
cf1 = cvmgt(f1(i,lo(2),k), 0.0D0,
$ (j .eq. lo(2)) .and. (m1(i,lo(2)-1,k).gt.0))
cf2 = cvmgt(f2(i,j,lo(3)), 0.0D0,
$ (k .eq. lo(3)) .and. (m2(i,j,lo(3)-1).gt.0))
cf3 = cvmgt(f3(hi(1),j,k), 0.0D0,
$ (i .eq. hi(1)) .and. (m3(hi(1)+1,j,k).gt.0))
cf4 = cvmgt(f4(i,hi(2),k), 0.0D0,
$ (j .eq. hi(2)) .and. (m4(i,hi(2)+1,k).gt.0))
cf5 = cvmgt(f5(i,j,hi(3)), 0.0D0,
$ (k .eq. hi(3)) .and. (m5(i,j,hi(3)+1).gt.0))
c
delta = cf0 + cf1 + cf2 + cf3 + cf4 + cf5
c
rho = phi(i-1,j,k,n) + phi(i+1,j,k,n)
$ + phi(i,j-1,k,n) + phi(i,j+1,k,n)
$ + phi(i,j,k-1,n) + phi(i,j,k+1,n)
c
phi(i,j,k,n)
$ = (rhs(i,j,k,n)*h*h - rho + phi(i,j,k,n)*delta)
$ / (delta - gamma)
c
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c Solve Preconditioned system here
c
subroutine FORT_CGPRECND(
$ zz, DIMS(zz),
$ rho,
$ rr, DIMS(rr),
$ lo, hi, nc,
$ h
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(zz)
REAL_T zz(DIMV(zz),nc)
integer DIMDEC(rr)
REAL_T rr(DIMV(rr),nc)
REAL_T h
REAL_T rho
c
integer i
integer j
integer k
integer n
REAL_T denom
c
rho = 0.0D0
denom = -h**2*sixth
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
zz(i,j,k,n) = rr(i,j,k,n)*denom
rho = rho + zz(i,j,k,n)*rr(i,j,k,n)
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c Fill in a matrix x vector operator here
c
subroutine FORT_ADOTX(
$ y, DIMS(y),
$ x, DIMS(x),
$ lo, hi, nc,
$ h
$ )
integer nc
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
integer DIMDEC(y)
REAL_T y(DIMV(y),nc)
integer DIMDEC(x)
REAL_T x(DIMV(x),nc)
REAL_T h
c
integer i, j, k, n
REAL_T scal
c
scal = 1.0D0/h**2
c
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)
y(i,j,k,n) = scal*
$ ( x(i-1,j,k,n) + x(i+1,j,k,n)
$ + x(i,j-1,k,n) + x(i,j+1,k,n)
$ + x(i,j,k-1,n) + x(i,j,k+1,n)
$ - 6*x(i,j,k,n) )
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c Fill in fluxes
c
subroutine FORT_FLUX(
$ x,DIMS(x),
$ lo,hi,nc,
$ h,
$ xflux,DIMS(xflux),
$ yflux,DIMS(yflux),
$ zflux,DIMS(zflux)
$ )
implicit none
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(x)
integer DIMDEC(xflux)
integer DIMDEC(yflux)
integer DIMDEC(zflux)
REAL_T x(DIMV(x),nc)
REAL_T xflux(DIMV(xflux),nc)
REAL_T yflux(DIMV(yflux),nc)
REAL_T zflux(DIMV(zflux),nc)
REAL_T h(BL_SPACEDIM)
c
REAL_T dhx, dhy, dhz
integer i,j,k,n
c
dhx = one/h(1)
dhy = one/h(2)
dhz = one/h(3)
c
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)
do i = lo(1), hi(1)+1
xflux(i,j,k,n) = - dhx*( x(i,j,k,n) - x(i-1,j,k,n) )
end do
end do
end do
end do
do n = 1, nc
do k = lo(3), hi(3)
do j = lo(2), hi(2)+1
do i = lo(1), hi(1)
yflux(i,j,k,n) = - dhy*( x(i,j,k,n) - x(i,j-1,k,n) )
end do
end do
end do
end do
do n = 1, nc
do k = lo(3), hi(3)+1
do j = lo(2), hi(2)
do i = lo(1), hi(1)
zflux(i,j,k,n) = - dhz*( x(i,j,k,n) - x(i,j,k-1,n) )
end do
end do
end do
end do
end
ccseapps-2.5/CCSEApps/mglib/.cvsignore 0000644 0001750 0001750 00000000225 11634153073 020750 0 ustar amckinstry amckinstry *.for
Debug
Debug3D
Release
Release3D
lib
hglib___
*.ncb *.opt *.plg
grdlog
ti_files
chk[0-9][0-9][0-9][0-9]
plt[0-9][0-9][0-9][0-9]
*.pixie *.Addrs
ccseapps-2.5/CCSEApps/mglib/Laplacian.cpp 0000644 0001750 0001750 00000015551 11634153073 021350 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: Laplacian.cpp,v 1.13 2001/08/09 22:42:00 marc Exp $
//
#include
#include
#include
Real
Laplacian::norm (int nm, int level)
{
switch ( nm )
{
case 0:
return 8.0/(h[level][0]*h[level][0]);
}
BoxLib::Error("Bad Laplacian::norm");
return -1.0;
}
void
Laplacian::compFlux (D_DECL(MultiFab &xflux, MultiFab &yflux, MultiFab &zflux),
MultiFab& in, const BC_Mode& bc_mode)
{
int level = 0;
int src_comp = 0;
int num_comp = 1;
applyBC(in,src_comp,num_comp,level,bc_mode);
const BoxArray& bxa = gbox[level];
int nc = in.nComp();
for (MFIter inmfi(in); inmfi.isValid(); ++inmfi)
{
BL_ASSERT(bxa[inmfi.index()] == inmfi.validbox());
FORT_FLUX(in[inmfi].dataPtr(),
ARLIM(in[inmfi].loVect()), ARLIM(in[inmfi].hiVect()),
inmfi.validbox().loVect(), inmfi.validbox().hiVect(), &nc,
h[level],
xflux[inmfi].dataPtr(),
ARLIM(xflux[inmfi].loVect()), ARLIM(xflux[inmfi].hiVect()),
yflux[inmfi].dataPtr(),
ARLIM(yflux[inmfi].loVect()), ARLIM(yflux[inmfi].hiVect())
#if (BL_SPACEDIM == 3)
,zflux[inmfi].dataPtr(),
ARLIM(zflux[inmfi].loVect()), ARLIM(zflux[inmfi].hiVect())
#endif
);
}
}
void
Laplacian::Fsmooth (MultiFab& solnL,
const MultiFab& rhsL,
int level,
int redBlackFlag)
{
const BoxArray& bxa = gbox[level];
OrientationIter oitr;
const FabSet& f0 = (*undrrelxr[level])[oitr()]; oitr++;
const FabSet& f1 = (*undrrelxr[level])[oitr()]; oitr++;
const FabSet& f2 = (*undrrelxr[level])[oitr()]; oitr++;
const FabSet& f3 = (*undrrelxr[level])[oitr()]; oitr++;
#if (BL_SPACEDIM > 2)
const FabSet& f4 = (*undrrelxr[level])[oitr()]; oitr++;
const FabSet& f5 = (*undrrelxr[level])[oitr()]; oitr++;
#endif
int nc = rhsL.nComp();
for (MFIter solnLmfi(solnL); solnLmfi.isValid(); ++solnLmfi)
{
oitr.rewind();
int gn = solnLmfi.index();
const Mask& m0 = *maskvals[level][gn][oitr()]; oitr++;
const Mask& m1 = *maskvals[level][gn][oitr()]; oitr++;
const Mask& m2 = *maskvals[level][gn][oitr()]; oitr++;
const Mask& m3 = *maskvals[level][gn][oitr()]; oitr++;
#if (BL_SPACEDIM > 2 )
const Mask& m4 = *maskvals[level][gn][oitr()]; oitr++;
const Mask& m5 = *maskvals[level][gn][oitr()]; oitr++;
#endif
BL_ASSERT(bxa[solnLmfi.index()] == solnLmfi.validbox());
#if (BL_SPACEDIM == 2)
FORT_GSRB(
solnL[solnLmfi].dataPtr(),
ARLIM(solnL[solnLmfi].loVect()),ARLIM(solnL[solnLmfi].hiVect()),
rhsL[solnLmfi].dataPtr(),
ARLIM(rhsL[solnLmfi].loVect()), ARLIM(rhsL[solnLmfi].hiVect()),
f0[solnLmfi].dataPtr(),
ARLIM(f0[solnLmfi].loVect()), ARLIM(f0[solnLmfi].hiVect()),
m0.dataPtr(),
ARLIM(m0.loVect()), ARLIM(m0.hiVect()),
f1[solnLmfi].dataPtr(),
ARLIM(f1[solnLmfi].loVect()), ARLIM(f1[solnLmfi].hiVect()),
m1.dataPtr(),
ARLIM(m1.loVect()), ARLIM(m1.hiVect()),
f2[solnLmfi].dataPtr(),
ARLIM(f2[solnLmfi].loVect()), ARLIM(f2[solnLmfi].hiVect()),
m2.dataPtr(),
ARLIM(m2.loVect()), ARLIM(m2.hiVect()),
f3[solnLmfi].dataPtr(),
ARLIM(f3[solnLmfi].loVect()), ARLIM(f3[solnLmfi].hiVect()),
m3.dataPtr(),
ARLIM(m3.loVect()), ARLIM(m3.hiVect()),
solnLmfi.validbox().loVect(), solnLmfi.validbox().hiVect(), &nc,
h[level], &redBlackFlag);
#endif
#if (BL_SPACEDIM == 3)
FORT_GSRB(
solnL[solnLmfi].dataPtr(),
ARLIM(solnL[solnLmfi].loVect()),ARLIM(solnL[solnLmfi].hiVect()),
rhsL[solnLmfi].dataPtr(),
ARLIM(rhsL[solnLmfi].loVect()), ARLIM(rhsL[solnLmfi].hiVect()),
f0[solnLmfi].dataPtr(),
ARLIM(f0[solnLmfi].loVect()), ARLIM(f0[solnLmfi].hiVect()),
m0.dataPtr(),
ARLIM(m0.loVect()), ARLIM(m0.hiVect()),
f1[solnLmfi].dataPtr(),
ARLIM(f1[solnLmfi].loVect()), ARLIM(f1[solnLmfi].hiVect()),
m1.dataPtr(),
ARLIM(m1.loVect()), ARLIM(m1.hiVect()),
f2[solnLmfi].dataPtr(),
ARLIM(f2[solnLmfi].loVect()), ARLIM(f2[solnLmfi].hiVect()),
m2.dataPtr(),
ARLIM(m2.loVect()), ARLIM(m2.hiVect()),
f3[solnLmfi].dataPtr(),
ARLIM(f3[solnLmfi].loVect()), ARLIM(f3[solnLmfi].hiVect()),
m3.dataPtr(),
ARLIM(m3.loVect()), ARLIM(m3.hiVect()),
f4[solnLmfi].dataPtr(),
ARLIM(f4[solnLmfi].loVect()), ARLIM(f4[solnLmfi].hiVect()),
m4.dataPtr(),
ARLIM(m4.loVect()), ARLIM(m4.hiVect()),
f5[solnLmfi].dataPtr(),
ARLIM(f5[solnLmfi].loVect()), ARLIM(f5[solnLmfi].hiVect()),
m5.dataPtr(),
ARLIM(m5.loVect()), ARLIM(m5.hiVect()),
solnLmfi.validbox().loVect(), solnLmfi.validbox().hiVect(), &nc,
h[level], &redBlackFlag);
#endif
}
}
void
Laplacian::Fapply (MultiFab& y,
const MultiFab& x,
int level)
{
int nc = y.nComp();
for (MFIter ymfi(y); ymfi.isValid(); ++ymfi)
{
FORT_ADOTX(y[ymfi].dataPtr(),
ARLIM(y[ymfi].loVect()), ARLIM(y[ymfi].hiVect()),
x[ymfi].dataPtr(),
ARLIM(x[ymfi].loVect()), ARLIM(x[ymfi].hiVect()),
ymfi.validbox().loVect(), ymfi.validbox().hiVect(), &nc,
h[level]);
}
}
ccseapps-2.5/CCSEApps/mglib/ABec_2D.F 0000644 0001750 0001750 00000033674 11634153073 020214 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: ABec_2D.F,v 1.9 2002/11/27 21:54:35 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
#include "ABec_F.H"
#include "ArrayLim.H"
#include "CONSTANTS.H"
c-----------------------------------------------------------------------
c
c Gauss-Seidel Red-Black (GSRB):
c Apply the GSRB relaxation to the state phi for the equation
c L(phi) = alpha*a(x)*phi(x) - beta*Div(b(x)Grad(phi(x))) = rhs(x)
c central differenced, according to the arrays of boundary
c masks (m#) and auxiliary data (f#).
c
c In general, if the linear operator L=gamma*y-rho, the GS relaxation
c is y = (R - rho)/gamma. Near a boundary, the ghost data is filled
c using a polynomial interpolant based on the "old" phi values, so
c L=(gamma-delta)*y - rho + delta*yOld. The resulting iteration is
c
c y = (R - delta*yOld + rho)/(gamma - delta)
c
c This expression is valid additionally in the interior provided
c delta->0 there. delta is constructed by summing all the
c contributions to the central stencil element coming from boundary
c interpolants. The f#s contain the corresponding coefficient of
c the interpolating polynomial. The masks are set > 0 if the boundary
c value was filled with an interpolant involving the central stencil
c element.
c
c-----------------------------------------------------------------------
subroutine FORT_GSRB (
$ phi,DIMS(phi),
$ rhs,DIMS(rhs),
$ alpha, beta,
$ a, DIMS(a),
$ bX, DIMS(bX),
$ bY, DIMS(bY),
$ f0, DIMS(f0),
$ m0, DIMS(m0),
$ f1, DIMS(f1),
$ m1, DIMS(m1),
$ f2, DIMS(f2),
$ m2, DIMS(m2),
$ f3, DIMS(f3),
$ m3, DIMS(m3),
$ lo,hi,nc,
$ h,redblack
$ )
REAL_T alpha, beta
integer DIMDEC(phi)
integer DIMDEC(rhs)
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM)
integer nc
integer redblack
integer DIMDEC(f0)
REAL_T f0(DIMV(f0))
integer DIMDEC(f1)
REAL_T f1(DIMV(f1))
integer DIMDEC(f2)
REAL_T f2(DIMV(f2))
integer DIMDEC(f3)
REAL_T f3(DIMV(f3))
integer DIMDEC(m0)
integer m0(DIMV(m0))
integer DIMDEC(m1)
integer m1(DIMV(m1))
integer DIMDEC(m2)
integer m2(DIMV(m2))
integer DIMDEC(m3)
integer m3(DIMV(m3))
REAL_T h(BL_SPACEDIM)
REAL_T phi(DIMV(phi),nc)
REAL_T rhs(DIMV(rhs),nc)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
c
integer i, j, ioff, n
c
REAL_T dhx, dhy, cf0, cf1, cf2, cf3
REAL_T delta, gamma, rho, rho_x, rho_y
integer LSDIM
parameter(LSDIM=127)
REAL_T a_ls(0:LSDIM)
REAL_T b_ls(0:LSDIM)
REAL_T c_ls(0:LSDIM)
REAL_T r_ls(0:LSDIM)
REAL_T u_ls(0:LSDIM)
integer do_line
integer ilen,jlen
if (h(2). gt. 1.5D0*h(1)) then
do_line = 1
ilen = hi(1)-lo(1)+1
if (ilen .gt. LSDIM) then
print *,'TOO BIG FOR LINE SOLVE IN GSRB: ilen = ',ilen
call bl_error("stop")
end if
else if (h(1) .gt. 1.5D0*h(2)) then
do_line = 2
jlen = hi(2)-lo(2)+1
if (jlen .gt. LSDIM) then
print *,'TOO BIG FOR LINE SOLVE IN GSRB: jlen = ',jlen
call bl_error("stop")
end if
else
do_line = 0
end if
c
dhx = beta/h(1)**2
dhy = beta/h(2)**2
do n = 1, nc
if (do_line .eq. 0) then
do j = lo(2), hi(2)
ioff = MOD(j + redblack,2)
do i = lo(1) + ioff,hi(1),2
c
cf0 = cvmgt(f0(lo(1),j), 0.0D0,
$ (i .eq. lo(1)) .and. (m0(lo(1)-1,j).gt.0))
cf1 = cvmgt(f1(i,lo(2)), 0.0D0,
$ (j .eq. lo(2)) .and. (m1(i,lo(2)-1).gt.0))
cf2 = cvmgt(f2(hi(1),j), 0.0D0,
$ (i .eq. hi(1)) .and. (m2(hi(1)+1,j).gt.0))
cf3 = cvmgt(f3(i,hi(2)), 0.0D0,
$ (j .eq. hi(2)) .and. (m3(i,hi(2)+1).gt.0))
c
delta = dhx*(bX(i,j)*cf0 + bX(i+1,j)*cf2)
$ + dhy*(bY(i,j)*cf1 + bY(i,j+1)*cf3)
c
gamma = alpha*a(i,j)
$ + dhx*( bX(i,j) + bX(i+1,j) )
$ + dhy*( bY(i,j) + bY(i,j+1) )
c
rho = dhx*(bX(i,j)*phi(i-1,j,n) + bX(i+1,j)*phi(i+1,j,n))
$ +dhy*(bY(i,j)*phi(i,j-1,n) + bY(i,j+1)*phi(i,j+1,n))
c
phi(i,j,n) = (rhs(i,j,n) + rho - phi(i,j,n)*delta)
$ / (gamma - delta)
c
end do
end do
else if (do_line .eq. 2) then
do i = lo(1) + redblack,hi(1),2
do j = lo(2), hi(2)
c
cf0 = cvmgt(f0(lo(1),j), 0.0D0,
$ (i .eq. lo(1)) .and. (m0(lo(1)-1,j).gt.0))
cf1 = cvmgt(f1(i,lo(2)), 0.0D0,
$ (j .eq. lo(2)) .and. (m1(i,lo(2)-1).gt.0))
cf2 = cvmgt(f2(hi(1),j), 0.0D0,
$ (i .eq. hi(1)) .and. (m2(hi(1)+1,j).gt.0))
cf3 = cvmgt(f3(i,hi(2)), 0.0D0,
$ (j .eq. hi(2)) .and. (m3(i,hi(2)+1).gt.0))
c
delta = dhx*(bX(i,j)*cf0 + bX(i+1,j)*cf2)
$ + dhy*(bY(i,j)*cf1 + bY(i,j+1)*cf3)
c
gamma = alpha*a(i,j)
$ + dhx*( bX(i,j) + bX(i+1,j) )
$ + dhy*( bY(i,j) + bY(i,j+1) )
c
rho_x = dhx*(bX(i,j)*phi(i-1,j,n) + bX(i+1,j)*phi(i+1,j,n))
a_ls(j-lo(2)) = -dhy*bY(i,j)
b_ls(j-lo(2)) = gamma - delta
c_ls(j-lo(2)) = -dhy*bY(i,j+1)
r_ls(j-lo(2)) = rhs(i,j,n) + rho_x - phi(i,j,n)*delta
if (j .eq. lo(2))
$ r_ls(j-lo(2)) = r_ls(j-lo(2)) + dhy*bY(i,j)*phi(i,j-1,n)
if (j .eq. hi(2))
$ r_ls(j-lo(2)) = r_ls(j-lo(2)) + dhy*bY(i,j+1)*phi(i,j+1,n)
end do
call tridiag(a_ls,b_ls,c_ls,r_ls,u_ls,jlen)
c
do j = lo(2), hi(2)
phi(i,j,n) = u_ls(j-lo(2))
end do
end do
else if (do_line .eq. 1) then
do j = lo(2) + redblack,hi(2),2
do i = lo(1), hi(1)
c
cf0 = cvmgt(f0(lo(1),j), 0.0D0,
$ (i .eq. lo(1)) .and. (m0(lo(1)-1,j).gt.0))
cf1 = cvmgt(f1(i,lo(2)), 0.0D0,
$ (j .eq. lo(2)) .and. (m1(i,lo(2)-1).gt.0))
cf2 = cvmgt(f2(hi(1),j), 0.0D0,
$ (i .eq. hi(1)) .and. (m2(hi(1)+1,j).gt.0))
cf3 = cvmgt(f3(i,hi(2)), 0.0D0,
$ (j .eq. hi(2)) .and. (m3(i,hi(2)+1).gt.0))
c
delta = dhx*(bX(i,j)*cf0 + bX(i+1,j)*cf2)
$ + dhy*(bY(i,j)*cf1 + bY(i,j+1)*cf3)
c
gamma = alpha*a(i,j)
$ + dhx*( bX(i,j) + bX(i+1,j) )
$ + dhy*( bY(i,j) + bY(i,j+1) )
c
rho_y = dhy*(bY(i,j)*phi(i,j-1,n) + bY(i,j+1)*phi(i,j+1,n))
a_ls(i-lo(1)) = -dhx*bX(i,j)
b_ls(i-lo(1)) = gamma - delta
c_ls(i-lo(1)) = -dhx*bX(i+1,j)
r_ls(i-lo(1)) = rhs(i,j,n) + rho_y - phi(i,j,n)*delta
if (i .eq. lo(1))
$ r_ls(i-lo(1)) = r_ls(i-lo(1)) + dhx*bX(i,j)*phi(i-1,j,n)
if (i .eq. hi(1))
$ r_ls(i-lo(1)) = r_ls(i-lo(1)) + dhx*bX(i+1,j)*phi(i+1,j,n)
end do
call tridiag(a_ls,b_ls,c_ls,r_ls,u_ls,ilen)
c
do i = lo(1), hi(1)
phi(i,j,n) = u_ls(i-lo(1))
end do
end do
else
print *,'BOGUS DO_LINE '
call bl_error("stop")
end if
end do
end
c-----------------------------------------------------------------------
c
c Solve Preconditioned system here
c
subroutine FORT_CGPRECND(
$ zz,DIMS(zz),
$ rho,
$ rr,DIMS(rr),
$ alpha, beta,
$ a, DIMS(a),
$ bX,DIMS(bX),
$ bY,DIMS(bY),
$ lo,hi,nc,
$ h
$ )
REAL_T alpha, beta
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(zz)
integer DIMDEC(rr)
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
REAL_T zz(DIMV(zz),nc)
REAL_T rr(DIMV(rr),nc)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
REAL_T h(BL_SPACEDIM), rho
c
integer i,j, n
REAL_T de, dhx, dhy
c
rho = 0
dhx = beta/h(1)**2
dhy = beta/h(2)**2
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
de = 1.0D0/(alpha*a(i,j) + dhx*(bX(i+1,j)+bX(i,j))
$ + dhy*(bY(i,j+1)+bY(i,j))
$ )
zz(i,j,n) = rr(i,j,n)*de
rho = rho + zz(i,j,n)*rr(i,j,n)
end do
end do
end do
c
end
c-----------------------------------------------------------------------
c
c Fill in a matrix x vector operator here
c
subroutine FORT_ADOTX(
$ y,DIMS(y),
$ x,DIMS(x),
$ alpha, beta,
$ a, DIMS(a),
$ bX,DIMS(bX),
$ bY,DIMS(bY),
$ lo,hi,nc,
$ h
$ )
REAL_T alpha, beta
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(y)
integer DIMDEC(x)
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
REAL_T y(DIMV(y),nc)
REAL_T x(DIMV(x),nc)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
REAL_T h(BL_SPACEDIM)
c
integer i,j,n
REAL_T uxx,uyy,dhx,dhy
c
dhx = beta/h(1)**2
dhy = beta/h(2)**2
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
y(i,j,n) = alpha*a(i,j)*x(i,j,n)
$ - dhx*
$ ( bX(i+1,j)*( x(i+1,j,n) - x(i ,j,n) )
$ - bX(i ,j)*( x(i ,j,n) - x(i-1,j,n) ) )
$ - dhy*
$ ( bY(i,j+1)*( x(i,j+1,n) - x(i,j ,n) )
$ - bY(i,j )*( x(i,j ,n) - x(i,j-1,n) ) )
end do
end do
end do
end
c-----------------------------------------------------------------------
c
c Fill in a matrix x vector operator here
c
subroutine FORT_NORMA(
& res,
$ alpha, beta,
$ a, DIMS(a),
$ bX,DIMS(bX),
$ bY,DIMS(bY),
$ lo,hi,nc,
$ h
$ )
REAL_T res
REAL_T alpha, beta
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
REAL_T h(BL_SPACEDIM)
c
integer i,j,n
REAL_T uxx,uyy,dhx,dhy
c
dhx = beta/h(1)**2
dhy = beta/h(2)**2
c
res = 0.0D0
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)
res = max(res,
& + abs( alpha*a(i,j)
& + dhx * (bX(i+1,j) + bX(i,j))
& + dhy * (bY(i,j+1) + bY(i,j)))
$ + abs(-dhx*bX(i+1,j)) + abs(-dhx*bX(i,j))
& + abs(-dhy*bY(i,j+1)) + abs(-dhy*bY(i,j)))
end do
end do
end do
end
c-----------------------------------------------------------------------
c
c Fill in fluxes
c
subroutine FORT_FLUX(
$ x,DIMS(x),
$ alpha, beta,
$ a, DIMS(a),
$ bX,DIMS(bX),
$ bY,DIMS(bY),
$ lo,hi,nc,
$ h,
$ xflux,DIMS(xflux),
$ yflux,DIMS(yflux)
$ )
implicit none
REAL_T alpha, beta
integer lo(BL_SPACEDIM), hi(BL_SPACEDIM), nc
integer DIMDEC(x)
integer DIMDEC(a)
integer DIMDEC(bX)
integer DIMDEC(bY)
integer DIMDEC(xflux)
integer DIMDEC(yflux)
REAL_T x(DIMV(x),nc)
REAL_T a(DIMV(a))
REAL_T bX(DIMV(bX))
REAL_T bY(DIMV(bY))
REAL_T xflux(DIMV(xflux),nc)
REAL_T yflux(DIMV(yflux),nc)
REAL_T h(BL_SPACEDIM)
c
REAL_T dhx, dhy
integer i,j,n
c
dhx = one/h(1)
dhy = one/h(2)
c
do n = 1, nc
do j = lo(2), hi(2)
do i = lo(1), hi(1)+1
xflux(i,j,n) = - dhx*bX(i,j)*( x(i,j,n) - x(i-1,j,n) )
end do
end do
end do
do n = 1, nc
do j = lo(2), hi(2)+1
do i = lo(1), hi(1)
yflux(i,j,n) = - dhy*bY(i,j)*( x(i,j,n) - x(i,j-1,n) )
end do
end do
end do
end
ccseapps-2.5/CCSEApps/mglib/MG_3D.F 0000644 0001750 0001750 00000010050 11634153073 017705 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: MG_3D.F,v 1.2 1998/12/14 20:23:47 lijewski Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#include
#include
#include "MG_F.H"
#include "ArrayLim.H"
c-----------------------------------------------------------------------
subroutine FORT_AVERAGE (
$ c, DIMS(c),
$ f, DIMS(f),
$ lo, hi, nc
$ )
integer nc
integer DIMDEC(c)
integer DIMDEC(f)
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
REAL_T f(DIMV(f),nc)
REAL_T c(DIMV(c),nc)
c
integer i, i2, i2p1
integer j, j2, j2p1
integer k, k2, k2p1
integer n
REAL_T denom
parameter(denom=eighth)
c
do n = 1, nc
do k = lo(3), hi(3)
k2 = 2*k
k2p1 = k2 + 1
do j = lo(2), hi(2)
j2 = 2*j
j2p1 = j2 + 1
cdir$ ivdep
do i = lo(1), hi(1)
i2 = 2*i
i2p1 = i2 + 1
c
c(i,j,k,n) = (
$ + f(i2p1,j2p1,k2 ,n) + f(i2,j2p1,k2 ,n)
$ + f(i2p1,j2 ,k2 ,n) + f(i2,j2 ,k2 ,n)
$ + f(i2p1,j2p1,k2p1,n) + f(i2,j2p1,k2p1,n)
$ + f(i2p1,j2 ,k2p1,n) + f(i2,j2 ,k2p1,n)
$ )*denom
c
end do
end do
end do
end do
c
end
c-----------------------------------------------------------------------
subroutine FORT_INTERP (
$ f, DIMS(f),
$ c, DIMS(c),
$ lo, hi, nc
$ )
integer nc
integer DIMDEC(f)
integer DIMDEC(c)
integer lo(BL_SPACEDIM)
integer hi(BL_SPACEDIM)
REAL_T f(DIMV(f),nc)
REAL_T c(DIMV(c),nc)
c
integer i, i2, i2p1
integer j, j2, j2p1
integer k, k2, k2p1
integer n
c
do n = 1, nc
do k = lo(3), hi(3)
k2 = 2*k
k2p1 = k2 + 1
do j = lo(2), hi(2)
j2 = 2*j
j2p1 = j2 + 1
cdir$ ivdep
do i = lo(1), hi(1)
i2 = 2*i
i2p1 = i2 + 1
c
f(i2p1,j2p1,k2 ,n) = c(i,j,k,n) + f(i2p1,j2p1,k2 ,n)
f(i2 ,j2p1,k2 ,n) = c(i,j,k,n) + f(i2 ,j2p1,k2 ,n)
f(i2p1,j2 ,k2 ,n) = c(i,j,k,n) + f(i2p1,j2 ,k2 ,n)
f(i2 ,j2 ,k2 ,n) = c(i,j,k,n) + f(i2 ,j2 ,k2 ,n)
f(i2p1,j2p1,k2p1,n) = c(i,j,k,n) + f(i2p1,j2p1,k2p1,n)
f(i2 ,j2p1,k2p1,n) = c(i,j,k,n) + f(i2 ,j2p1,k2p1,n)
f(i2p1,j2 ,k2p1,n) = c(i,j,k,n) + f(i2p1,j2 ,k2p1,n)
f(i2 ,j2 ,k2p1,n) = c(i,j,k,n) + f(i2 ,j2 ,k2p1,n)
c
end do
end do
end do
end do
c
end
ccseapps-2.5/CCSEApps/mglib/ABecLaplacian.H 0000644 0001750 0001750 00000023637 11634153073 021474 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _ABecLAPLACIAN_H_
#define _ABecLAPLACIAN_H_
//
// $Id: ABecLaplacian.H,v 1.11 2002/11/20 16:55:55 lijewski Exp $
//
#include
#include
//@Man:
/*@Memo:
An ABecLaplacian tailors the description of a linear operator to apply
the second-order central difference approximation to the differential
operator, alpha*a(x).phi - beta*div[b(x).grad(phi)], on a cell-centered
MultiFab, phi. Here, alpha and beta are constants, a(x) is a
cell-centered MultiFab, and b(x) is a vector of wall-centered
MultiFabs, 1 per dimension. phi can have multiple components, but
all coefficient info is scalar, and norm reports on ALL components
together.
*/
/*@Doc:
An ABecLaplacian tailors a LinOp (a virtual base class for general
linear operators) to compute the second-order central difference
approximation to the differential operator,
\begin{center}
alpha*a(x).phi - beta*div[b(x).grad(phi)],
\end{center}
on a cell-centered
MultiFab, phi. Here, alpha and beta are constants, a(x) is a
cell-centered MultiFab, and b(x) is a vector of wall-centered
MultiFabs, 1 per dimension. phi can have multiple components, but
all coefficient info is scalar, and norm reports on ALL components
together.
This class provides the necessary
implementations for applying the operator, and for
smoothing a guessed solution to the linear equation system,
L(phi) = rhs (where rhs is another cell-centered MultiFab). This
class also provides access functions to set/control the coefficient
MulitFabs a and b, as well as the scalars, alpha and beta. These
customizations are designed for 2D and 3D, with constant (but
not necessarily equal) mesh spacing in each direction.
Application of the operator and smoothing are
"level" operations, and therefore must access "hidden" level data
(such as boundary conditions, etc) as required, in concert with the
semantics of the underlying LinOp defintions. Accordingly, these
implementations are "protected" and called only by the publically
accessible members of the virtual base class, LinOp. Note that these
implementations may therefore assume that boundary (ghost) nodes and
other pertinent information are filled properly by the base class
functions prior to call.
Defaults are as follows for the coefficients:
\begin{itemize}
\item alpha = 1.0
\item beta = 1.0
\item a (MultiFab) = 0.0
\item b (MultiFab) = 1.0
\end{itemize}
This class does NOT provide a copy constructor or assignment operator.
*/
class ABecLaplacian
:
public LinOp
{
public:
//
//@ManDoc: constructor for box array, boundary data and scalar mesh spacing
//
ABecLaplacian (const BndryData& bd,
Real _h);
//
//@ManDoc: constructor for box array, boundary data and vector mesh spacing
//
ABecLaplacian (const BndryData& bd,
const Real* _h);
//
//@ManDoc: destructor
//
virtual ~ABecLaplacian ();
//
//@ManDoc: Compute extensive (area-weighted) flux associated with the op
//
virtual void compFlux (D_DECL(MultiFab &xflux, MultiFab &yflux, MultiFab &zflux),
MultiFab& in, const BC_Mode& bc_mode=Inhomogeneous_BC);
void compFlux (D_DECL(MultiFab &xflux, MultiFab &yflux, MultiFab &zflux),
MultiFab& in, const BC_Mode& bc_mode, bool do_ApplyBC);
//
//@ManDoc: Set scalar coefficients.
//
void setScalars (Real _alpha,
Real _beta);
//
//@ManDoc: get scalar alpha coefficient
//
Real get_alpha () const;
//
//@ManDoc: get scalar beta coefficient
//
Real get_beta () const;
//
//@ManDoc: return reference to "a" coefficients for base level
//
const MultiFab& aCoefficients (int level = 0);
//
//@ManDoc: return reference to "b" coefficients for base level
//
const MultiFab& bCoefficients (int dir,
int level=0);
//
//@ManDoc: copy \_a into "a" coeffs for base level
//
void aCoefficients (const MultiFab& _a);
//
//@ManDoc: copy \_b into "b" coeffs in "dir" coordinate direction for base level
//
void bCoefficients (const MultiFab& _b,
int dir);
//
//@ManDoc: alternative (older) version of above members
//
void setCoefficients (const MultiFab& _a,
const MultiFab& _bX,
const MultiFab& _bY);
//
//@ManDoc: collective version of above members (taking an array of MultiFabs for "b")
//
void setCoefficients (const MultiFab& _a,
const MultiFab* _b);
//
//@ManDoc: allocate/fill internal data for new level
//
virtual void prepareForLevel (int level);
//
//@ManDoc: remove internal data for this level and all levels above
//
virtual void clearToLevel (int level);
//
//@ManDoc: set flags so that a coeffs at lev and coarser require recalculation
//
void invalidate_a_to_level (int lev);
//
//@ManDoc: set flags so that b coeffs at lev and coarser require recalculation
//
void invalidate_b_to_level (int lev);
virtual Real norm (int nm = 0, int level = 0);
protected:
//
//@ManDoc: initialize a full set (a,b) of coefficients on the box array
//
void initCoefficients (const BoxArray &_ba);
//
//@ManDoc: compute out=L(in) at level=level
//
virtual void Fapply (MultiFab& out,
const MultiFab& in,
int level);
//
//@ManDoc: apply smoother to improve residual to L(solnL)=rhsL
//
virtual void Fsmooth (MultiFab& solnL,
const MultiFab& rhsL,
int level,
int rgbflag);
//
//@ManDoc: Array (on level) of "a" coefficients
//
Array< MultiFab* > acoefs;
//
//@ManDoc: Array (on level) of Tuple (on dimension) of "b" coefficients
//
Array< Tuple< MultiFab*, BL_SPACEDIM> > bcoefs;
//
//@ManDoc: Scalar "alpha" coefficient
//
Real alpha;
//
//@ManDoc: Scalar "beta" coefficient
//
Real beta;
private:
//
// Flag, can a coeffs be trusted at a level.
//
std::vector a_valid;
//
// Flag, can b coeffs be trusted at a level.
//
std::vector b_valid;
//
// Default value for a (MultiFab) coefficient.
//
static Real a_def;
//
// Default value for b (MultiFab) coefficient.
//
static Real b_def;
//
// Default value for alpha (scalar) coefficient.
//
static Real alpha_def;
//
// Default value for beta (scalar) coefficient.
//
static Real beta_def;
//
// Disallow copy constructors (for now...to be fixed)
//
ABecLaplacian (const ABecLaplacian&);
ABecLaplacian& operator= (const ABecLaplacian&);
};
inline
Real
ABecLaplacian::get_alpha () const
{
return alpha;
}
inline
Real
ABecLaplacian::get_beta () const
{
return beta;
}
inline
void
ABecLaplacian::aCoefficients (const MultiFab& _a)
{
BL_ASSERT(_a.ok());
BL_ASSERT(_a.boxArray() == (acoefs[0])->boxArray());
invalidate_a_to_level(0);
(*acoefs[0]).copy(_a,0,0,1);
}
inline
void
ABecLaplacian::bCoefficients (const MultiFab& _b,
int dir)
{
BL_ASSERT(_b.ok());
BL_ASSERT(_b.boxArray() == (bcoefs[0][dir])->boxArray());
invalidate_b_to_level(0);
(*bcoefs[0][dir]).copy(_b,0,0,1);
}
inline
const MultiFab&
ABecLaplacian::aCoefficients (int level)
{
prepareForLevel(level);
return *acoefs[level];
}
inline
const MultiFab&
ABecLaplacian::bCoefficients (int dir,int level)
{
prepareForLevel(level);
return *bcoefs[level][dir];
}
inline
void
ABecLaplacian::setCoefficients (const MultiFab &_a,
const MultiFab &_bX,
const MultiFab &_bY)
{
aCoefficients(_a);
bCoefficients(_bX, 0);
bCoefficients(_bY, 1);
}
inline
void
ABecLaplacian::setCoefficients (const MultiFab& _a,
const MultiFab* _b)
{
aCoefficients(_a);
for (int n = 0; n < BL_SPACEDIM; ++n)
bCoefficients(_b[n], n);
}
inline
void
ABecLaplacian::setScalars (Real _alpha,
Real _beta)
{
alpha = _alpha;
beta = _beta;
}
#endif /*_ABecLAPLACIAN_H_*/
ccseapps-2.5/CCSEApps/mglib/LP_F.H 0000644 0001750 0001750 00000013537 11634153073 017653 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _LP_F_H_
#define _LP_F_H_
/*
** $Id: LP_F.H,v 1.7 2002/04/26 22:10:02 lijewski Exp $
*/
#include
#if defined(BL_LANG_FORT)
#if (BL_SPACEDIM == 2)
#define FORT_GSRB gsrb2dsim
#define FORT_CGPRECND cgprecnd2dsim
#define FORT_ADOTX adotx2dsim
#define FORT_FLUX flux2dsim
#endif
#if (BL_SPACEDIM == 3)
#define FORT_GSRB gsrb3dsim
#define FORT_CGPRECND cgprecnd3dsim
#define FORT_ADOTX adotx3dsim
#define FORT_FLUX flux3dsim
#endif
#else
#if (BL_SPACEDIM == 2)
#if defined(BL_FORT_USE_UPPERCASE)
#define FORT_GSRB GSRB2DSIM
#define FORT_CGPRECND CGPRECND2DSIM
#define FORT_ADOTX ADOTX2DSIM
#define FORT_FLUX FLUX2DSIM
#elif defined(BL_FORT_USE_LOWERCASE)
#define FORT_GSRB gsrb2dsim
#define FORT_CGPRECND cgprecnd2dsim
#define FORT_ADOTX adotx2dsim
#define FORT_FLUX flux2dsim
#elif defined(BL_FORT_USE_UNDERSCORE)
#define FORT_GSRB gsrb2dsim_
#define FORT_CGPRECND cgprecnd2dsim_
#define FORT_ADOTX adotx2dsim_
#define FORT_FLUX flux2dsim_
#endif
#endif
#if (BL_SPACEDIM == 3)
#if defined(BL_FORT_USE_UPPERCASE)
#define FORT_GSRB GSRB3DSIM
#define FORT_CGPRECND CGPRECND3DSIM
#define FORT_ADOTX ADOTX3DSIM
#define FORT_FLUX FLUX3DSIM
#elif defined(BL_FORT_USE_LOWERCASE)
#define FORT_GSRB gsrb3dsim
#define FORT_CGPRECND cgprecnd3dsim
#define FORT_ADOTX adotx3dsim
#define FORT_FLUX flux3dsim
#elif defined(BL_FORT_USE_UNDERSCORE)
#define FORT_GSRB gsrb3dsim_
#define FORT_CGPRECND cgprecnd3dsim_
#define FORT_ADOTX adotx3dsim_
#define FORT_FLUX flux3dsim_
#endif
#endif
#include
extern "C"
{
#if (BL_SPACEDIM == 2)
void FORT_GSRB (
Real* phi , ARLIM_P(phi_lo), ARLIM_P(phi_hi),
const Real* rhs , ARLIM_P(rhs_lo), ARLIM_P(rhs_hi),
const Real* den0, ARLIM_P(den0_lo), ARLIM_P(den0_hi),
const int* m0 , ARLIM_P(m0_lo), ARLIM_P(m0_hi),
const Real* den1, ARLIM_P(den1_lo), ARLIM_P(den1_hi),
const int* m1 , ARLIM_P(m1_lo), ARLIM_P(m1_hi),
const Real* den2, ARLIM_P(den2_lo), ARLIM_P(den2_hi),
const int* m2 , ARLIM_P(m2_lo), ARLIM_P(m2_hi),
const Real* den3, ARLIM_P(den3_lo), ARLIM_P(den3_hi),
const int* m3 , ARLIM_P(m3_lo), ARLIM_P(m3_hi),
const int* lo, const int* hi, const int *nc,
const Real *h, const int* redblack
);
void FORT_FLUX(
const Real *x, ARLIM_P(x_lo), ARLIM_P(x_hi),
const int *lo, const int *hi, const int *nc,
const Real *h,
Real* xflux, ARLIM_P(xflux_lo), ARLIM_P(xflux_hi),
Real* yflux, ARLIM_P(yflux_lo), ARLIM_P(yflux_hi)
);
#endif
#if (BL_SPACEDIM == 3)
void FORT_GSRB (
Real* phi , ARLIM_P(phi_lo), ARLIM_P(phi_hi),
const Real* rhs , ARLIM_P(rhs_lo), ARLIM_P(rhs_hi),
const Real* den0, ARLIM_P(den0_lo), ARLIM_P(den0_hi),
const int* m0 , ARLIM_P(m0_lo), ARLIM_P(m0_hi),
const Real* den1, ARLIM_P(den1_lo), ARLIM_P(den1_hi),
const int* m1 , ARLIM_P(m1_lo), ARLIM_P(m1_hi),
const Real* den2, ARLIM_P(den2_lo), ARLIM_P(den2_hi),
const int* m2 , ARLIM_P(m2_lo), ARLIM_P(m2_hi),
const Real* den3, ARLIM_P(den3_lo), ARLIM_P(den3_hi),
const int* m3 , ARLIM_P(m3_lo), ARLIM_P(m3_hi),
const Real* den4, ARLIM_P(den4), ARLIM_P(den4_hi),
const int* m4 , ARLIM_P(m4), ARLIM_P(m4_hi),
const Real* den5, ARLIM_P(den5), ARLIM_P(den5_hi),
const int* m5 , ARLIM_P(m5), ARLIM_P(m5_hi),
const int* lo, const int* hi, const int *nc,
const Real *h, const int* redblack
);
void FORT_FLUX(
const Real *x, ARLIM_P(x_lo), ARLIM_P(x_hi),
const int *lo, const int *hi, const int *nc,
const Real *h,
Real* xflux, ARLIM_P(xflux_lo), ARLIM_P(xflux_hi),
Real* yflux, ARLIM_P(yflux_lo), ARLIM_P(yflux_hi),
Real* zflux, ARLIM_P(zflux_lo), ARLIM_P(zflux_hi)
);
#endif
void FORT_CGPRECND(
Real *tmpz, ARLIM_P(tmpz_lo), ARLIM_P(tmzr_hi),
Real *rho,
const Real *tmpr, ARLIM_P(tmpr_lo), ARLIM_P(tmpr_hi),
const int *lo, const int *hi, const int *nc,
const Real *h
);
void FORT_ADOTX(
Real *y, ARLIM_P(y_lo), ARLIM_P(y_hi),
const Real *x, ARLIM_P(x_lo), ARLIM_P(x_hi),
const int *lo, const int *hi, const int *nc,
const Real *h
);
void FORT_ESTANORM(
Real* H,
const int *lo, const int *hi, const int *nc,
const Real *h
);
}
#endif
#endif /*_LP_F_H_*/
ccseapps-2.5/CCSEApps/mglib/LO_UTIL.F 0000644 0001750 0001750 00000007616 11634153073 020241 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
c
c $Id: LO_UTIL.F,v 1.3 2002/10/19 18:33:57 car Exp $
c
#undef BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif
#undef TESTING_POLYNOMINTERPCOEFFS
#ifdef TESTING_POLYNOMINTERPCOEFFS
#define NORDER 3
#define REAL_T real*8
#define zero 0.d0
#define one 1.d0
#else
#include
#include
#endif
c polyInterpCoeff:
c
c This routine returns the Lagrange interpolating coefficients for a
c polynomial through N points, evaluated at xInt (see Numerical Recipes,
c v2, p102, e.g.):
c
c (x-x2)(x-x3)...(x-xN) (x-x1)(x-x2)...(x-x(N-1))
c P(x) = ----------------------- y1 + ... + ------------------------ yN
c (x1-x2)(x1-x3)...(x1-xN) (x1-x2)(x1-x3)...(x1-xN)
c
c P(xInt) = sum_(i=1)^(N) y[i]*c[i]
c
subroutine polyInterpCoeff(xInt, x, N, c)
implicit none
integer N, i, j
REAL_T xInt, x(N), c(N), num, den
do j=1,N
num = one
den = one
do i = 1,j-1
num = num*(xInt - x(i))
den = den*(x(j) - x(i))
end do
do i = j+1,N
num = num*(xInt - x(i))
den = den*(x(j) - x(i))
end do
#ifndef NDEBUG
if (den .eq. zero) STOP 'polyInterpCoeff::invalid data'
#endif
c(j) = num/den
end do
return
end
#ifdef TESTING_POLYNOMINTERPCOEFFS
c
c This is a test driver for the routine polyInterpCoeff. Sample data
c is created from the statement function, and the location of the
c boundary node and internal nodes are set, as apporpriate. The
c number of points created is equal to the test NORDER set at the
c top of this file through a define. The coefficients are computed,
c and then the ghost cell value is constructed from the resulting
c coefficients and written out.
c
program polyInterpCoeffTest
integer i, j
REAL_T c(NORDER), y(NORDER), yInt
REAL_T x(NORDER), const, yfunc, xx, xInt
c
c Make data, locations
yfunc(xx) = (2*xx-one)**(NORDER-1) + const
const = -one
x(1) = zero
y(1) = yfunc(x(1))
do j=2,NORDER
x(j) = j - 1.5D0*one
y(j) = yfunc(x(j))
end do
c
c Set interpolation point to ghost cell location
xInt = (x(2) - x(3))*0.5D0
c
c Call routine
call polyInterpCoeff(xInt,x,NORDER,c)
c
c Evaluate result
yInt = zero
do j=1,NORDER
yInt = yInt + c(j)*y(j)
end do
c
c Dump output
write(6,*) 'x = ',x
write(6,*) 'y = ',y
write(6,*) 'c = ',c
write(6,*) 'Interpolated y = ',yInt
end
#endif
ccseapps-2.5/CCSEApps/mglib/BndryData.H 0000644 0001750 0001750 00000021622 11634153073 020735 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _BNDRYDATA_H_
#define _BNDRYDATA_H_
//
// $Id: BndryData.H,v 1.12 2001/08/01 21:51:03 lijewski Exp $
//
#include
#include
#include
#include
#include
#include
#include
#include
//@Man:
/*@Memo:
A BndryData stores and manipulates boundary data
information on each side of each box in a BoxArray.
*/
/*@Doc:
A BndryData contains a BndryRegister about each side of each grid in
a Boxarray. These data are used to store information along the
outer layer of each grid (at the same level of coarseness), such
as the value of boundary conditions there. Also, for each
boundary, this class maintains a BoundCond identifier and a
location. This "location" often specifies where, in physical
space, a value, which is stored in the boundary registers, will
be applied by a solver (although interpretation of this information
is application-specific).
In addition to boundary condition values, types and locations, and
BndryDate object maintains a mask for each boundary value. Given
a Geometry describing the physical "domain" of application, a BndryData
object fills the mask arrays with a mask value to indicate if the
node is outside the domain (outside_domain), or, if not, whether it
lays within the valid region of an adjacent grid (covered), or not
(not_covered). This mask data is created upon non-default class
instantiation.
*/
class BndryData
:
private BndryRegister
{
public:
//
//@ManDoc: return the array of Boxes
//
BndryRegister::boxes;
//
//@ManDoc: return the number of Boxes
//
BndryRegister::size;
//
//@ManDoc: mask values enumeration
//
enum MaskVal { covered = 0, not_covered = 1, outside_domain = 2, NumMaskVals = 3 };
//
//@ManDoc: default constructor
//
BndryData() : BndryRegister () {}
/*@ManDoc: constructor specifying number of components and box of physical
domain (cell-centered)
*/
BndryData (const BoxArray& grids,
int ncomp,
const Geometry& geom);
//
//@ManDoc: destructor
//
virtual ~BndryData ();
//
//@ManDoc: copy constructor
//
BndryData (const BndryData& src);
//
//@ManDoc: copy assignment operator
//
BndryData& operator= (const BndryData& src);
//
//@ManDoc: alocate bndry fabs along given face
//
void define (const BoxArray& grids,
int ncomp,
const Geometry& geom);
//
//@ManDoc: write to output stream
//
friend std::ostream& operator<< (std::ostream& os, const BndryData& bd);
//
//@ManDoc: return FabSet on given face
//
const FabSet& bndryValues (const Orientation& face) const;
//
//@ManDoc: return boundary location on given face
//
const Array& bndryLocs (const Orientation& face) const;
//
//@ManDoc: return boundary type specifyer on given face
//
const Array >& bndryConds (const Orientation& face) const;
//
//@ManDoc: return boundary mask on given face
//
const PArray& bndryMasks (const Orientation& face) const;
//
//@ManDoc: return number of components for which this object is inteded
//
int nComp () const;
//
//@ManDoc: return domain used to define masks
//
const Box& getDomain () const;
//
//@ManDoc: return geometry used to define masks
//
const Geometry& getGeom () const;
//
//@ManDoc: set values of boundary Fab for given orientation on nth grid
//
void setValue (const Orientation& face,
int n,
Real val);
//
//@ManDoc: set mask values for given orientation on nth grid
//
void setMaskValue (const Orientation& face,
int n,
int val);
//
//@ManDoc: set boundary type specifier for given orientation on nth grid
//
void setBoundCond (const Orientation& face,
int n,
int comp,
const BoundCond& bcn);
//
//@ManDoc: set boundary location for given orientation on nth grid
//
void setBoundLoc (const Orientation& face,
int n,
Real val);
//
//@ManDoc: implement public access to const BndryRegister::operator[]
//
const FabSet& operator[] (const Orientation& face) const;
//
//@ManDoc: implement public access to BndryRegister::operator[]
//
FabSet& operator[] (const Orientation& face);
//
//@ManDoc: write the boundary data object to an ostream
//
void writeOn (std::ostream& os) const;
//
//@ManDoc: read the boundary data object from an istream
//
void readFrom (std::istream& is);
protected:
//
// Helper function for copy constructor and assigment operator.
//
void init (const BndryData& src);
//
//@ManDoc: protect BndryRegister grids.
//
BndryRegister::grids;
//
//@ManDoc: protect BndryRegister FabSets.
//
BndryRegister::bndry;
//
// The data.
//
// Array (on orientation)(on grid)(on component) of boundary
// condition type specifiers.
//
Array< Array > bcond[2*BL_SPACEDIM];
//
// Array (on orientation) of boundary condition locations.
//
Array bcloc[2*BL_SPACEDIM];
//
// Array (on orientation) of boundary condition mask arrays (FAB-like)
//
PArray masks[2*BL_SPACEDIM];
//
// Domain used for mask defintions.
//
Geometry geom;
private:
//
// Free memory taken by masks for this BndryData object.
//
void clear_masks ();
static int NTangHalfWidth;
};
inline
const FabSet&
BndryData::bndryValues (const Orientation& _face) const
{
return bndry[_face];
}
inline
const Array&
BndryData::bndryLocs (const Orientation& _face) const
{
return bcloc[_face];
}
inline
const Array >&
BndryData::bndryConds (const Orientation& _face) const
{
return bcond[_face];
}
inline
const PArray&
BndryData::bndryMasks (const Orientation& _face) const
{
return masks[_face];
}
inline
int
BndryData::nComp () const
{
return bcond[0][0].size();
}
inline
const Box&
BndryData::getDomain () const
{
return geom.Domain();
}
inline
const Geometry&
BndryData::getGeom () const
{
return geom;
}
inline
void
BndryData::setValue (const Orientation& _face,
int _n,
Real _val)
{
bndry[_face][_n].setVal(_val);
}
inline
void
BndryData::setMaskValue (const Orientation& _face,
int _n,
int _val)
{
masks[_face][_n].setVal(_val);
}
inline
void
BndryData::setBoundCond (const Orientation& _face,
int _n,
int _comp,
const BoundCond& _bcn)
{
bcond[_face][_n][_comp] = _bcn;
}
inline
void
BndryData::setBoundLoc (const Orientation& _face,
int _n,
Real _val)
{
bcloc[_face][_n] = _val;
}
inline
const FabSet&
BndryData::operator[] (const Orientation& _face) const
{
return BndryRegister::bndry[_face];
}
inline
FabSet&
BndryData::operator[] (const Orientation& _face)
{
return BndryRegister::bndry[_face];
}
#endif /*_BNDRYDATA_H_*/
ccseapps-2.5/CCSEApps/mglib/CGSolver.H 0000644 0001750 0001750 00000024335 11634153073 020555 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _CGSOLVER_H_
#define _CGSOLVER_H_
//
// $Id: CGSolver.H,v 1.10 2001/08/01 21:51:03 lijewski Exp $
//
#include
#include
#include
#include
#include
class MultiGrid;
//@Man:
/*@Memo:
A CGSolver solves the linear equation, L(phi)=rhs, for a LinOp L and
MultiFabs rhs and phi, using the conjugate gradient algorithm, either
vanilla, or preconditioned via a single V-cycle of multigrid.
*/
/*@Doc:
A CGSolver object solves the linear equation, L(phi)=rhs for a LinOp
L, and MultiFabs phi and rhs. A CGSolver is constructed with a
fully initialized 2D or 3D LinOp, and responds to "solve" requests of
various signatures. The solve request (implicitly) includes a flag
as to whether the system is to be solved with homogeneous boundary
conditions or no. If homogeneous BCs are requested, all boundary
information within the LinOp is used, except that the values of
boundary FabSets are zeroed. The algorithm follows closely that
described of p15 of the SIAM book, "Templates for the Solution of
Linear Systems". Before solving a system, a small number of control
parameters may be modified (maximum number of allowed iterations,
reporting verbosity, etc). Also, either on construction or via
member access functions, the user may choose to use a V-cycle
1-step MultiGrid preconditioner within the CG loop by setting
the appropriate bool flag (see members/ctrs below). The MG
preconditioner used is just an instantiation of a MultiGrid class
object (the MultiGrid class is documented separately).
Implementation Notes:
\begin{itemize}
\item This algorithm implements solution of equations in a way that
requires linearity of the operator. In "residual correction form",
equations are solved only for the "correction" to the initial guess
that is required to solve the desired system. In particular,
boundary conditions are assumed to be satisfied after a single
application of the linear operator (therefore, the correction is
homogeneous at the boundary). As a result, after putting the
problem in residual correction form, the entire system CG system
has homigeneous boundary conditions. This solver therefore cannot
incorporate fully nonlinear systems.
\item In general, a LinOp has the ability to apply high-order
interpolation methods for computing boundary values. However, if
the operator used in this CGSolver is non-symmetric, cg performance
suffers tremendously. As a result, BC's should be applied with
interpolants of order less than or equal to 2. We do not enforce
this condition rigourosly, since it would interfere with the user's
definition of the operator. If cg performance is bad however,
setting the LinOp's maxorder=2 is a good place to start.
\item CGSolver can fail to converge, or more likely diverge, if you
run into a solvability problem (likely the accuracy cannot be
achieved). CGSolver can be put into a different mode by using
setExpert, where instead of bombing out, solve() returns an error
code. 0 means good, 1 means loss-of-accuracy, 2 means iteration
count exceeded.
\end{itemize}
Default settings:
The user has access to the following options in the cg algorithm:
\begin{itemize}
\item maxiter(40) Maximum number of cg cycles allowed to solve the
system before abandoning
\item verbose(0) Verbosity (1-results, 2-progress, 3-detailed progress)
\item use\_mg\_precond(false) Whether to use the V-cycle multigrid
solver for the preconditioner system
\item unstable\_criterion(10) if norm of residual grows by more than
this factor, it is taken as signal that you've run into a solvability
problem.
\end{itemize}
This class does NOT provide a copy constructor or assignment operator.
*/
class CGSolver
{
public:
enum Solver { CG, BiCGStab, CG_Alt, Automatic};
//
//@ManDoc: constructor
//
CGSolver (LinOp& _Lp,
bool _use_mg_precond = false,
int _lev = 0);
//
//@ManDoc: destructor
//
virtual ~CGSolver ();
//
//@ManDoc: solve the system, Lp(solnL)=rhsL to relative err, tolerance
// RETURNS AN INT!!!! indicating success or failure.
// 0 means success
// 1 means failed for loss of precision
// 2 means iterations exceeded
//
int solve (MultiFab& solnL,
const MultiFab& rhsL,
Real eps_rel = -1.0,
Real eps_abs = -1.0,
LinOp::BC_Mode bc_mode = LinOp::Inhomogeneous_BC,
Solver cg_solver_ = Automatic);
//
//@ManDoc: set maximum allowed number of CG iterations
//
void setMaxIter (int _maxiter);
//
//@ManDoc: get maximum allowed number of CG iterations
//
int getMaxIter () const;
//
//@ManDoc: set expert mode
void setExpert( bool flag ) { isExpert = flag; }
//
//@ManDoc: get expert flag
bool getExpert() { return isExpert; }
//
//@ManDoc: set flag determining whether MG preconditioning is used
//
void setUseMGPrecond (bool _use_mg_precond);
//
//@ManDoc: get flag determining whether MG preconditioning is used
//
bool getUseMGPrecond () const;
//
//@ManDoc: set the verbosity value
//
void setVerbose (int _verbose);
//
//@ManDoc: return the verbosity value
//
int getVerbose ();
void setCGSolver(Solver cg_solver_);
Solver getCGSolver() const;
protected:
int solve_00 (MultiFab& solnL,
const MultiFab& rhsL,
Real eps_rel = -1.0,
Real eps_abs = -1.0,
LinOp::BC_Mode bc_mode = LinOp::Inhomogeneous_BC);
int solve_cg (MultiFab& solnL,
const MultiFab& rhsL,
Real eps_rel = -1.0,
Real eps_abs = -1.0,
LinOp::BC_Mode bc_mode = LinOp::Inhomogeneous_BC);
int solve_bicgstab (MultiFab& solnL,
const MultiFab& rhsL,
Real eps_rel = -1.0,
Real eps_abs = -1.0,
LinOp::BC_Mode bc_mode = LinOp::Inhomogeneous_BC);
//
//@ManDoc: construct work space, initialize parameters
//
static void initialize ();
//
//@ManDoc: if (use\_mg\_precond == 1) then define the MultiGrid * mg\_precond
//
virtual void set_mg_precond ();
//
//@ManDoc: compute p = z + beta p in the CG algorithm
//
void advance (MultiFab& p,
Real beta,
const MultiFab& z);
//
//@ManDoc: compute x =+ alpha p and r -= alpha w in the CG algorithm
//
void update (MultiFab& sol,
Real alpha,
MultiFab& r,
const MultiFab& p,
const MultiFab& w);
//
//@ManDoc: compute w = A.p, and return Transpose(p).w in the CG algorithm
//
Real axp (MultiFab& w,
MultiFab& p,
LinOp::BC_Mode bc_mode);
//
//@ManDoc: Initialized yet?
//
static int initialized;
//
//@ManDoc: Default maximum number of allowed iterations.
//
static int def_maxiter;
//
//@ManDoc: default unstable_criterion used to test for loss of accuracy in
//
static double def_unstable_criterion;
//
//@ManDoc: flag determining action when error conditions are hit
//
bool isExpert;
//
//@ManDoc: Default verbosity flag.
//
static int def_verbose;
static Solver def_cg_solver;
Solver cg_solver;
//
// The data.
//
LinOp& Lp; // Operator for linear system to be solved.
MultiGrid* mg_precond; // MultiGrid solver to be used as preconditioner
int maxiter; // Current maximum number of allowed iterations.
int verbose; // Current verbosity level.
int lev; // Level of the linear operator to use
bool use_mg_precond; // Use multigrid as a preconditioner.
private:
//
// Disable copy constructor and assignment operator.
//
CGSolver (const CGSolver&);
CGSolver& operator= (const CGSolver&);
};
inline
void
CGSolver::setMaxIter (int _maxiter)
{
maxiter = _maxiter;
}
inline
int
CGSolver::getMaxIter () const
{
return maxiter;
}
inline
void
CGSolver::setUseMGPrecond (bool _use_mg_precond)
{
use_mg_precond = _use_mg_precond;
set_mg_precond();
}
inline
bool
CGSolver::getUseMGPrecond () const
{
return use_mg_precond;
}
inline
void
CGSolver::setVerbose (int _verbose)
{
verbose = _verbose;
}
inline
int
CGSolver::getVerbose ()
{
return verbose;
}
inline
void
CGSolver::setCGSolver(Solver cg_solver_)
{
cg_solver = cg_solver_;
}
inline
CGSolver::Solver
CGSolver::getCGSolver() const
{
return cg_solver;
}
#endif /*_CGSOLVER_H_*/
ccseapps-2.5/CCSEApps/mglib/CG_F.H 0000644 0001750 0001750 00000010227 11634153073 017622 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _CG_F_H_
#define _CG_F_H_
/*
** $Id: CG_F.H,v 1.4 2002/04/26 22:10:02 lijewski Exp $
*/
#include
#if defined(BL_LANG_FORT)
#if (BL_SPACEDIM == 2)
#define FORT_CGUPDATE cgupdate2dgen
#define FORT_CGADVCP cgadvcp2dgen
#define FORT_CGXDOTY cgxdoty2dgen
#define FORT_CGSXAY cgsxay2dgen
#endif
#if (BL_SPACEDIM == 3)
#define FORT_CGUPDATE cgupdate3dgen
#define FORT_CGADVCP cgadvcp3dgen
#define FORT_CGXDOTY cgxdoty3dgen
#define FORT_CGSXAY cgsxay3dgen
#endif
#else
#if defined(BL_FORT_USE_UPPERCASE)
# if (BL_SPACEDIM == 2)
# define FORT_CGUPDATE CGUPDATE2DGEN
# define FORT_CGADVCP CGADVCP2DGEN
# define FORT_CGXDOTY CGXDOTY2DGEN
# define FORT_CGSXAY CGSXAY2DGEN
# endif
# if (BL_SPACEDIM == 3)
# define FORT_CGUPDATE CGUPDATE3DGEN
# define FORT_CGADVCP CGADVCP3DGEN
# define FORT_CGXDOTY CGXDOTY3DGEN
# define FORT_CGSXAY CGSXAY3DGEN
# endif
#elif defined(BL_FORT_USE_LOWERCASE)
# if (BL_SPACEDIM == 2)
# define FORT_CGUPDATE cgupdate2dgen
# define FORT_CGADVCP cgadvcp2dgen
# define FORT_CGXDOTY cgxdoty2dgen
# define FORT_CGSXAY cgsxay2dgen
# endif
# if (BL_SPACEDIM == 3)
# define FORT_CGUPDATE cgupdate3dgen
# define FORT_CGADVCP cgadvcp3dgen
# define FORT_CGXDOTY cgxdoty3dgen
# define FORT_CGSXAY cgsxay3dgen
# endif
#elif defined(BL_FORT_USE_UNDERSCORE)
# if (BL_SPACEDIM == 2)
# define FORT_CGUPDATE cgupdate2dgen_
# define FORT_CGADVCP cgadvcp2dgen_
# define FORT_CGXDOTY cgxdoty2dgen_
# define FORT_CGSXAY cgsxay2dgen_
# endif
# if (BL_SPACEDIM == 3)
# define FORT_CGUPDATE cgupdate3dgen_
# define FORT_CGADVCP cgadvcp3dgen_
# define FORT_CGXDOTY cgxdoty3dgen_
# define FORT_CGSXAY cgsxay3dgen_
# endif
#endif
#include
extern "C"
{
void FORT_CGUPDATE (
Real* phi, ARLIM_P(phi_lo), ARLIM_P(phi_hi),
Real* tmpr, ARLIM_P(tmpr_lo), ARLIM_P(tmpr_hi),
const Real *h,
const Real* tmpw, ARLIM_P(tmpw_lo), ARLIM_P(tmpw_hi),
const Real* tmpp, ARLIM_P(tmpp_lo), ARLIM_P(tmpp_hi),
const int* lo, const int* hi,
const int* nc
);
void FORT_CGADVCP (
Real* tmpp, ARLIM_P(tmpp_lo), ARLIM_P(tmpp_hi),
const Real* tmpr, ARLIM_P(tmpr_lo), ARLIM_P(tmpr_hi),
const Real *b,
const int* lo, const int* hi,
const int* nc
);
void FORT_CGXDOTY (
Real *pw,
const Real* phi, ARLIM_P(phi_lo), ARLIM_P(phi_hi),
const Real* tmpw, ARLIM_P(tmpw_lo), ARLIM_P(tmpw_hi),
const int* lo, const int* hi,
const int* nc
);
void FORT_CGSXAY (
Real* s, ARLIM_P(s_lo), ARLIM_P(s_hi),
const Real* x, ARLIM_P(x_lo), ARLIM_P(x_hi),
const Real* a,
const Real* y, ARLIM_P(y_lo), ARLIM_P(y_hi),
const int* lo, const int* hi,
const int* nc
);
}
#endif
#endif /*_CG_F_H_*/
ccseapps-2.5/CCSEApps/mglib/lo_bctypes.fi 0000644 0001750 0001750 00000000621 11634153073 021433 0 ustar amckinstry amckinstry c-----------------------------------------------------------------------
c Should reflect the same contents as LO_BCTYPES.H
c $Id: lo_bctypes.fi,v 1.1 2002/11/08 18:34:42 car Exp $
c
integer LO_DIRICHLET
integer LO_NEUMANN
integer LO_REFLECT_ODD
parameter (
& LO_DIRICHLET = 101,
& LO_NEUMANN = 102,
& LO_REFLECT_ODD = 103
& )
ccseapps-2.5/CCSEApps/mglib/LinOp.cpp 0000644 0001750 0001750 00000053476 11634153073 020515 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: LinOp.cpp,v 1.30 2002/11/26 22:47:22 lijewski Exp $
//
#include
#include
#include
#include
#include
#include
#include
#include
#include
bool LinOp::initialized = false;
int LinOp::def_harmavg = 0;
int LinOp::def_verbose = 0;
int LinOp::def_maxorder = 2;
#ifndef NDEBUG
//
// LinOp::applyBC fills LinOp_grow ghost cells with data expected in
// LinOp::apply therefore, the incoming MultiFab to LinOp::applyBC better
// have this many ghost allocated.
//
const int LinOp_grow = 1;
#endif
void
LinOp::initialize ()
{
ParmParse pp("Lp");
pp.query("harmavg", def_harmavg);
pp.query("v", def_verbose);
pp.query("maxorder", def_maxorder);
if (ParallelDescriptor::IOProcessor() && def_verbose)
{
std::cout << "def_harmavg = " << def_harmavg << '\n';
std::cout << "def_maxorder = " << def_maxorder << '\n';
}
initialized = true;
}
LinOp::LinOp (const BndryData& _bgb,
const Real _h)
:
bgb(_bgb)
{
Real __h[BL_SPACEDIM];
for (int i = 0; i < BL_SPACEDIM; i++)
{
__h[i] = _h;
}
initConstruct(__h);
}
LinOp::LinOp (const BndryData& _bgb,
const Real* _h)
:
bgb(_bgb)
{
initConstruct(_h);
}
LinOp::~LinOp ()
{
for (int i = 0; i < maskvals.size(); ++i)
{
for (int j = 0; j < maskvals[i].size(); ++j)
{
for (int k = 0; k < maskvals[i][j].size(); ++k)
{
delete maskvals[i][j][k];
}
}
}
}
LinOp::LinOp (const LinOp& _lp,
int level)
:
bgb(_lp.bgb)
{
harmavg = _lp.harmavg;
verbose = _lp.verbose;
gbox.resize(1);
gbox[0] = _lp.boxArray(level);
geomarray.resize(1);
geomarray[0] = bgb.getGeom();
h.resize(1);
BL_ASSERT(_lp.numLevels() > level);
h[0] = _lp.h[level];
undrrelxr.resize(1);
undrrelxr[0] = _lp.undrrelxr[level];
}
void
LinOp::initConstruct (const Real* _h)
{
if (!initialized)
initialize();
harmavg = def_harmavg;
verbose = def_verbose;
gbox.resize(1);
const int level = 0;
gbox[level] = bgb.boxes();
geomarray.resize(1);
geomarray[level] = bgb.getGeom();
h.resize(1);
maxorder = def_maxorder;
for (int i = 0; i < BL_SPACEDIM; i++)
{
h[level][i] = _h[i];
}
undrrelxr.resize(1);
undrrelxr[level] = new BndryRegister(gbox[level], 1, 0, 0, 1);
maskvals.resize(1);
maskvals[level].resize(gbox[level].size());
//
// For each orientation, build NULL masks, then use distributed allocation.
//
for (int i = 0; i < gbox[level].size(); i++)
{
maskvals[level][i].resize(2*BL_SPACEDIM, 0);
}
for (OrientationIter oitr; oitr; ++oitr)
{
Orientation face = oitr();
const FabSet& bndry = bgb[face];
for (int i = 0; i < gbox[level].size(); i++)
{
if (bndry.DistributionMap()[i] == ParallelDescriptor::MyProc())
{
const PArray& pam = bgb.bndryMasks(face);
BL_ASSERT(maskvals[level][i][face] == 0);
maskvals[level][i][face] = new Mask(pam[i].box(), 1);
maskvals[level][i][face]->copy(pam[i]);
}
}
}
}
void
LinOp::apply (MultiFab& out,
MultiFab& in,
int level,
LinOp::BC_Mode bc_mode)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "apply()");
applyBC(in,0,1,level,bc_mode);
Fapply(out,in,level);
}
#ifdef BL_THREADS
class task_applybc_orientation
:
public WorkQueue::task
{
public:
task_applybc_orientation(const OrientationIter& oitr_,
int level_,
int flagden_, int flagbc_, int maxorder_,
MultiFab& inout_, int src_comp_, int num_comp_,
int cdr_,
const Array< Array >& b_, const Array& r_,
const FabSet& fs_,
const Array< Array< Array< Mask*> > >& maskvals_,
FabSet& f_,
int nc_,
const Real* h_);
virtual void run();
private:
const OrientationIter oitr;
const int level;
const int flagden;
const int flagbc;
const int maxorder;
MultiFab& inout;
const int src_comp;
const int num_comp;
const int cdr;
const Array< Array >& b;
const Array< Real>& r;
const FabSet& fs;
const Array< Array< Array< Mask*> > >& maskvals;
FabSet& f;
int nc;
const Real* h;
};
task_applybc_orientation::task_applybc_orientation(const OrientationIter& oitr_, int level_,
int flagden_, int flagbc_, int maxorder_,
MultiFab& inout_, int src_comp_, int num_comp_,
int cdr_,
const Array< Array >& b_, const Array& r_,
const FabSet& fs_,
const Array< Array< Array< Mask*> > >& maskvals_,
FabSet& f_,
int nc_,
const Real* h_)
: oitr(oitr_), level(level_), flagden(flagden_), flagbc(flagbc_), maxorder(maxorder_),
inout(inout_), src_comp(src_comp_), num_comp(num_comp_), cdr(cdr_), b(b_), r(r_), fs(fs_), maskvals(maskvals_), f(f_), nc(nc_), h(h_)
{}
void
task_applybc_orientation::run()
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::run()");
const int comp = 0;
for (MFIter inoutmfi(inout); inoutmfi.isValid(); ++inoutmfi)
{
const int gn = inoutmfi.index();
const Mask& m = *maskvals[level][gn][oitr()];
Real bcl = r[gn];
int bct = b[gn][comp];
FORT_APPLYBC(&flagden, &flagbc, &maxorder,
inout[inoutmfi].dataPtr(src_comp),
ARLIM(inout[inoutmfi].loVect()), ARLIM(inout[inoutmfi].hiVect()),
&cdr, &bct, &bcl,
fs[inoutmfi].dataPtr(),
ARLIM(fs[inoutmfi].loVect()), ARLIM(fs[inoutmfi].hiVect()),
m.dataPtr(),
ARLIM(m.loVect()), ARLIM(m.hiVect()),
f[inoutmfi].dataPtr(),
ARLIM(f[inoutmfi].loVect()), ARLIM(f[inoutmfi].hiVect()),
inoutmfi.validbox().loVect(),
inoutmfi.validbox().hiVect(), &nc, h);
}
}
class task_applybc
:
public WorkQueue::task
{
public:
task_applybc(int flagden_, int flagbc_, int maxorder_,
FArrayBox& inout_, int srccomp_,
int cdr_, int bct_, Real bcl_,
const FArrayBox& fs_,
const Mask& m_,
FArrayBox& f_,
const Box& vbox_,
int nc_,
const Real* h_);
virtual void run();
private:
const int flagden;
const int flagbc;
const int maxorder;
FArrayBox& inout;
int src_comp;
const int cdr;
const int bcl;
Real bct;
const FArrayBox& fs;
const Mask& m;
FArrayBox& f;
const Box vbox;
int nc;
const Real* h;
};
task_applybc::task_applybc(int flagden_, int flagbc_, int maxorder_,
FArrayBox& inout_, int srccomp_,
int cdr_, int bcl_, Real bct_,
const FArrayBox& fs_,
const Mask& m_,
FArrayBox& f_,
const Box& vbox_,
int nc_,
const Real* h_)
: flagden(flagden_), flagbc(flagbc_), maxorder(maxorder_),
inout(inout_), src_comp(srccomp_), cdr(cdr_), bcl(bcl_), bct(bct_), fs(fs_), m(m_), f(f_), vbox(vbox_), nc(nc_), h(h_)
{}
void
task_applybc::run()
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::run()");
FORT_APPLYBC(&flagden, &flagbc, &maxorder,
inout.dataPtr(src_comp),
ARLIM(inout.loVect()), ARLIM(inout.hiVect()),
&cdr, &bcl, &bct,
fs.dataPtr(), ARLIM(fs.loVect()), ARLIM(fs.hiVect()),
m.dataPtr(), ARLIM(m.loVect()), ARLIM(m.hiVect()),
f.dataPtr(), ARLIM(f.loVect()), ARLIM(f.hiVect()),
vbox.loVect(), vbox.hiVect(),
&nc, h);
}
#endif
void
LinOp::applyBC (MultiFab& inout,
int src_comp,
int num_comp,
int level,
LinOp::BC_Mode bc_mode)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::applyBC()");
//
// The inout MultiFab needs at least LinOp_grow ghost cells for applyBC.
//
BL_ASSERT(inout.nGrow() >= LinOp_grow);
//
// The inout MultiFab must have at least Periodic_BC_grow cells for the
// algorithms taking care of periodic boundary conditions.
//
BL_ASSERT(inout.nGrow() >= LinOp_grow);
//
// No coarsened boundary values, cannot apply inhomog at lev>0.
//
BL_ASSERT(!(level > 0 && bc_mode == Inhomogeneous_BC));
int flagden = 1; // Fill in undrrelxr.
int flagbc = 1; // Fill boundary data.
if (bc_mode == LinOp::Homogeneous_BC)
flagbc = 0; // No data if homog.
//
// Only single-component solves supported (verified) by this class.
//
BL_ASSERT(num_comp == 1);
inout.FillBoundary(src_comp,num_comp);
prepareForLevel(level);
//
// Do periodic fixup.
//
geomarray[level].FillPeriodicBoundary(inout,src_comp,num_comp);
//
// Fill boundary cells.
//
for (OrientationIter oitr; oitr; ++oitr)
{
const Array< Array >& b = bgb.bndryConds(oitr());
const Array& r = bgb.bndryLocs(oitr());
FabSet& f = (*undrrelxr[level])[oitr()];
int cdr = oitr();
const FabSet& fs = bgb.bndryValues(oitr());
#ifdef BL_THREADS
#if 1
BoxLib::theWorkQueue().add(new task_applybc_orientation(oitr, level,
flagden, flagbc, maxorder,
inout, src_comp, num_comp,
cdr, b, r,
fs,
maskvals,
f,
num_comp, h[level]));
#else
for (MFIter inoutmfi(inout); inoutmfi.isValid(); ++inoutmfi)
{
const int gn = inoutmfi.index();
BL_ASSERT(gbox[level][inoutmfi.index()] == inoutmfi.validbox());
const Mask& m = *maskvals[level][gn][oitr()];
Real bcl = r[gn];
int bct = b[gn][comp];
BoxLib::theWorkQueue().add(new task_applybc(flagden, flagbc, maxorder,
inout[gn], src_comp, num_comp,
cdr, bct, bcl,
fs[gn],
m,
f[gn],
inoutmfi.validbox(),
num_comp, h[level]));
}
#endif
#else
const int comp = 0;
for (MFIter inoutmfi(inout); inoutmfi.isValid(); ++inoutmfi)
{
const int gn = inoutmfi.index();
BL_ASSERT(gbox[level][inoutmfi.index()] == inoutmfi.validbox());
const Mask& m = *maskvals[level][gn][oitr()];
Real bcl = r[gn];
int bct = b[gn][comp];
FORT_APPLYBC(&flagden, &flagbc, &maxorder,
inout[inoutmfi].dataPtr(src_comp),
ARLIM(inout[inoutmfi].loVect()), ARLIM(inout[inoutmfi].hiVect()),
&cdr, &bct, &bcl,
fs[inoutmfi].dataPtr(),
ARLIM(fs[inoutmfi].loVect()), ARLIM(fs[inoutmfi].hiVect()),
m.dataPtr(),
ARLIM(m.loVect()), ARLIM(m.hiVect()),
f[inoutmfi].dataPtr(),
ARLIM(f[inoutmfi].loVect()), ARLIM(f[inoutmfi].hiVect()),
inoutmfi.validbox().loVect(),
inoutmfi.validbox().hiVect(), &num_comp, h[level]);
}
#endif
}
BoxLib::theWorkQueue().wait();
}
void
LinOp::residual (MultiFab& residL,
const MultiFab& rhsL,
MultiFab& solnL,
int level,
LinOp::BC_Mode bc_mode)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "residual()");
apply(residL, solnL, level, bc_mode);
for (MFIter solnLmfi(solnL); solnLmfi.isValid(); ++solnLmfi)
{
int nc = residL.nComp();
//
// Only single-component solves supported (verified) by this class.
//
BL_ASSERT(nc == 1);
BL_ASSERT(gbox[level][solnLmfi.index()] == solnLmfi.validbox());
FORT_RESIDL(
residL[solnLmfi].dataPtr(),
ARLIM(residL[solnLmfi].loVect()), ARLIM(residL[solnLmfi].hiVect()),
rhsL[solnLmfi].dataPtr(),
ARLIM(rhsL[solnLmfi].loVect()), ARLIM(rhsL[solnLmfi].hiVect()),
residL[solnLmfi].dataPtr(),
ARLIM(residL[solnLmfi].loVect()), ARLIM(residL[solnLmfi].hiVect()),
solnLmfi.validbox().loVect(), solnLmfi.validbox().hiVect(), &nc);
}
}
void
LinOp::smooth (MultiFab& solnL,
const MultiFab& rhsL,
int level,
LinOp::BC_Mode bc_mode)
{
BL_PROFILE(BL_PROFILE_THIS_NAME() + "::smooth()");
for (int redBlackFlag = 0; redBlackFlag < 2; redBlackFlag++)
{
applyBC(solnL, 0, 1, level, bc_mode);
Fsmooth(solnL, rhsL, level, redBlackFlag);
}
}
Real
LinOp::norm (int nm, int level)
{
BoxLib::Error("Placeholder for pure virtual function");
return 0.0;
}
void
LinOp::prepareForLevel (int level)
{
if (level == 0)
return;
LinOp::prepareForLevel(level-1);
if (h.size() > level)
return;
//
// Assume from here down that this is a new level one coarser than existing
//
BL_ASSERT(h.size() == level);
h.resize(level+1);
for (int i = 0; i < BL_SPACEDIM; ++i)
{
h[level][i] = h[level-1][i]*2.0;
}
geomarray.resize(level+1);
geomarray[level].define(BoxLib::coarsen(geomarray[level-1].Domain(),2));
const Box& curdomain = geomarray[level].Domain();
//
// Add a box to the new coarser level (assign removes old BoxArray).
//
gbox.resize(level+1);
gbox[level] = gbox[level-1];
gbox[level].coarsen(2);
//
// Add the BndryRegister of relax values to the new coarser level.
//
BL_ASSERT(undrrelxr.size() == level);
undrrelxr.resize(level+1);
undrrelxr[level] = new BndryRegister(gbox[level], 1, 0, 0, 1);
//
// Add an Array of Array of maskvals to the new coarser level
// For each orientation, build NULL masks, then use distributed allocation
// Initial masks for coarse levels, ignore outside_domain possibility since
// we always solve homogeneous equation on coarse levels.
//
BL_ASSERT(maskvals.size() == level);
maskvals.resize(level+1);
maskvals[level].resize(gbox[level].size());
for (int i = 0; i < gbox[level].size(); i++)
{
maskvals[level][i].resize(2*BL_SPACEDIM, (Mask*)0);
}
Array pshifts(27);
for (OrientationIter oitr; oitr; ++oitr)
{
Orientation face = oitr();
//
// Use bgb's distribution map for masks.
//
for (FabSetIter bndryfsi(bgb[face]); bndryfsi.isValid(); ++bndryfsi)
{
int gn = bndryfsi.index();
Box bx_k = BoxLib::adjCell(gbox[level][gn], face, 1);
BL_ASSERT(maskvals[level][gn][face] == 0);
maskvals[level][gn][face] = new Mask(bx_k, 1);
Mask& curmask = *(maskvals[level][gn][face]);
curmask.setVal(BndryData::not_covered);
for (int gno = 0; gno < gbox[level].size(); ++gno)
{
Box btmp = gbox[level][gno] & bx_k;
if (gno != gn && btmp.ok())
{
curmask.setVal(BndryData::covered, btmp,0);
}
}
//
// Now take care of periodic wraparounds.
//
Geometry& curgeom = geomarray[level];
if (curgeom.isAnyPeriodic() && !curdomain.contains(bx_k))
{
curgeom.periodicShift(curdomain, bx_k, pshifts);
for (int iiv = 0; iiv < pshifts.size(); iiv++)
{
curmask.shift(pshifts[iiv]);
for (int gno = 0; gno < gbox[level].size(); ++gno)
{
Box btmp = gbox[level][gno] & curmask.box();
curmask.setVal(BndryData::covered, btmp,0);
}
curmask.shift(-pshifts[iiv]);
}
}
}
}
}
void
LinOp::makeCoefficients (MultiFab& cs,
const MultiFab& fn,
int level)
{
int nc = 1;
//
// Determine index type of incoming MultiFab.
//
const IndexType iType(fn.boxArray()[0].ixType());
const IndexType cType(D_DECL(IndexType::CELL, IndexType::CELL, IndexType::CELL));
const IndexType xType(D_DECL(IndexType::NODE, IndexType::CELL, IndexType::CELL));
const IndexType yType(D_DECL(IndexType::CELL, IndexType::NODE, IndexType::CELL));
#if (BL_SPACEDIM == 3)
const IndexType zType(D_DECL(IndexType::CELL, IndexType::CELL, IndexType::NODE));
#endif
int cdir;
if (iType == cType)
{
cdir = -1;
}
else if (iType == xType)
{
cdir = 0;
}
else if (iType == yType)
{
cdir = 1;
#if (BL_SPACEDIM == 3)
}
else if (iType == zType)
{
cdir = 2;
#endif
}
else
{
BoxLib::Error("LinOp::makeCoeffients: Bad index type");
}
BoxArray d(gbox[level]);
if (cdir >= 0)
d.surroundingNodes(cdir);
//
// Only single-component solves supported (verified) by this class.
//
const int nComp=1;
const int nGrow=0;
cs.define(d, nComp, nGrow, Fab_allocate);
const BoxArray& grids = gbox[level];
MFIter csmfi(cs);
switch (cdir)
{
case -1:
for ( ; csmfi.isValid(); ++csmfi)
{
FORT_AVERAGECC(cs[csmfi].dataPtr(), ARLIM(cs[csmfi].loVect()),
ARLIM(cs[csmfi].hiVect()),fn[csmfi].dataPtr(),
ARLIM(fn[csmfi].loVect()),ARLIM(fn[csmfi].hiVect()),
grids[csmfi.index()].loVect(),
grids[csmfi.index()].hiVect(), &nc);
}
break;
case 0:
case 1:
case 2:
if (harmavg)
{
for ( ; csmfi.isValid(); ++csmfi)
{
FORT_HARMONIC_AVERAGEEC(cs[csmfi].dataPtr(),
ARLIM(cs[csmfi].loVect()),
ARLIM(cs[csmfi].hiVect()),
fn[csmfi].dataPtr(),
ARLIM(fn[csmfi].loVect()),
ARLIM(fn[csmfi].hiVect()),
grids[csmfi.index()].loVect(),
grids[csmfi.index()].hiVect(),
&nc,&cdir);
}
}
else
{
for ( ; csmfi.isValid(); ++csmfi)
{
FORT_AVERAGEEC(cs[csmfi].dataPtr(),ARLIM(cs[csmfi].loVect()),
ARLIM(cs[csmfi].hiVect()),fn[csmfi].dataPtr(),
ARLIM(fn[csmfi].loVect()),ARLIM(fn[csmfi].hiVect()),
grids[csmfi.index()].loVect(),
grids[csmfi.index()].hiVect(),&nc, &cdir);
}
}
break;
default:
BoxLib::Error("LinOp:: bad coefficient coarsening direction!");
}
}
std::ostream&
operator<< (std::ostream& os,
const LinOp& lp)
{
if (ParallelDescriptor::IOProcessor())
{
os << "LinOp" << '\n';
os << "Grids: " << '\n';
for (int level = 0; level < lp.h.size(); ++level)
{
os << " level = " << level << ": " << lp.gbox[level] << '\n';
}
os << "Grid Spacing: " << '\n';
for (int level = 0; level < lp.h.size(); ++level)
{
os << " level = " << level << ", dx = ";
for (int d =0; d < BL_SPACEDIM; ++d)
{
os << lp.h[level][d] << " ";
}
os << '\n';
}
os << "Harmonic average? " << (lp.harmavg == 1 ? "yes" : "no") << '\n';
os << "Verbosity: " << lp.verbose << '\n';
os << "Max Order: " << lp.maxorder << '\n';
}
if (ParallelDescriptor::IOProcessor())
{
os << "Masks:" << '\n';
}
for (int level = 0; level < lp.h.size(); ++level)
{
if (ParallelDescriptor::IOProcessor())
os << "level = " << level << '\n';
for (int nproc = 0; nproc < ParallelDescriptor::NProcs(); ++nproc)
{
if (nproc == ParallelDescriptor::MyProc())
{
os << "Processor " << nproc << '\n';
for (OrientationIter oitr; oitr; ++oitr)
{
Orientation face = oitr();
for (int i=0; i
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
//#include
static
Real
mfnorm_0_valid (const MultiFab& mf)
{
Real r = 0;
for ( MFIter cmfi(mf); cmfi.isValid(); ++cmfi )
{
Real s = mf[cmfi].norm(cmfi.validbox(), 0, 0, mf[cmfi].nComp());
r = (r > s) ? r : s;
}
ParallelDescriptor::ReduceRealMax(r);
return r;
}
static
Real
mfnorm_2_valid (const MultiFab& mf)
{
Real r = 0;
for ( MFIter cmfi(mf); cmfi.isValid(); ++cmfi )
{
Real s = mf[cmfi].norm(cmfi.validbox(), 2, 0, mf[cmfi].nComp());
r += s*s;
}
ParallelDescriptor::ReduceRealSum(r);
return ::sqrt(r);
}
BoxList readBoxList (std::string file, Box& domain);
int
main (int argc, char* argv[])
{
BoxLib::Initialize(argc,argv);
std::cout << std::setprecision(15);
ParmParse pp;
std::cout << "maxthreads = " << BoxLib::theWorkQueue().max_threads() << std::endl;
// Obtain prob domain and box-list, set H per phys domain [0:1]Xn
Box container;
#if (BL_SPACEDIM == 2)
std::string boxfile("grids/gr.2_small_a") ; pp.query("boxes", boxfile);
#elif (BL_SPACEDIM == 3)
std::string boxfile("grids/gr.3_small_a") ; pp.query("boxes", boxfile);
#endif
BoxArray bs(readBoxList(boxfile,container));
Geometry geom( container );
Real H[BL_SPACEDIM];
for ( int n=0; nsetVal(1.0);
}
// Initialize boundary data, set boundary condition flags and locations:
// (phys boundaries set to dirichlet on cell walls)
BndryData bd(bs, 1, geom);
int comp = 0;
for ( int n=0; n b;
b[0]=1.0; pp.query("b0", b[0]);
b[1]=1.0; pp.query("b1", b[1]);
#if (BL_SPACEDIM > 2)
b[2]=1.0; pp.query("b2", b[2]);
#endif
MultiFab acoefs;
acoefs.define(bs, Ncomp, Nghost, Fab_allocate);
acoefs.setVal(a);
MultiFab bcoefs[BL_SPACEDIM];
for ( int n=0; n> domain;
int numbox = 0;
boxspec >> numbox;
for ( int i=0; i> tmpbox;
if( ! domain.contains(tmpbox))
{
std::cerr << "readBoxList: bogus box " << tmpbox << '\n';
exit(1);
}
retval.push_back(tmpbox);
}
boxspec.close();
return retval;
}
ccseapps-2.5/CCSEApps/mglib/Test/GNUmakefile 0000644 0001750 0001750 00000004164 11634153073 021747 0 ustar amckinstry amckinstry PRECISION = DOUBLE
PROFILE = FALSE
PROFILE = TRUE
DEBUG = FALSE
DEBUG = TRUE
DIM = 3
DIM = 2
COMP = KCC
COMP = g++
USE_MPI=TRUE
USE_MPI=FALSE
USE_THREADS=FALSE
USE_THREADS=TRUE
STRICTLY=TRUE
USE_ARRAYVIEW = TRUE
USE_ARRAYVIEW = FALSE
PBOXLIB_HOME := ../..
EBASE = main
LBASE =
include $(PBOXLIB_HOME)/mk/Make.defs
# multigrid test sources
CEXE_sources += $(EBASE).cpp
include Make.package
include $(PBOXLIB_HOME)/bndrylib/Make.package
include $(PBOXLIB_HOME)/mglib/Make.package
include $(PBOXLIB_HOME)/BoxLib/Make.package
#include $(PBOXLIB_HOME)/util/Make.package
INCLUDE_LOCATIONS += $(PBOXLIB_HOME)/bndrylib
vpathdir += $(PBOXLIB_HOME)/bndrylib
INCLUDE_LOCATIONS += $(PBOXLIB_HOME)/BoxLib
vpathdir += $(PBOXLIB_HOME)/BoxLib
INCLUDE_LOCATIONS += $(PBOXLIB_HOME)/iamrlib
vpathdir += $(PBOXLIB_HOME)/iamrlib
INCLUDE_LOCATIONS += $(PBOXLIB_HOME)/mglib
vpathdir += $(PBOXLIB_HOME)/mglib
#INCLUDE_LOCATIONS += $(PBOXLIB_HOME)/util
#vpathdir += $(PBOXLIB_HOME)/util
# We need these from amrlib
CEXE_sources += BCRec.cpp
CEXE_headers += BCRec.H BC_Types.H
INCLUDE_LOCATIONS += $(PBOXLIB_HOME)/amrlib
vpathdir += $(PBOXLIB_HOME)/amrlib
# Needed from AmrVis
CEXE_headers += AmrData.H
INCLUDE_LOCATIONS += $(PBOXLIB_HOME)/pAmrvis
vpathdir += $(PBOXLIB_HOME)/pAmrvis
ifeq ($(DEBUG),TRUE)
ifeq ($(USE_ARRAYVIEW),TRUE)
ARRAYVIEWDIR = $(PBOXLIB_HOME)/util
INCLUDE_LOCATIONS += $(ARRAYVIEWDIR)
CEXE_headers += DatasetClient.H ArrayView.H
CEXE_sources += DatasetClient.cpp
DEFINES += -DBL_USE_ARRAYVIEW
#DEFINES += -DBL_ARRAYVIEW_TAGBOX
endif
CEXE_headers += TV_TempWrite.H
endif
ifeq ($(MACHINE),OSF1)
3RD=1
3RD=
ifdef 3RD
# FOR RUNNING 3RD ONLY
LDFLAGS += --link_command_prefix 3rd
#CXXDEBF = +K0 --link_command_prefix 3rd -non_shared
LDFLAGS += -non_shared -v
#LIBRARIES += -ldnet_stub
#FDEBF += -automatic
# FOR RUNNING 3RD ONLY
endif
DEFINES += -DBL3_NANOSLEEP
LIBRARIES+=-lrt
FFLAGS += -automatic
endif
CXXFLAGS +=
CXXOPTF +=
CXXDEBF +=
CFLAGS +=
COPTF +=
CDEBF +=
vpath %.cpp : . $(vpathdir)
vpath %.F : . $(vpathdir)
all: $(executable)
include $(PBOXLIB_HOME)/mk/Make.rules
ccseapps-2.5/CCSEApps/mglib/Test/amrvis.defaults 0000644 0001750 0001750 00000000455 11634153073 022726 0 ustar amckinstry amckinstry palette Palette
initialderived blank
initialscale 3
numberformat %7.5f
numberformat %12.8f
maxpixmapsize 1000000
reservesystemcolors 24
showboxes TRUE
windowheight 550
windowwidth 800
fabordering alpha
ccseapps-2.5/CCSEApps/mglib/Test/Palette 0000644 0001750 0001750 00000001400 11634153073 021204 0 ustar amckinstry amckinstry #'+/37;?CGKOSW[_cgkosw{ƒ‡‹“—›Ÿ£§«¯³·»¿ÃÇËÏÓ×Ûßãçëïó÷ûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúöñíéäàÛ×ÓÎÊÅÁ½¸´¯«§¢ž™•‘Œˆƒ #'+/37;?CGKOSW[_cgkosw{ƒ‡‹“—›Ÿ£§«¯³·»¿ÃÇËÏÓ×Ûßãçëïó÷ûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû÷óïëçãßÛ×ÓÏËÇÿ»·³¯«§£Ÿ›—“‹‡ƒ{wsokgc_[WSOKGC?;73/+'# ƒ‡‹“—›Ÿ£§«¯³·»¿ÃÇËÏÓ×Ûßãçëïó÷ûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû÷óïëçãßÛ×ÓÏËÇÿ»·³¯«§£Ÿ›—“‹‡ƒ{wsokgc_[WSOKGC?;73/+'# ccseapps-2.5/CCSEApps/mglib/Test/macprojTest.cpp 0000644 0001750 0001750 00000020206 11634153073 022667 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: macprojTest.cpp,v 1.2 2001/08/21 22:15:37 car Exp $
//
// In order to use this utility to mimic a mac projection solve from the
// full AMR code, the lines of code below need to be added to the top
// of mac_level_driver in MacOperator.cpp. This will dump the required
// information. The data sent to cout needs to be set in the input and
// grid files for this test utility. The boundary data and multifabs will
// be read directly.
//
//cout << grids << endl;
//cout << "use_cg_solve = " << use_cg_solve << endl;
//cout << "level = " << level << endl;
//cout << "Density = " << Density << endl;
//cout << "dx = " << dx[0] << " " << dx[1] << " " << dx[2] << endl;
//cout << "dt = " << dt << endl;
//cout << "mac_tol = " << mac_tol << endl;
//cout << "mac_abs_tol = " << mac_abs_tol << endl;
//cout << "rhs_scale = " << rhs_scale << endl;
//ofstream macOS;
//macOS.open("mac_bndry_OS",ios::out|ios::binary);
//mac_bndry.writeOn(macOS);
//macOS.close();
//
//
//
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
static
Real
mfnorm_0_valid (const MultiFab& mf)
{
Real r = 0;
for ( ConstMultiFabIterator cmfi(mf); cmfi.isValid(); ++cmfi )
{
Real s = cmfi->norm(cmfi.validbox(), 0, 0, cmfi->nComp());
r = (r > s) ? r : s;
}
ParallelDescriptor::ReduceRealMax(r);
return r;
}
static
Real
mfnorm_2_valid (const MultiFab& mf)
{
Real r = 0;
for ( ConstMultiFabIterator cmfi(mf); cmfi.isValid(); ++cmfi )
{
Real s = cmfi->norm(cmfi.validbox(), 2, 0, cmfi->nComp());
r += s*s;
}
ParallelDescriptor::ReduceRealSum(r);
return ::sqrt(r);
}
BoxList readBoxList(aString file,
Box& domain);
void mac_driver (const MacBndry& mac_bndry,
const BoxArray& grids,
int use_cg_solve,
int Density,
const Real* dx,
Real dt,
Real mac_tol,
Real mac_abs_tol,
Real rhs_scale,
MultiFab* area,
MultiFab& volume,
MultiFab& S,
MultiFab& Rhs,
MultiFab* u_mac,
MultiFab* mac_phi);
int
main (int argc, char* argv[])
{
BoxLib::Initialize(argc, argv);
//
// Instantiate after we're running in Parallel.
//
//
// Obtain prob domain and box-list, set dx
//
Box container;
#if (BL_SPACEDIM == 2)
aString boxfile("grids/gr.2_mac_tst");
#elif (BL_SPACEDIM == 3)
aString boxfile("grids/gr.3_mac_tst");
#endif
ParmParse pp;
pp.query("boxes", boxfile);
BoxArray bs(readBoxList(boxfile, container));
Geometry geom( container );
Real dx[BL_SPACEDIM];
for ( int n=0; n> domain;
int numbox;
boxspec >> numbox;
for ( int i=0; i> tmpbox;
if( ! domain.contains(tmpbox))
{
cerr << "readBoxList: bogus box " << tmpbox << '\n';
exit(1);
}
retval.append(tmpbox);
}
boxspec.close();
return retval;
}
//
// This routine is intended to mimic the mac_level_driver in MacOperator.cpp.
// So, we can read in the appropriate MultiFabs and then pass them to this
// routine
//
void
mac_driver (const MacBndry& mac_bndry,
const BoxArray& grids,
int use_cg_solve,
int Density,
const Real* dx,
Real dt,
Real mac_tol,
Real mac_abs_tol,
Real rhs_scale,
MultiFab* area,
MultiFab& volume,
MultiFab& S,
MultiFab& Rhs,
MultiFab* u_mac,
MultiFab* mac_phi)
{
MacOperator mac_op(mac_bndry,dx);
mac_op.setCoefficients(area,S,Density,dx);
mac_op.defRHS(area,volume,Rhs,u_mac,rhs_scale);
mac_op.maxOrder(2);
if (use_cg_solve && mac_op.maxOrder() != 2)
{
BoxLib::Error("Can't use CGSolver with maxorder > 2");
}
//
// Construct MultiGrid or CGSolver object and solve system.
//
if (use_cg_solve)
{
bool use_mg_precond = true;
CGSolver mac_cg(mac_op,use_mg_precond);
mac_cg.solve(*mac_phi,Rhs,mac_tol,mac_abs_tol);
}
else
{
MultiGrid mac_mg(mac_op);
mac_mg.solve(*mac_phi,Rhs,mac_tol,mac_abs_tol);
}
}
ccseapps-2.5/CCSEApps/mglib/Test/.cvsignore 0000644 0001750 0001750 00000000023 11634153073 021663 0 ustar amckinstry amckinstry ti_files
bl3_prof*
ccseapps-2.5/CCSEApps/mglib/Test/vpramps.dat 0000644 0001750 0001750 00000000136 11634153073 022052 0 ustar amckinstry amckinstry 1
2
5
0 42 140 220 255
0.0 0.0 0.1 0.8 1.0
4
0 4 128 255
0.0 0.6 0.8 1.0
0.10
0.90
ccseapps-2.5/CCSEApps/mglib/Test/grids/ 0000755 0001750 0001750 00000000000 11634153073 021000 5 ustar amckinstry amckinstry ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_stack_a 0000644 0001750 0001750 00000000176 11634153073 023163 0 ustar amckinstry amckinstry boxes = grids/gr.3_stack_a
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 16.0 24.0 16.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_disjoint_e 0000644 0001750 0001750 00000000165 11634153073 023702 0 ustar amckinstry amckinstry boxes = grids/gr.2_disjoint_e
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 16.0 12.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_3x2 0000644 0001750 0001750 00000000225 11634153073 022166 0 ustar amckinstry amckinstry ((0,0)(31,47)(0,0))
6
((0,0)(15,15)(0,0))
((16,0)(31,15)(0,0))
((0,16)(15,31)(0,0))
((16,16)(31,31)(0,0))
((0,32)(15,47)(0,0))
((16,32)(31,47)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_stack_a 0000644 0001750 0001750 00000000162 11634153073 023155 0 ustar amckinstry amckinstry boxes = grids/gr.2_stack_a
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 16.0 48.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_3boxes_b 0000644 0001750 0001750 00000000125 11634153073 023255 0 ustar amckinstry amckinstry ((0,0)(63,63)(0,0))
3
((0,0)(31,63)(0,0))
((32,0)(63,31)(0,0))
((32,32)(63,63)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_small_a 0000644 0001750 0001750 00000000156 11634153073 023163 0 ustar amckinstry amckinstry boxes = grids/gr.2_small_a
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 7.0 7.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_big 0000644 0001750 0001750 00000000156 11634153073 022314 0 ustar amckinstry amckinstry boxes = grids/gr.2_big
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 64.0 64.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_shiftedUp 0000644 0001750 0001750 00000000200 11634153073 023475 0 ustar amckinstry amckinstry boxes = grids/gr.3_shiftedUp
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 16.0 24.0 32.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_2x2_b 0000644 0001750 0001750 00000000077 11634153073 022473 0 ustar amckinstry amckinstry ((0,0)(63,63)(0,0))
2
((0,0)(31,63)(0,0))
((32,0)(63,63)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_disjoint_c 0000644 0001750 0001750 00000000207 11634153073 023700 0 ustar amckinstry amckinstry ((0,0,0)(15,23,23)(0,0,0))
4
((0,0,0)(7,7,7)(0,0,0))
((8,16,0)(15,23,7)(0,0,0))
((0,0,16)(7,7,23)(0,0,0))
((8,16,16)(15,23,23)(0,0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_2x2_c 0000644 0001750 0001750 00000000160 11634153073 022463 0 ustar amckinstry amckinstry boxes = grids/gr.2_2x2_c
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 64.0 64.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_2x2_a 0000644 0001750 0001750 00000000160 11634153073 022461 0 ustar amckinstry amckinstry boxes = grids/gr.2_2x2_a
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 32.0 64.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_shiftedUp 0000644 0001750 0001750 00000000124 11634153073 023504 0 ustar amckinstry amckinstry ((0,0,0)(15,23,31)(0,0,0))
2
((0,8,0)(15,23,15)(0,0,0))
((0,0,16)(15,15,31)(0,0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_small_b 0000644 0001750 0001750 00000000162 11634153073 023161 0 ustar amckinstry amckinstry boxes = grids/gr.2_small_b
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 8.0 16.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2per_2x2_c 0000644 0001750 0001750 00000000230 11634153073 023170 0 ustar amckinstry amckinstry boxes = grids/gr.2_2x2_c
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 32.0 32.0
#-geometry.period_0
#-geometry.period_1
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_big 0000644 0001750 0001750 00000000052 11634153073 022311 0 ustar amckinstry amckinstry ((0,0)(63,63)(0,0))
1
((0,0)(63,63)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_small_a 0000644 0001750 0001750 00000000046 11634153073 023163 0 ustar amckinstry amckinstry ((0,0)(7,7)(0,0))
1
((0,0)(7,7)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_disjoint_b 0000644 0001750 0001750 00000000165 11634153073 023677 0 ustar amckinstry amckinstry boxes = grids/gr.2_disjoint_b
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 32.0 32.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_disjoint_b 0000644 0001750 0001750 00000000115 11634153073 023675 0 ustar amckinstry amckinstry ((0,0,0)(7,7,23)(0,0,0))
2
((0,0,0)(7,7,7)(0,0,0))
((0,0,16)(7,7,23)(0,0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_3boxes_c 0000644 0001750 0001750 00000000163 11634153073 023256 0 ustar amckinstry amckinstry boxes = grids/gr.2_3boxes_c
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 64.0 64.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_stack_a 0000644 0001750 0001750 00000000077 11634153073 023164 0 ustar amckinstry amckinstry ((0,0)(15,47)(0,0))
2
((0,0)(15,31)(0,0))
((0,32)(15,47)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_disjoint_b 0000644 0001750 0001750 00000000201 11634153073 023667 0 ustar amckinstry amckinstry boxes = grids/gr.3_disjoint_b
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 8.0 8.0 24.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_2x2_c 0000644 0001750 0001750 00000000152 11634153073 022466 0 ustar amckinstry amckinstry ((0,0)(63,63)(0,0))
4
((0,0)(31,31)(0,0))
((32,0)(63,31)(0,0))
((0,32)(31,63)(0,0))
((32,32)(63,63)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_3boxes_a 0000644 0001750 0001750 00000000163 11634153073 023254 0 ustar amckinstry amckinstry boxes = grids/gr.2_3boxes_a
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 32.0 48.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_disjoint_d 0000644 0001750 0001750 00000000120 11634153073 023672 0 ustar amckinstry amckinstry ((0,0)(15,15)(0,0))
3
((0,0)(7,7)(0,0))
((8,0)(15,7)(0,0))
((0,12)(15,15)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_stack_d 0000644 0001750 0001750 00000000162 11634153073 023160 0 ustar amckinstry amckinstry boxes = grids/gr.2_stack_d
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 16.0 64.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_disjoint_a 0000644 0001750 0001750 00000000075 11634153073 023700 0 ustar amckinstry amckinstry ((0,0)(31,15)(0,0))
2
((0,0)(7,15)(0,0))
((14,0)(31,7)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_19boxes 0000644 0001750 0001750 00000001205 11634153073 023043 0 ustar amckinstry amckinstry ((0,0)(511,255)(0,0)) 19
((0,72)(135,119)(0,0))
((288,80)(399,119)(0,0))
((160,48)(215,71)(0,0))
((0,136)(135,183)(0,0))
((400,72)(511,119)(0,0))
((152,72)(231,103)(0,0))
((280,144)(351,167)(0,0))
((496,128)(511,143)(0,0))
((280,120)(383,143)(0,0))
((152,104)(191,207)(0,0))
((352,144)(511,183)(0,0))
((456,120)(487,143)(0,0))
((384,120)(391,127)(0,0))
((192,152)(231,175)(0,0))
((400,128)(431,143)(0,0))
((384,136)(399,143)(0,0))
((192,176)(207,207)(0,0))
((432,136)(455,143)(0,0))
((208,176)(231,191)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_disjoint_c 0000644 0001750 0001750 00000000074 11634153073 023701 0 ustar amckinstry amckinstry ((0,0)(15,15)(0,0))
2
((0,0)(7,7)(0,0))
((8,8)(15,15)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_disjoint_c 0000644 0001750 0001750 00000000201 11634153073 023670 0 ustar amckinstry amckinstry boxes = grids/gr.3_disjoint_c
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 16.0 24.0 24.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_disjoint_a 0000644 0001750 0001750 00000000201 11634153073 023666 0 ustar amckinstry amckinstry boxes = grids/gr.3_disjoint_a
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 16.0 16.0 32.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_2boxes_a 0000644 0001750 0001750 00000000177 11634153073 023261 0 ustar amckinstry amckinstry boxes = grids/gr.3_2boxes_a
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 8.0 8.0 16.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_small_a 0000644 0001750 0001750 00000000062 11634153073 023162 0 ustar amckinstry amckinstry ((0,0,0)(7,7,7)(0,0,0))
1
((0,0,0)(7,7,7)(0,0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3per_2x3x4 0000644 0001750 0001750 00000000265 11634153073 023154 0 ustar amckinstry amckinstry boxes = grids/gr.3_2x3x4
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 16.0 24.0 32.0
-geometry.period_0
-geometry.period_1
-geometry.period_2
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_disjoint_c 0000644 0001750 0001750 00000000165 11634153073 023700 0 ustar amckinstry amckinstry boxes = grids/gr.2_disjoint_c
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 16.0 16.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_2x3x4 0000644 0001750 0001750 00000000174 11634153073 022444 0 ustar amckinstry amckinstry boxes = grids/gr.3_2x3x4
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 16.0 24.0 32.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_big 0000644 0001750 0001750 00000000172 11634153073 022313 0 ustar amckinstry amckinstry boxes = grids/gr.3_big
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 64.0 64.0 64.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_mac_tst 0000644 0001750 0001750 00000002225 11634153073 023207 0 ustar amckinstry amckinstry (( 0, 0, 0) ( 7,39, 7) (0,0,0))
40
((0,0,0) (3,3,3) (0,0,0))
((4,0,0) (7,3,3) (0,0,0))
((0,36,0) (3,39,3) (0,0,0))
((0,32,0) (3,35,3) (0,0,0))
((0,28,0) (3,31,3) (0,0,0))
((0,24,0) (3,27,3) (0,0,0))
((0,20,0) (3,23,3) (0,0,0))
((0,16,0) (3,19,3) (0,0,0))
((0,12,0) (3,15,3) (0,0,0))
((0,8,0) (3,11,3) (0,0,0))
((0,4,0) (3,7,3) (0,0,0))
((0,0,4) (3,3,7) (0,0,0))
((4,36,0) (7,39,3) (0,0,0))
((4,32,0) (7,35,3) (0,0,0))
((4,28,0) (7,31,3) (0,0,0))
((4,24,0) (7,27,3) (0,0,0))
((4,20,0) (7,23,3) (0,0,0))
((4,16,0) (7,19,3) (0,0,0))
((4,12,0) (7,15,3) (0,0,0))
((4,8,0) (7,11,3) (0,0,0))
((4,4,0) (7,7,3) (0,0,0))
((4,0,4) (7,3,7) (0,0,0))
((0,36,4) (3,39,7) (0,0,0))
((0,32,4) (3,35,7) (0,0,0))
((0,28,4) (3,31,7) (0,0,0))
((0,24,4) (3,27,7) (0,0,0))
((0,20,4) (3,23,7) (0,0,0))
((0,16,4) (3,19,7) (0,0,0))
((0,12,4) (3,15,7) (0,0,0))
((0,8,4) (3,11,7) (0,0,0))
((0,4,4) (3,7,7) (0,0,0))
((4,36,4) (7,39,7) (0,0,0))
((4,32,4) (7,35,7) (0,0,0))
((4,28,4) (7,31,7) (0,0,0))
((4,24,4) (7,27,7) (0,0,0))
((4,20,4) (7,23,7) (0,0,0))
((4,16,4) (7,19,7) (0,0,0))
((4,12,4) (7,15,7) (0,0,0))
((4,8,4) (7,11,7) (0,0,0))
((4,4,4) (7,7,7) (0,0,0))
1
(( 0, 0, 0) ( 7,39, 7) (0,0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_stack_b 0000644 0001750 0001750 00000000077 11634153073 023165 0 ustar amckinstry amckinstry ((0,0)(47,31)(0,0))
2
((0,0)(31,31)(0,0))
((32,0)(47,31)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_3boxes_c 0000644 0001750 0001750 00000000125 11634153073 023256 0 ustar amckinstry amckinstry ((0,0)(63,63)(0,0))
3
((0,0)(15,63)(0,0))
((16,0)(63,31)(0,0))
((16,32)(63,63)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_disjoint_a 0000644 0001750 0001750 00000000165 11634153073 023676 0 ustar amckinstry amckinstry boxes = grids/gr.2_disjoint_a
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 32.0 16.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_19boxes 0000644 0001750 0001750 00000000166 11634153073 023046 0 ustar amckinstry amckinstry boxes = grids/gr.2_19boxes
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 512.0 256.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_disjoint_b 0000644 0001750 0001750 00000000076 11634153073 023702 0 ustar amckinstry amckinstry ((0,0)(31,31)(0,0))
2
((0,0)(7,7)(0,0))
((24,24)(31,31)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_mac_tst 0000644 0001750 0001750 00000001010 11634153073 023174 0 ustar amckinstry amckinstry boxes = grids/gr.3_mac_tst
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 0.16 0.8 .16
use_cg_solve = 0
Density = 3
dt = 0.0001543470841
mac_tol = 1e-12
mac_abs_tol = 1e-14
rhs_scale = 12957.80877
dump_norm = true
mg.numLevelsMAX=1
mg.v = 4
mg.usecg = 1
mg.nu_0 = 1
mg.nu_1 = 4
mg.nu_2 = 4
mg.nu_f = 40
mg.maxiter = 100
cg.maxiter = 40 # default 40
cg.unstable_criterion = 10. # default 10.
cg.v = 4
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_2x2_a 0000644 0001750 0001750 00000000152 11634153073 022464 0 ustar amckinstry amckinstry ((0,0)(31,63)(0,0))
4
((0,0)(15,31)(0,0))
((16,0)(31,31)(0,0))
((0,32)(15,63)(0,0))
((16,32)(31,63)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_stack_d 0000644 0001750 0001750 00000000077 11634153073 023167 0 ustar amckinstry amckinstry ((0,0)(15,63)(0,0))
2
((0,0)(15,31)(0,0))
((0,32)(15,63)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_stack_b 0000644 0001750 0001750 00000000162 11634153073 023156 0 ustar amckinstry amckinstry boxes = grids/gr.2_stack_b
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 48.0 32.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_3boxes_a 0000644 0001750 0001750 00000000124 11634153073 023253 0 ustar amckinstry amckinstry ((0,0)(31,47)(0,0))
3
((0,0)(15,31)(0,0))
((16,0)(31,31)(0,0))
((0,32)(31,47)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_disjoint_e 0000644 0001750 0001750 00000000074 11634153073 023703 0 ustar amckinstry amckinstry ((0,0)(15,11)(0,0))
2
((0,0)(7,7)(0,0))
((8,4)(15,11)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_2x2_b 0000644 0001750 0001750 00000000160 11634153073 022462 0 ustar amckinstry amckinstry boxes = grids/gr.2_2x2_b
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 64.0 64.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_disjoint_a 0000644 0001750 0001750 00000000124 11634153073 023674 0 ustar amckinstry amckinstry ((0,0,0)(15,15,31)(0,0,0))
2
((0,0,0)(15,15,15)(0,0,0))
((8,8,24)(15,15,31)(0,0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_2boxes_a 0000644 0001750 0001750 00000000114 11634153073 023252 0 ustar amckinstry amckinstry ((0,0,0)(7,7,15)(0,0,0))
2
((0,0,0)(7,7,7)(0,0,0))
((0,0,8)(7,7,15)(0,0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_2x3x4 0000644 0001750 0001750 00000001241 11634153073 022442 0 ustar amckinstry amckinstry ((0,0,0)(15,23,31)(0,0,0))
24
((0,0,0)(7,7,7)(0,0,0))
((8,0,0)(15,7,7)(0,0,0))
((0,8,0)(7,15,7)(0,0,0))
((8,8,0)(15,15,7)(0,0,0))
((0,16,0)(7,23,7)(0,0,0))
((8,16,0)(15,23,7)(0,0,0))
((0,0,8)(7,7,15)(0,0,0))
((8,0,8)(15,7,15)(0,0,0))
((0,8,8)(7,15,15)(0,0,0))
((8,8,8)(15,15,15)(0,0,0))
((0,16,8)(7,23,15)(0,0,0))
((8,16,8)(15,23,15)(0,0,0))
((0,0,16)(7,7,23)(0,0,0))
((8,0,16)(15,7,23)(0,0,0))
((0,8,16)(7,15,23)(0,0,0))
((8,8,16)(15,15,23)(0,0,0))
((0,16,16)(7,23,23)(0,0,0))
((8,16,16)(15,23,23)(0,0,0))
((0,0,24)(7,7,31)(0,0,0))
((8,0,24)(15,7,31)(0,0,0))
((0,8,24)(7,15,31)(0,0,0))
((8,8,24)(15,15,31)(0,0,0))
((0,16,24)(7,23,31)(0,0,0))
((8,16,24)(15,23,31)(0,0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.3_small_a 0000644 0001750 0001750 00000000176 11634153073 023166 0 ustar amckinstry amckinstry boxes = grids/gr.3_small_a
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0 0.0
geometry.prob_hi = 8.0 8.0 8.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_stack_c 0000644 0001750 0001750 00000000162 11634153073 023157 0 ustar amckinstry amckinstry boxes = grids/gr.2_stack_c
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 16.0 48.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_3boxes_b 0000644 0001750 0001750 00000000163 11634153073 023255 0 ustar amckinstry amckinstry boxes = grids/gr.2_3boxes_b
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 64.0 64.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_disjoint_d 0000644 0001750 0001750 00000000165 11634153073 023701 0 ustar amckinstry amckinstry boxes = grids/gr.2_disjoint_d
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 16.0 16.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_stack_c 0000644 0001750 0001750 00000000077 11634153073 023166 0 ustar amckinstry amckinstry ((0,0)(15,47)(0,0))
2
((0,0)(15,15)(0,0))
((0,16)(15,47)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.2_small_b 0000644 0001750 0001750 00000000072 11634153073 023163 0 ustar amckinstry amckinstry ((0,0)(7,15)(0,0))
2
((0,0)(7,7)(0,0))
((0,8)(7,15)(0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_big 0000644 0001750 0001750 00000000070 11634153073 022312 0 ustar amckinstry amckinstry ((0,0,0)(63,63,63)(0,0,0))
1
((0,0,0)(63,63,63)(0,0,0))
ccseapps-2.5/CCSEApps/mglib/Test/grids/in.2_3x2 0000644 0001750 0001750 00000000156 11634153073 022167 0 ustar amckinstry amckinstry boxes = grids/gr.2_3x2
geometry.coord_sys = 0
geometry.prob_lo = 0.0 0.0
geometry.prob_hi = 32.0 48.0
ccseapps-2.5/CCSEApps/mglib/Test/grids/gr.3_stack_a 0000644 0001750 0001750 00000000244 11634153073 023161 0 ustar amckinstry amckinstry ((0,0,0)(15,23,15)(0,0,0))
5
((0,0,0)(15,15,15)(0,0,0))
((0,16,0)(7,23,7)(0,0,0))
((8,16,0)(15,23,7)(0,0,0))
((0,16,8)(7,23,15)(0,0,0))
((8,16,8)(15,23,15)(0,0,0))
ccseapps-2.5/CCSEApps/mglib/LO_F.H 0000644 0001750 0001750 00000012161 11634153073 017642 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
#ifndef _LO_F_H_
#define _LO_F_H_
/*
** $Id: LO_F.H,v 1.3 2002/04/26 22:10:02 lijewski Exp $
*/
#include
#if defined(BL_LANG_FORT)
#if (BL_SPACEDIM == 2)
#define FORT_AVERAGECC averagecc2dgen
#define FORT_AVERAGEEC averageec2dgen
#define FORT_HARMONIC_AVERAGEEC haraverageec2dgen
#define FORT_APPLYBC applybc2dgen
#define FORT_RESIDL resid2dgen
#endif
#if (BL_SPACEDIM == 3)
#define FORT_AVERAGECC averagecc3dgen
#define FORT_AVERAGEEC averageec3dgen
#define FORT_HARMONIC_AVERAGEEC haraverageec3dgen
#define FORT_APPLYBC applybc3dgen
#define FORT_RESIDL resid3dgen
#endif
#else
#if (BL_SPACEDIM == 2)
#if defined(BL_FORT_USE_UPPERCASE)
#define FORT_AVERAGECC AVERAGECC2DGEN
#define FORT_AVERAGEEC AVERAGEEC2DGEN
#define FORT_HARMONIC_AVERAGEEC HARAVERAGEEC2DGEN
#define FORT_APPLYBC APPLYBC2DGEN
#define FORT_RESIDL RESID2DGEN
#elif defined(BL_FORT_USE_LOWERCASE)
#define FORT_AVERAGECC averagecc2dgen
#define FORT_AVERAGEEC averageec2dgen
#define FORT_HARMONIC_AVERAGEEC haraverageec2dgen
#define FORT_APPLYBC applybc2dgen
#define FORT_RESIDL resid2dgen
#elif defined(BL_FORT_USE_UNDERSCORE)
#define FORT_AVERAGECC averagecc2dgen_
#define FORT_AVERAGEEC averageec2dgen_
#define FORT_HARMONIC_AVERAGEEC haraverageec2dgen_
#define FORT_APPLYBC applybc2dgen_
#define FORT_RESIDL resid2dgen_
#endif
#endif
#if (BL_SPACEDIM == 3)
#if defined(BL_FORT_USE_UPPERCASE)
#define FORT_AVERAGECC AVERAGECC3DGEN
#define FORT_AVERAGEEC AVERAGEEC3DGEN
#define FORT_HARMONIC_AVERAGEEC HARAVERAGEEC3DGEN
#define FORT_APPLYBC APPLYBC3DGEN
#define FORT_RESIDL RESID3DGEN
#elif defined(BL_FORT_USE_LOWERCASE)
#define FORT_AVERAGECC averagecc3dgen
#define FORT_AVERAGEEC averageec3dgen
#define FORT_HARMONIC_AVERAGEEC haraverageec3dgen
#define FORT_APPLYBC applybc3dgen
#define FORT_RESIDL resid3dgen
#elif defined(BL_FORT_USE_UNDERSCORE)
#define FORT_AVERAGECC averagecc3dgen_
#define FORT_AVERAGEEC averageec3dgen_
#define FORT_HARMONIC_AVERAGEEC haraverageec3dgen_
#define FORT_APPLYBC applybc3dgen_
#define FORT_RESIDL resid3dgen_
#endif
#endif
#include
extern "C"
{
void FORT_RESIDL (
Real* res , ARLIM_P(res_lo), ARLIM_P(res_hi),
const Real* rhs, ARLIM_P(rhs_lo), ARLIM_P(rhs_hi),
const Real* phi, ARLIM_P(phi_lo), ARLIM_P(phi_hi),
const int* lo, const int* hi, const int* nc
);
void FORT_APPLYBC(
const int *flagden, const int *flagbc, const int *maxorder,
Real *phi, ARLIM_P(phi_lo), ARLIM_P(phi_hi),
const int *cdr,
const int *bct,
const Real *bcl,
const Real *bcval, ARLIM_P(bcval_lo), ARLIM_P(bcval_hi),
const int *mask, ARLIM_P(mask_lo), ARLIM_P(mask_hi),
Real *den, ARLIM_P(den_lo), ARLIM_P(den_hi),
const int *lo, const int *hi, const int *nc,
const Real *h
);
void FORT_AVERAGECC (
Real* crseX, ARLIM_P(crseX_lo), ARLIM_P(crseX_hi),
const Real* fineX, ARLIM_P(fineX_lo), ARLIM_P(fineX_hi),
const int *tlo, const int *thi, const int *nc
);
void FORT_AVERAGEEC (
Real* crseX, ARLIM_P(crseX_lo), ARLIM_P(crseX_hi),
const Real* fineX, ARLIM_P(fineX_lo), ARLIM_P(fineX_hi),
const int *tlo, const int *thi, const int *nc,
const int *axis
);
void FORT_HARMONIC_AVERAGEEC (
Real* crseX, ARLIM_P(crseX_lo), ARLIM_P(crseX_hi),
const Real* fineX, ARLIM_P(fineX_lo), ARLIM_P(fineX_hi),
const int *tlo, const int *thi, const int *nc,
const int *axis
);
}
#endif
#endif /*_LO_F_H_*/
ccseapps-2.5/CCSEApps/mglib/OpenSource.txt 0000644 0001750 0001750 00000024346 11634153073 021605 0 ustar amckinstry amckinstry SOURCE CODE LICENSE AGREEMENT
Software: MGLib
Version: Oct. 12, 2000 Release
IMPORTANT - READ CAREFULLY: This License Agreement ("Agreement") is a
legal agreement between you (in your capacity as an individual and as
an agent for your company, institution or other entity) and The
Regents of the University of California, Department of Energy
contract-operators of the Ernest Orlando Lawrence Berkeley National
Laboratory ("Berkeley Lab"). Downloading, installing, using, or
copying of the Software (as defined below) by you or by a third party
on your behalf indicates your agreement to be bound by the terms and
conditions of this Agreement. If you do not agree to these terms and
conditions, do not download, install or use the Software.
1. LICENSE GRANT. Berkeley Lab grants you, and you hereby accept, a
non-exclusive, royalty-free perpetual license to install, use,
modify, prepare derivative works, incorporate into other computer
software, and distribute the version noted above of the computer
software program noted above, in binary and source code format, or
any derivative work thereof, together with any associated media,
printed materials, and on-line or electronic documentation (if
any) provided by Berkeley Lab (collectively, the "Software"),
subject to the following terms and conditions: (i) any
distribution of the Software shall bind the receiver to the terms
and conditions of this Agreement; (ii) any distribution of the
Software in modified form shall clearly state that the Software
has been modified from the version originally obtained from
Berkeley Lab. This version of the Software constitutes a research
prototype and may be changed substantially. The license grant set
forth above is subject to receipt by Berkeley Lab of any required
U.S. Department of Energy approvals.
2. COPYRIGHT; RETENTION OF RIGHTS. The above license grant is
conditioned on the following: (i) you must reproduce all copyright
notices and other proprietary notices on any copies of the
Software and you must not remove such notices; (ii) in the event
you compile the Software, you will include the copyright notice
with the binary in such a manner as to allow it to be easily
viewable; (iii) if you incorporate the Software into other code,
you must provide notice that the code contains the Software and
include a copy of the copyright notices and other proprietary
notices. All copies of the Software shall be subject to the terms
of this Agreement. Subject to approval by the U.S. Department of
Energy: (a) you hereby acknowledge that the Software is protected
by United States copyright law and international treaty
provisions; (b) Berkeley Lab, and its licensors (if any), hereby
reserve all rights in the Software which are not explicitly
granted to you herein; (c) without limiting the generality of the
foregoing, Berkeley Lab and its licensors retain all title,
copyright, and other proprietary interests in the Software and any
copies thereof, and you do not acquire any rights, express or
implied, in the Software, other than those specifically set forth
in this Agreement.
3. NO MAINTENANCE OR SUPPORT; TREATMENT OF ENHANCEMENTS YOU CHOOSE TO
PROVIDE TO BERKELEY LAB. Berkeley Lab is under no obligation
whatsoever to: (i) provide maintenance or support for the
Software; or (ii) to notify you of bug fixes, patches, or upgrades
to the features, functionality or performance of the Software
("Enhancements") (if any), whether developed by Berkeley Lab or
third parties. If, in its sole discretion, Berkeley Lab makes an
Enhancement available to you and Berkeley Lab does not separately
enter into a written license agreement with you relating to such
bug fix, patch or upgrade, then it shall be deemed incorporated
into the Software and subject to this Agreement. You are under no
obligation whatsoever to provide any Enhancements to Berkeley Lab
that you may develop over time; however, if you choose to provide
Berkeley Lab with Enhancements in source code form that you have
developed without contemporaneously requiring Berkeley Lab to
enter into a separate written license agreement, then you hereby
grant Berkeley Lab a non-exclusive, royalty-free perpetual license
to install, use, modify, prepare derivative works, incorporate
into the Software or other computer software, distribute, and
sublicense your Enhancements or derivative works thereof, in
binary and source code form.
4. U.S. GOVERNMENT RIGHTS. The Software was developed under funding
from the U.S. Department of Energy and the U.S. Government
consequently retains certain rights as follows: the
U.S. Government has been granted for itself and others acting on
its behalf a paid-up, nonexclusive, irrevocable, worldwide license
in the Software to reproduce, prepare derivative works, and
perform publicly and display publicly. Beginning five (5) years
after the date permission to assert copyright was granted by the
U.S. Dept. of Energy, and subject to any subsequent five (5) year
renewals, the U.S. Government is granted for itself and others
acting on its behalf a paid-up, nonexclusive, irrevocable,
worldwide license in the Software to reproduce, prepare derivative
works, distribute copies to the public, perform publicly and
display publicly, and to permit others to do so.
5. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS" WITHOUT
WARRANTY OF ANY KIND. BERKELEY LAB, ITS LICENSORS, THE UNITED
STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND THEIR
EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR IMPLIED,
INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE OR
NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY OR
RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR USEFULNESS OF
THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF THE SOFTWARE WOULD
NOT INFRINGE PRIVATELY OWNED RIGHTS, (4) DO NOT WARRANT THAT THE
SOFTWARE WILL FUNCTION UNINTERRUPTED, THAT IT IS ERROR-FREE OR
THAT ANY ERRORS WILL BE CORRECTED.
6. LIMITATION OF LIABILITY. IN NO EVENT WILL BERKELEY LAB OR ITS
LICENSORS BE LIABLE FOR ANY INDIRECT, INCIDENTAL, CONSEQUENTIAL,
SPECIAL OR PUNITIVE DAMAGES OF ANY KIND OR NATURE, INCLUDING BUT
NOT LIMITED TO LOSS OF PROFITS OR LOSS OF DATA, FOR ANY REASON
WHATSOEVER, WHETHER SUCH LIABILITY IS ASSERTED ON THE BASIS OF
CONTRACT, TORT (INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR
OTHERWISE, EVEN IF BERKELEY LAB HAS BEEN WARNED OF THE POSSIBILITY
OF SUCH LOSS OR DAMAGES. IN NO EVENT SHALL BERKELEY LAB'S
LIABILITY FOR DAMAGES ARISING FROM OR IN CONNECTION WITH THIS
AGREEMENT EXCEED THE AMOUNT PAID BY YOU FOR THE SOFTWARE.
7. INDEMNITY. You shall indemnify, defend, and hold harmless
Berkeley Lab, the U.S. Government, the Software developers, the
Software sponsors, and their agents, officers, and employees,
against any and all claims, suits, losses, damage, costs, fees,
and expenses arising out of or in connection with this Agreement.
You shall pay all costs incurred by Berkeley Lab in enforcing this
provision, including reasonable attorney fees.
8. TERM AND TERMINATION. The license granted to you under this
Agreement will continue perpetually unless terminated by Berkeley
Lab in accordance with this Agreement. If you breach any term of
this Agreement, and fail to cure such breach within thirty (30)
days of the date of written notice, this Agreement shall
immediately terminate. Upon such termination, you shall
immediately cease using the Software, return to Berkeley Lab, or
destroy, all copies of the Software, and provide Berkeley Lab with
written certification of your compliance with the foregoing.
Termination shall not relieve you from your obligations arising
prior to such termination. Notwithstanding any provision of this
Agreement to the contrary, Sections 5 through 10 shall survive
termination of this Agreement.
9. EXPORT CONTROLS. You shall observe all applicable United States
and foreign laws and regulations (if any) with respect to the
export, re-export, diversion or transfer of the Software, related
technical data and direct products thereof, including, without
limitation, the International Traffic in Arms Regulations (ITAR)
and the Export Administration Regulations.
10. NO ENDORSEMENT. In accordance with California Education Code
Section 92000, you shall not use in advertising, publicity or
other promotional activities any name, trade name, trademark, or
other designation of the University of California, nor shall you
so use "Ernest Orlando Lawrence Berkeley National Laboratory" or
"United States Department of Energy" (including any contraction,
abbreviation, or simulation of any of the foregoing) without
Berkeley Lab's prior written consent.
11. GENERAL. This Agreement shall be governed by the laws of the
State of California, excluding its rules governing conflicts of
laws. No provision in either party's purchase orders, or in any
other business forms employed by either party will supersede the
terms of this Agreement, and no modification or amendment of this
Agreement is binding, unless in writing signed by a duly
authorized representative of each party. This Agreement is
binding upon and shall inure to the benefit of Berkeley Lab, its
successors and assigns. This Agreement represents the entire
understanding of the parties, and supersedes all previous
communications, written or oral, relating to the subject of this
Agreement. If you have any questions concerning this license,
contact Lawrence Berkeley National Laboratory, Technology Transfer
Department, One Cyclotron Road, MS 90-1070, Berkeley, CA 94720,
Attn: Software Licensing or via e-mail at TTD@lbl.gov.
If you have any questions or feedback concerning this Software,
contact the Center for Computational Sciences and Engineering,
Lawrence Berkeley National Laboratory, One Cyclotron Road, MS
50A-1148, Berkeley, CA 94720 or via email at webmaster@mothra.lbl.gov.
Form rev000928
ccseapps-2.5/CCSEApps/scripts/ 0000755 0001750 0001750 00000000000 11634153073 017346 5 ustar amckinstry amckinstry ccseapps-2.5/CCSEApps/scripts/dsp.mak 0000644 0001750 0001750 00000023751 11634153073 020636 0 ustar amckinstry amckinstry #!/bin/sh
USAGE="Usage: $myName [-p project] [-t paralleltopdir] [-v prversion] [-d spacedim] [-o outfile] [-O <0, 1>] [-f namefile] [-S] filenames"
myName=$0
PROJ=IAMRAll
TOP=..\..
DIM=2
OFILE=$PROJ.dsp
OLEVEL=0 # 0 - DEBUG, 1 - Release
VERSION=0
SERIAL=0
NFILE=
#
# Parse command arguments, exit if incorrect usage
#
if [ $# = 0 ]
then
echo $USAGE
exit
fi
#set -- `getopt p:t:d:o:O:f:v:S $*`
if [ $? != 0 ]
then
echo $USAGE
exit
fi
for argument in $*
do
case $argument in
-p) shift;PROJ=$1;shift;;
-t) shift;TOP=`echo $1 | sed 's/\\//\\\/g'`;shift;;
-d) shift;DIM=$1;shift;;
-o) shift;OFILE=$1;shift;;
-O) shift;OLEVEL=$1;shift;;
-f) shift;NFILE=$1;shift;;
-v) shift;VERSION=$1;shift;;
-S) shift;SERIAL=1;;
--) shift;break;;
esac
done
files=$*
vN=5
if [ ${VERSION} = v9 ]
then
vN=9
fi
CPROJVERS='/D "BL_PRVERSION='${vN}\"
FPROJVERS='/DBL_PRVERSION='${vN}
CPROJDEF=
FPROJDEF=
if [ ${SERIAL} = 1 ]
then
CPROJDEF='/D "BL_USE_HGPROJ_SERIAL"'
FPROJDEF='/DBL_USE_HGPROJ_SERIAL'
fi
if [ -n $NFILE ]
then
files=`cat $NFILE` $files
fi
OptString=Debug
if [ $OLEVEL = 1 ]
then
OptString=Release
fi
#
# Split up the infiles
#
FEXE_sources=
CEXE_sources=
CEXE_headers=
fEXE_sources=
IncludeLocations=
for f in `cat $NFILE`
do
if [ `echo $f | fgrep .F` ]
then
FEXE_sources="${FEXE_sources} $f"
else if [ `echo $f | fgrep .cpp` ]
then
CEXE_sources="${CEXE_sources} $f"
else if [ `echo $f | grep '\.[hH]'` ]
then
CEXE_headers="${CEXE_headers} $f"
else if [ `echo $f | fgrep .f` ]
then
fEXE_sources="${fEXE_sources} $f"
else
dir=`echo $f | tr '\\/' '\\\'`
IncludeLocations="$IncludeLocations $dir"
fi
fi
fi
fi
done
cdirlist=
for d in $IncludeLocations
do
cdirlist="$cdirlist /I \"$d\""
done
fdirlist=
for d in $IncludeLocations
do
fdirlist="$fdirlist /S$d"
done
cat > $OFILE << EOF
# Microsoft Developer Studio Project File - Name="$PROJ" - Package Owner=<4>
# Microsoft Developer Studio Generated Build File, Format Version 6.00
# ** DO NOT EDIT **
# TARGTYPE "Win32 (x86) Console Application" 0x0103
CFG=$PROJ - Win32 $OptString
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
!MESSAGE use the Export Makefile command and run
!MESSAGE
!MESSAGE NMAKE /f "$PROJ.mak".
!MESSAGE
!MESSAGE You can specify a configuration when running NMAKE
!MESSAGE by defining the macro CFG on the command line. For example:
!MESSAGE
!MESSAGE NMAKE /f "$PROJ.mak" CFG="$PROJ - Win32 Release"
!MESSAGE
!MESSAGE Possible choices for configuration are:
!MESSAGE
!MESSAGE "$PROJ - Win32 Release" (based on "Win32 (x86) Console Application")
!MESSAGE "$PROJ - Win32 Debug" (based on "Win32 (x86) Console Application")
!MESSAGE
# Begin Project
# PROP AllowPerConfigDependencies 0
# PROP Scc_ProjName ""
# PROP Scc_LocalPath ""
CPP=cl.exe
F90=df.exe
RSC=rc.exe
!IF "\$(CFG)" == "$PROJ - Win32 Release"
# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 0
# PROP BASE Output_Dir "Release"
# PROP BASE Intermediate_Dir "Release"
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 0
# PROP Output_Dir "Release"
# PROP Intermediate_Dir "Release"
# PROP Ignore_Export_Lib 0
# PROP Target_Dir ""
# ADD BASE F90 /compile_only /include:"Release/" /nologo /warn:nofileopt
# ADD F90 /assume:noaccuracy_sensitive /compile_only /debug:none /iface:cref /include:"Release/" /math_library:fast /nologo /threads /tune:k7 /warn:nofileopt /unroll:4
# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
# ADD CPP /nologo /MT /W3 /GR /GX /O2 $cdirlist /I "C:\WMPI\include" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /D "WIN32" /D "BL_USE_DOUBLE" /D "BL_ARCH_IEEE" /D "BL_USE_NEW_HFILES" /D "BL_SPACEDIM=${DIM}" ${CPROJDEF} ${CPROJVERS} /D "BL_PARALLEL_IO" /D "BL_FORT_USE_UPPERCASE" /D "BL_LANG_CC" /D "BL_USE_CHEM" /D for="if(0);else for" /YX /FD /c
# ADD BASE RSC /l 0x409 /d "NDEBUG"
# ADD RSC /l 0x409 /d "NDEBUG"
BSC32=bscmake.exe
# ADD BASE BSC32 /nologo
# ADD BSC32 /nologo
LINK32=link.exe
# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib dformt.lib /nologo /subsystem:console /machine:I386 /include:"__matherr"
!ELSEIF "\$(CFG)" == "$PROJ - Win32 Debug"
# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 1
# PROP BASE Output_Dir "Debug"
# PROP BASE Intermediate_Dir "Debug"
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 1
# PROP Output_Dir "Debug"
# PROP Intermediate_Dir "Debug"
# PROP Ignore_Export_Lib 0
# PROP Target_Dir ""
# ADD BASE F90 /check:bounds /compile_only /debug:full /include:"Debug/" /nologo /traceback /warn:argument_checking /warn:nofileopt
# ADD F90 /browser /check:bounds /compile_only /dbglibs /debug:full /iface:cref /include:"Debug/" /libs:static /nologo /traceback /warn:argument_checking /optimize:0 /threads /warn:nofileopt
# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
# ADD CPP /nologo /MTd /W3 /Gm /GR /GX /ZI /Od $cdirlist /I "C:\WMPI\include" /D "_CONSOLE" /D "_MBCS" /D "_DEBUG" /D "WIN32" /D "BL_USE_DOUBLE" /D "BL_ARCH_IEEE" /D "BL_USE_NEW_HFILES" /D "BL_SPACEDIM=${DIM}" ${CPROJDEF} ${CPROJVERS} /D "BL_PARALLEL_IO" /D "BL_FORT_USE_UPPERCASE" /D "BL_LANG_CC" /D "BL_USE_CHEM" /D for="if(0);else for" /FR /YX /FD /c
# ADD BASE RSC /l 0x409 /d "_DEBUG"
# ADD RSC /l 0x409 /d "_DEBUG"
BSC32=bscmake.exe
# ADD BASE BSC32 /nologo
# ADD BSC32 /nologo
LINK32=link.exe
# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib dformt.lib /nologo /subsystem:console /debug /machine:I386 /include:"__matherr" /pdbtype:sept
!ENDIF
# Begin Target
# Name "$PROJ - Win32 Release"
# Name "$PROJ - Win32 Debug"
EOF
#
# Do C++ sources
#
cat >> $OFILE <> $OFILE << EOF
# Begin Source File
SOURCE=$cppfile
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
#
# Do C++ headers
#
cat >> $OFILE <> $OFILE << EOF
# Begin Source File
SOURCE=$cpphdr
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
#
# Do processed fortran sources
#
cat >> $OFILE << EOF
# Begin Group "Fortran"
# PROP Default_Filter ""
EOF
for file in $fEXE_sources
do
forfile=`echo $file | sed 's/\\//\\\/g'`
cat >> $OFILE << EOF
# Begin Source File
SOURCE=$forfile
# End Source File
EOF
done
cat >> $OFILE << EOF
# Begin Group "TEMPS-Debug"
# PROP Default_Filter "FOR"
EOF
for file in $FEXE_sources
do
filer=`basename $file .F`
ffile=$filer.FOR
forfile=`echo $ffile | sed 's/\\//\\\/g'`
cat >> $OFILE << EOF
# Begin Source File
SOURCE=Debug\\Fort\\$forfile
!IF "\$(CFG)" == "$PROJ - Win32 Release"
# PROP Exclude_From_Build 1
!ELSEIF "\$(CFG)" == "$PROJ - Win32 Debug"
!ENDIF
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
cat >> $OFILE << EOF
# Begin Group "TEMPS-Release"
# PROP Default_Filter "FOR"
EOF
for file in $FEXE_sources
do
filer=`basename $file .F`
ffile=$filer.FOR
forfile=`echo $ffile | sed 's/\\//\\\/g'`
cat >> $OFILE << EOF
# Begin Source File
SOURCE=Release\\Fort\\$forfile
!IF "\$(CFG)" == "$PROJ - Win32 Release"
!ELSEIF "\$(CFG)" == "$PROJ - Win32 Debug"
# PROP Exclude_From_Build 1
!ENDIF
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
#
# Do preprocessing for Fortran sources
#
for file in $FEXE_sources
do
ifile=`basename $file .F`
ffile=`echo $file | sed 's/\\//\\\/g'`
cat >> $OFILE << EOF
# Begin Source File
SOURCE=$ffile
!IF "\$(CFG)" == "$PROJ - Win32 Release"
# PROP Ignore_Default_Tool 1
# Begin Custom Build
InputPath=$ffile
InputName=$ifile
"Release\\Fort\\\$(InputName).FOR" : \$(SOURCE) "\$(INTDIR)" "\$(OUTDIR)"
fpp /m /ansi /nologo $fdirlist /DBL_LANG_FORT /DBL_SPACEDIM=${DIM} /DBL_USE_DOUBLE /DBL_NO_FORT_FLUSH /DBL_USE_CHEM ${FPROJDEF} ${FPROJVERS} \$(InputPath) | perl ${TOP}\scripts\strip72 -c > Release\\Fort\\\$(InputName).FOR
# End Custom Build
!ELSEIF "\$(CFG)" == "$PROJ - Win32 Debug"
# PROP Ignore_Default_Tool 1
# Begin Custom Build
InputPath=$ffile
InputName=$ifile
"Debug\\Fort\\\$(InputName).FOR" : \$(SOURCE) "\$(INTDIR)" "\$(OUTDIR)"
fpp /m /ansi /nologo $fdirlist /DBL_LANG_FORT /DBL_SPACEDIM=${DIM} /DBL_USE_DOUBLE /DBL_NO_FORT_FLUSH /DBL_USE_CHEM ${FPROJDEF} ${FPROJVERS} \$(InputPath) | perl ${TOP}\scripts\strip72 -c > Debug\\Fort\\\$(InputName).FOR
# End Custom Build
!ENDIF
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
cat >> $OFILE << EOF
# End Target
# End Project
EOF
# Add lf's needed by Windows junk
perl -e 'while(<>) {s/\n/\r\n/;print;}' < $OFILE > junk.$$
mv junk.$$ $OFILE
exit 0
ccseapps-2.5/CCSEApps/scripts/dsp.lib.mak 0000644 0001750 0001750 00000020757 11634153073 021406 0 ustar amckinstry amckinstry #!/bin/sh
USAGE="Usage: $myName [-p project] [-t paralleltopdir] [-v prversion] [-d spacedim] [-o outfile] [-O <0, 1>] [-f namefile] [-S] filenames"
myName=$0
PROJ=IAMRAll
TOP=..\..
DIM=2
OFILE=$PROJ.dsp
OLEVEL=0 # 0 - DEBUG, 1 - Release
VERSION=0
SERIAL=0
NFILE=
#
# Parse command arguments, exit if incorrect usage
#
if [ $# = 0 ]
then
echo $USAGE
exit
fi
#set -- `getopt p:t:d:o:O:f:v:S $*`
if [ $? != 0 ]
then
echo $USAGE
exit
fi
for argument in $*
do
case $argument in
-p) shift;PROJ=$1;shift;;
-t) shift;TOP=`echo $1 | sed 's/\\//\\\/g'`;shift;;
-d) shift;DIM=$1;shift;;
-o) shift;OFILE=$1;shift;;
-O) shift;OLEVEL=$1;shift;;
-f) shift;NFILE=$1;shift;;
-v) shift;VERSION=$1;shift;;
-S) shift;SERIAL=1;;
--) shift;break;;
esac
done
files=$*
vN=5
if [ ${VERSION} = v9 ]
then
vN=9
fi
CPROJVERS='/D "BL_PRVERSION='${vN}\"
FPROJVERS='/DBL_PRVERSION='${vN}
CPROJDEF=
FPROJDEF=
if [ ${SERIAL} = 1 ]
then
CPROJDEF='/D "BL_USE_HGPROJ_SERIAL"'
FPROJDEF='/DBL_USE_HGPROJ_SERIAL'
fi
if [ -n $NFILE ]
then
files=`cat $NFILE` $files
fi
OptString=Debug
if [ $OLEVEL = 1 ]
then
OptString=Release
fi
#
# Split up the infiles
#
FEXE_sources=
CEXE_sources=
CEXE_headers=
fEXE_sources=
IncludeLocations=
for f in `cat $NFILE`
do
if [ `echo $f | fgrep .F` ]
then
FEXE_sources="${FEXE_sources} $f"
else if [ `echo $f | fgrep .cpp` ]
then
CEXE_sources="${CEXE_sources} $f"
else if [ `echo $f | grep '\.[hH]'` ]
then
CEXE_headers="${CEXE_headers} $f"
else if [ `echo $f | fgrep .f` ]
then
fEXE_sources="${fEXE_sources} $f"
else
dir=`echo $f | tr '\\/' '\\\'`
IncludeLocations="$IncludeLocations $dir"
fi
fi
fi
fi
done
cdirlist=
for d in $IncludeLocations
do
cdirlist="$cdirlist /I \"$d\""
done
fdirlist=
for d in $IncludeLocations
do
fdirlist="$fdirlist /S$d"
done
cat > $OFILE << EOF
# Microsoft Developer Studio Project File - Name="$PROJ" - Package Owner=<4>
# Microsoft Developer Studio Generated Build File, Format Version 6.00
# ** DO NOT EDIT **
# TARGTYPE "Win32 (x86) Static Library" 0x0104
CFG=$PROJ - Win32 $OptString
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
!MESSAGE use the Export Makefile command and run
!MESSAGE
!MESSAGE NMAKE /f "$PROJ.mak".
!MESSAGE
!MESSAGE You can specify a configuration when running NMAKE
!MESSAGE by defining the macro CFG on the command line. For example:
!MESSAGE
!MESSAGE NMAKE /f "$PROJ.mak" CFG="$PROJ - Win32 Debug"
!MESSAGE
!MESSAGE Possible choices for configuration are:
!MESSAGE
!MESSAGE "$PROJ - Win32 Release" (based on "Win32 (x86) Static Library")
!MESSAGE "$PROJ - Win32 Debug" (based on "Win32 (x86) Static Library")
!MESSAGE
# Begin Project
# PROP AllowPerConfigDependencies 0
# PROP Scc_ProjName ""
# PROP Scc_LocalPath ""
CPP=cl.exe
F90=df.exe
RSC=rc.exe
!IF "\$(CFG)" == "$PROJ - Win32 Release"
# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 0
# PROP BASE Output_Dir "Release"
# PROP BASE Intermediate_Dir "Release"
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 0
# PROP Output_Dir "Release"
# PROP Intermediate_Dir "Release"
# PROP Target_Dir ""
# ADD BASE F90 /compile_only /nologo /warn:nofileopt
# ADD F90 /assume:noaccuracy_sensitive /compile_only /debug:none /iface:cref /include:"Release/" /math_library:fast /nologo /threads /tune:k7 /warn:nofileopt /unroll:4
# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
# ADD CPP /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_LIB" /YX /FD /D "_MBCS" /c
# ADD CPP /nologo /MD /W3 /GR /GX /O2 $cdirlist /I "C:\WMPI\include" /D "NDEBUG" /D "_LIB" /D "BL_LANG_CC" /D "WIN32" /D "_MBCS" /D "BL_USE_DOUBLE" /D "BL_ARCH_IEEE" /D "BL_SPACEDIM=${DIM}" ${CPROJDEF} ${CPROJVERS} /D "BL_PARALLEL_IO" /D "BL_FORT_USE_UPPERCASE" /D "BL_LANG_CC" /D for="if(0);else for" /YX /FD /c
# ADD BASE RSC /l 0x409
# ADD RSC /l 0x409
BSC32=bscmake.exe
# ADD BASE BSC32 /nologo
# ADD BSC32 /nologo
LIB32=link.exe -lib
# ADD BASE LIB32 /nologo
# ADD LIB32 /nologo
!ELSEIF "\$(CFG)" == "$PROJ - Win32 Debug"
# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 1
# PROP BASE Output_Dir "Debug"
# PROP BASE Intermediate_Dir "Debug"
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 1
# PROP Output_Dir "Debug"
# PROP Intermediate_Dir "Debug"
# PROP Target_Dir ""
# ADD BASE F90 /check:bounds /compile_only /debug:full /nologo /warn:argument_checking /warn:nofileopt
# ADD F90 /browser /check:bounds /compile_only /dbglibs /debug:full /iface:cref /libs:dll /nologo /threads /warn:argument_checking /warn:nofileopt
# SUBTRACT F90 /traceback
# ADD BASE CPP /nologo /W3 /GX /Od /D "WIN32" /D "_DEBUG" /D "_LIB" /D "_MBCS" /YX /FD /c
# ADD CPP /nologo /MDd /W3 /Gm /Gi /GR /GX /ZI /Od $cdirlist /I "C:\WMPI\include" /D "_CONSOLE" /D "_MBCS" /D "_DEBUG" /D "WIN32" /D "BL_USE_DOUBLE" /D "BL_ARCH_IEEE" /D "BL_THREADS" /D "BL_SPACEDIM=${DIM}" ${CPROJDEF} ${CPROJVERS} /D "BL_PARALLEL_IO" /D "BL_FORT_USE_UPPERCASE" /D "BL_LANG_CC" /D for="if(0);else for" /FR /YX /FD /c
# ADD BASE RSC /l 0x409
# ADD RSC /l 0x409
BSC32=bscmake.exe
# ADD BASE BSC32 /nologo
# ADD BSC32 /nologo
LIB32=link.exe -lib
# ADD BASE LIB32 /nologo
# ADD LIB32 /nologo
!ENDIF
# Begin Target
# Name "$PROJ - Win32 Release"
# Name "$PROJ - Win32 Debug"
EOF
#
# Do C++ sources
#
cat >> $OFILE <> $OFILE << EOF
# Begin Source File
SOURCE=$cppfile
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
#
# Do C++ headers
#
cat >> $OFILE <> $OFILE << EOF
# Begin Source File
SOURCE=$cpphdr
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
#
# Do processed fortran sources
#
cat >> $OFILE << EOF
# Begin Group "Fortran"
# PROP Default_Filter ""
EOF
for file in $fEXE_sources
do
forfile=`echo $file | sed 's/\\//\\\/g'`
cat >> $OFILE << EOF
# Begin Source File
SOURCE=$forfile
# End Source File
EOF
done
cat >> $OFILE << EOF
# Begin Group "TEMPS-Debug"
# PROP Default_Filter "FOR"
EOF
for file in $FEXE_sources
do
filer=`basename $file .F`
ffile=$filer.FOR
forfile=`echo $ffile | sed 's/\\//\\\/g'`
cat >> $OFILE << EOF
# Begin Source File
SOURCE=Debug\\Fort\\$forfile
!IF "\$(CFG)" == "$PROJ - Win32 Release"
# PROP Exclude_From_Build 1
!ELSEIF "\$(CFG)" == "$PROJ - Win32 Debug"
!ENDIF
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
cat >> $OFILE << EOF
# Begin Group "TEMPS-Release"
# PROP Default_Filter "FOR"
EOF
for file in $FEXE_sources
do
filer=`basename $file .F`
ffile=$filer.FOR
forfile=`echo $ffile | sed 's/\\//\\\/g'`
cat >> $OFILE << EOF
# Begin Source File
SOURCE=Release\\Fort\\$forfile
!IF "\$(CFG)" == "$PROJ - Win32 Release"
!ELSEIF "\$(CFG)" == "$PROJ - Win32 Debug"
# PROP Exclude_From_Build 1
!ENDIF
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
#
# Do preprocessing for Fortran sources
#
for file in $FEXE_sources
do
ifile=`basename $file .F`
ffile=`echo $file | sed 's/\\//\\\/g'`
cat >> $OFILE << EOF
# Begin Source File
SOURCE=$ffile
!IF "\$(CFG)" == "$PROJ - Win32 Release"
# PROP Ignore_Default_Tool 1
# Begin Custom Build
InputPath=$ffile
InputName=$ifile
"Release\\Fort\\\$(InputName).FOR" : \$(SOURCE) "\$(INTDIR)" "\$(OUTDIR)"
fpp /m /ansi /nologo $fdirlist /DBL_LANG_FORT /DBL_SPACEDIM=${DIM} /DBL_USE_DOUBLE /DBL_NO_FORT_FLUSH /DBL_USE_CHEM ${FPROJDEF} ${FPROJVERS} \$(InputPath) | perl ${TOP}\scripts\strip72 -c > Release\\Fort\\\$(InputName).FOR
# End Custom Build
!ELSEIF "\$(CFG)" == "$PROJ - Win32 Debug"
# PROP Ignore_Default_Tool 1
# Begin Custom Build
InputPath=$ffile
InputName=$ifile
"Debug\\Fort\\\$(InputName).FOR" : \$(SOURCE) "\$(INTDIR)" "\$(OUTDIR)"
fpp /m /ansi /nologo $fdirlist /DBL_LANG_FORT /DBL_SPACEDIM=${DIM} /DBL_USE_DOUBLE /DBL_NO_FORT_FLUSH /DBL_USE_CHEM ${FPROJDEF} ${FPROJVERS} \$(InputPath) | perl ${TOP}\scripts\strip72 -c > Debug\\Fort\\\$(InputName).FOR
# End Custom Build
!ENDIF
# End Source File
EOF
done
cat >> $OFILE << EOF
# End Group
EOF
cat >> $OFILE << EOF
# End Target
# End Project
EOF
# Add lf's needed by Windows junk
perl -e 'while(<>) {s/\n/\r\n/;print;}' < $OFILE > junk.$$
mv junk.$$ $OFILE
exit 0
ccseapps-2.5/CCSEApps/scripts/install-sh 0000644 0001750 0001750 00000011244 11634153073 021351 0 ustar amckinstry amckinstry #! /bin/sh
#
# install - install a program, script, or datafile
# This comes from X11R5.
#
# Calling this script install-sh is preferred over install.sh, to prevent
# `make' implicit rules from creating a file called install from it
# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch.
#
# set DOITPROG to echo to test this script
# Don't use :- since 4.3BSD and earlier shells don't like it.
doit="${DOITPROG-}"
# put in absolute paths if you don't have them in your path; or use env. vars.
mvprog="${MVPROG-mv}"
cpprog="${CPPROG-cp}"
chmodprog="${CHMODPROG-chmod}"
chownprog="${CHOWNPROG-chown}"
chgrpprog="${CHGRPPROG-chgrp}"
stripprog="${STRIPPROG-strip}"
rmprog="${RMPROG-rm}"
mkdirprog="${MKDIRPROG-mkdir}"
tranformbasename=""
transform_arg=""
instcmd="$mvprog"
chmodcmd="$chmodprog 0755"
chowncmd=""
chgrpcmd=""
stripcmd=""
rmcmd="$rmprog -f"
mvcmd="$mvprog"
src=""
dst=""
dir_arg=""
while [ x"$1" != x ]; do
case $1 in
-c) instcmd="$cpprog"
shift
continue;;
-d) dir_arg=true
shift
continue;;
-m) chmodcmd="$chmodprog $2"
shift
shift
continue;;
-o) chowncmd="$chownprog $2"
shift
shift
continue;;
-g) chgrpcmd="$chgrpprog $2"
shift
shift
continue;;
-s) stripcmd="$stripprog"
shift
continue;;
-t=*) transformarg=`echo $1 | sed 's/-t=//'`
shift
continue;;
-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
shift
continue;;
*) if [ x"$src" = x ]
then
src=$1
else
# this colon is to work around a 386BSD /bin/sh bug
:
dst=$1
fi
shift
continue;;
esac
done
if [ x"$src" = x ]
then
echo "install: no input file specified"
exit 1
else
true
fi
if [ x"$dir_arg" != x ]; then
dst=$src
src=""
if [ -d $dst ]; then
instcmd=:
else
instcmd=mkdir
fi
else
# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
# might cause directories to be created, which would be especially bad
# if $src (and thus $dsttmp) contains '*'.
if [ -f $src -o -d $src ]
then
true
else
echo "install: $src does not exist"
exit 1
fi
if [ x"$dst" = x ]
then
echo "install: no destination specified"
exit 1
else
true
fi
# If destination is a directory, append the input filename; if your system
# does not like double slashes in filenames, you may need to add some logic
if [ -d $dst ]
then
dst="$dst"/`basename $src`
else
true
fi
fi
## this sed command emulates the dirname command
dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
# Make sure that the destination directory exists.
# this part is taken from Noah Friedman's mkinstalldirs script
# Skip lots of stat calls in the usual case.
if [ ! -d "$dstdir" ]; then
defaultIFS='
'
IFS="${IFS-${defaultIFS}}"
oIFS="${IFS}"
# Some sh's can't handle IFS=/ for some reason.
IFS='%'
set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
IFS="${oIFS}"
pathcomp=''
while [ $# -ne 0 ] ; do
pathcomp="${pathcomp}${1}"
shift
if [ ! -d "${pathcomp}" ] ;
then
$mkdirprog "${pathcomp}"
else
true
fi
pathcomp="${pathcomp}/"
done
fi
if [ x"$dir_arg" != x ]
then
$doit $instcmd $dst &&
if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
else
# If we're going to rename the final executable, determine the name now.
if [ x"$transformarg" = x ]
then
dstfile=`basename $dst`
else
dstfile=`basename $dst $transformbasename |
sed $transformarg`$transformbasename
fi
# don't allow the sed command to completely eliminate the filename
if [ x"$dstfile" = x ]
then
dstfile=`basename $dst`
else
true
fi
# Make a temp file name in the proper directory.
dsttmp=$dstdir/#inst.$$#
# Move or copy the file name to the temp name
$doit $instcmd $src $dsttmp &&
trap "rm -f ${dsttmp}" 0 &&
# and set any options; do chmod last to preserve setuid bits
# If any of these fail, we abort the whole thing. If we want to
# ignore errors from any of these, just make sure not to ignore
# errors from the above "$doit $instcmd $src $dsttmp" command.
if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
# Now rename the file to the real destination.
$doit $rmcmd -f $dstdir/$dstfile &&
$doit $mvcmd $dsttmp $dstdir/$dstfile
fi &&
exit 0
ccseapps-2.5/CCSEApps/scripts/strip72 0000644 0001750 0001750 00000026106 11634153073 020610 0 ustar amckinstry amckinstry #!/usr/local/gnu/bin/perl
# "$Id: strip72,v 1.7 2001/05/18 16:49:24 car Exp $"
# -------------------------------------------------------------------------
# This PERL script will act as a filter for FORTRAN code.
# It will:
# (1) expand tabs on non-comment lines
# (2) replace multiple blank lines with a single blank line
# (3) split lines at or before column 72 and preserve indention
# (4) translate CRAY conditional vector merge statements
# into equivalent if-then-else statements (if requested).
# This will even work on nested conditions vector merge statements.
# (5) translates DUMARR(a) -> a,a_lo,a_hi to be used in
# the summy arguments lists of subroutines, function calls, etc.
# (6) translates DECL(typ,name,n1,n2,...nm) into an array
# declaration. For example:
# DECL(integer,a,nvar)
# is replaced by the lines: (if SDIM = 2)
# integer a_lo(2),a_hi(2)
# integer a(a_lo(1):a_hi(1),a_lo(2):a_hi(2),nvar)
#
# Usage: strip72 [-c] [-s SDIM]
# -c => convert cvmgX to if-then-else statments
# Without -c it will leave cvmgX in code
# -s => use next argument as SPACEDIM, default = 2
# reads from standard input of list of files,
# writes to standard output.
#
# Author: Michael Welcome
# Lawrence Livermore National Laboratory
# Date: 8/26/94
# MODIFY: 8/1/95
# -------------------------------------------------------------------------
# check command line for -c flag
$do_cvmgX = 0;
$debug = 0;
$SDIM = 2;
# read command line options
while ($ARGV[0] =~ /^-/) {
$_ = shift;
if (/^-c/i) {
$do_cvmgX = 1;
} elsif (/^-d/i) {
$debug = 1;
} elsif (/^-s/i) {
$SDIM = shift
} else {
die "invalid argument: $_\n";
}
}
$dash_line = "-" x 50 . "\n";
# look ahead loop: read first line and continue until input is exhausted.
$_ = "\n";
while ($_) {
print $dash_line if $debug;
# gather all continuation lines of statement
# gather all comments in @comment
# replace multiple blank lines with single blank line
$line = $_;
@comments = ();
$nskip = 0;
while (<>) {
# if comment, gather for later printing
# and continue searching for continuation lines
if (/^c/i) {
push(@comments,$_);
next;
}
if (/^[!]/i) {
push(@comments,$_);
next;
}
# if blank line and no previous blank line, save it in @comments
if (/^\s*$/) {
next if $nskip > 0;
push(@comments,"\n");
$nskip++;
next;
}
# skip lines with CPP control characters in first column
next if /^\#/;
# if not a continuation line, drop out of loop
last if !/^ \S/;
# found a continuation line
chop($line);
chop();
# remove continuation statement and leading white space
s/^ \S\s*//;
# collapse other white space
s/\s+/ /g;
# append to current line and add newline char
$line .= $_ . "\n";
}
print "DB: AFTER GATHER : $line" if $debug;
# all continuation lines have been gathered in $line
# search for all occurances of DUMARR(a) and expand to
# "a,a_lo,a_hi"
if ($line =~ /^\s+.*DUMARR/) {
# while ($line =~ /.*DUMARR\s*\(\s*(\w+)\s*\)/) {
while ($line =~ /DUMARR\s*\(\s*(\w+)\s*\)/) {
$args = "$1,$1_lo,$1_hi";
$line = $`.$args.$';
}
}
# now expand tabs
while ($line =~ /(\t)/) {
$_n = index($line,$1); # locaton of tab
$_len = 8 - ($_n % 8); # number of spaces to next tab stop
substr($line,$_n,1) = " " x $_len; # replace with spaces
}
# search line for DECL statement and replace with declarations
if ($line =~ /^\s+DECL\s*\(([^\)]*)/) {
($typ,$aname,@rest) = split(/,/,$1);
$line =~ /^\s*/;
$indent = $&;
$lines[0] = $indent . "integer $aname"."_lo($SDIM), $aname"."_hi($SDIM)\n";
$lines[1] = $indent . "$typ $aname(";
foreach $dim (1 .. $SDIM) {
$lines[1] .= "$aname"."_lo(".$dim."):$aname"."_hi(".$dim.")";
$lines[1] .= "," if $dim < $SDIM;
}
if (@rest > 0) {
$lines[1] .= "," . join(",",@rest);
}
$lines[1] .= ")\n";
} else {
@lines = ($line);
}
# put line in an array of lines
# check for conditional vector merge statement
if ($do_cvmgX && $line =~ /.*=\s*cvmg[pPmMnNzZtT]\s*\(/o) {
# @lines will contain the equivalent if-then-else statement
# with proper indention preserved.
@lines = &expand_cvmgX($line);
}
# if we got here, the line has been split into
# possibly multiple lines by the cvmgX splitter
# now output each line so that each has a length < 72
foreach $ln (@lines) {
if (length($ln) <= 73) {
print $ln;
} else {
&chop_line($ln);
}
}
# now that line is out, print comments that where
# collected in the forward search for continuation lines.
# This preserves the order of comments and code.
foreach $ln (@comments) {
print $ln;
}
}
# -------------------------------------------------------------------
# Subroutine expand_cvmgX
# input is a string containing cvmgX statement
# output is array of strings containing equivalent
# if-then-else statements
# Note, this is a recursive subroutine
# -------------------------------------------------------------------
sub expand_cvmgX {
print "DB: SUB expand_cvmgX with @_[0]" if $debug;
# recursive, so need local variables
local($_line) = @_[0];
local(@args, @out);
# remove newline char
chop($_line);
# get indention string and strip white_space
$_line =~ /^\s*/;
$indent = $&;
$_line =~ s/\s+//g;
# statement looks like =cvmgX(a,b,c), = (a,b,c)
# collect LHS and RHS
$_line =~ /=cvmg/i;
$lhs = $`;
$rhs = $';
$type = substr($rhs,0,1);
# strip off type and outer parens
substr($rhs,0,2) = "";
chop($rhs);
# collect a, b, c searching for comma, matching parens
$len = length($rhs);
$chunk = 0;
@args = ("","","");
$paren = 0;
for ($i=0; $i<$len; $i++) {
# examine ith character in string
$ch = substr($rhs,$i,1);
if (($ch eq ",") && ($paren == 0)) {
# found comma seperator, start gathering next arg
$chunk++;
die "$0 : too many args to cvmg$type\n" if $chunk > 2;
} else {
# gather char, incr or decr paren count
$args[$chunk] .= $ch;
$paren++ if $ch eq "(";
$paren-- if $ch eq ")";
}
}
if ($debug) {
print "LHS = $lhs, TYPE = $type, RHS = $rhs\n";
print "A = $args[0]\n";
print "B = $args[1]\n";
print "C = $args[2]\n";
}
# make sure conditional does not contain a cvmgX statement
if ($args[2] =~ /.*=\s*cvmg[pPmMnNzZtT]\s*\(/) {
die "$0 : cvmg$type in conditional: $args[2]\n";
}
# determine type of conditional vector merge statement, build
# components of conditional statement
$type =~ tr/A-Z/a-z/;
if ($type eq "p") {
$cmp1 = " .ge. 0.0";
$pre2 = "";
$cmp2 = " .lt. 0.0";
} elsif ($type eq "m") {
$cmp1 = " .lt. 0.0";
$pre2 = "";
$cmp2 = " .ge. 0.0";
} elsif ($type eq "n") {
$cmp1 = " .ne. 0.0";
$pre2 = "";
$cmp2 = " .eq. 0.0";
} elsif ($type eq "z") {
$cmp1 = " .eq. 0.0";
$pre2 = "";
$cmp2 = " .ne. 0.0";
} elsif ($type eq "t") {
$cmp1 = "";
$pre2 = " .not. (";
$cmp2 = ")";
} else {
die "$0 : cvmg$type not a conditional vector merge\n";
}
# produce output
# recursively apply translator if statement contains
# another conditional vector merge
if ($lhs eq $args[0]) {
# single branch if statement
$out[0] = $indent . "if (" . $pre2 . $args[2] . $cmp2 . ") then\n";
$out[1] = $indent . " " . $lhs . " = " . $args[1] . "\n";
$out[2] = $indent . "endif\n";
if ($out[1] =~ /.*=\s*cvmg[pPmMnNzZtT]\s*\(/) {
splice(@out,1,1,&expand_cvmgX($out[1]));
}
} elsif ($lhs eq $args[1]) {
# single branch if statement
$out[0] = $indent . "if (" . $args[2] . $cmp1 . ") then\n";
$out[1] = $indent . " " . $lhs . " = " . $args[0] . "\n";
$out[2] = $indent . "endif\n";
if ($out[1] =~ /.*=\s*cvmg[pPmMnNzZtT]\s*\(/) {
splice(@out,1,1,&expand_cvmgX($out[1]));
}
} else {
# double branch if statement
$out[0] = $indent . "if (" . $args[2] . $cmp1 . ") then\n";
$out[1] = $indent . " " . $lhs . " = " . $args[0] . "\n";
$out[2] = $indent . "else\n";
$out[3] = $indent . " " . $lhs . " = " . $args[1] . "\n";
$out[4] = $indent . "endif\n";
if ($out[3] =~ /.*=\s*cvmg[pPmMnNzZtT]\s*\(/) {
splice(@out,3,1,&expand_cvmgX($out[3]));
}
if ($out[1] =~ /.*=\s*cvmg[pPmMnNzZtT]\s*\(/) {
splice(@out,1,1,&expand_cvmgX($out[1]));
}
}
return @out;
}
# -------------------------------------------------------------------
# Subroutine chop_line
# input is a string containing a long line
# side effect is to chop the line into shorter continuation
# lines and write to standard output.
# NOTE: preserves indention of input line
# -------------------------------------------------------------------
sub chop_line {
local($_line) = @_;
print "DB: SUB chop_line with line = $_line" if $debug;
# NOTE: tabs have been expanded at this point
chop($_line);
$_line =~ s/^.{5}\s*//; # find possible label and leading white space
$indent1 = $&; # string containing label and white space
# $indent2 = $&; # string containing continuation and white space
$indent2 = " &"; # hardwire removal of white space : MSD-11-06-98
$i_len = length($indent1); # length of leading white space
# try stripping multiple white space, see if that solves problem
$_line =~ s/\s+/ /g; # replace multiple spaces with single space
if (length($_line) <= 72-$i_len) {
print $indent1, $_line, "\n";
return 1;
}
# if we got here the line is still too long
$mx_len = 72 - $i_len; # num allowed char after indent
$line_no = 0;
$no_split_chars = "'[a-zA-Z0-9_\.]";
while (($_len = length($_line)) > 0) {
# find closest word bndry prior to $l_len and split there
$pos = $_len;
if ($pos >= $mx_len) {
$pos = $mx_len-1;
while ($pos >= 0 && (substr($_line,$pos,1) =~ /$no_split_chars/o)) {
$pos--;
}
}
die "Failed to chop long line. Try adding spaces!!!\n\n==> $_line\n"
if $pos <= 0;
# make header so that it indents correct number of chars
$header = ($line_no == 0 ? $indent1 : $indent2);
# print portion that will fit on this line
print $header , substr($_line,0,$pos+1) , "\n";
# increment line count and remove portion of line that has
# just been printed.
$line_no++;
substr($_line,0,$pos+1) = "";
$mx_len = 70 - $i_len; # num allowed char after indent
}
if ($line_no > 19) {
warn "$0: produced $line_no continuation lines\n";
}
}
ccseapps-2.5/CCSEApps/scripts/mkdep 0000644 0001750 0001750 00000012215 11634153073 020372 0 ustar amckinstry amckinstry #!/usr/bin/perl
# ------------------------------------------------------------------
# Perl script to generate a "make"-style dependency list for a
# C, C++, or FORTRAN source file with CPP include directives.
#
# Usage: mk_dep -DBG [-I]* [-X]* filename ...
# Notes: * -I defines a search path for include files
# * -DBG turn on debug flag
# + -fortran: parse fortran style include directives
# * -X means disgard entries with this path (NOT IMPLEMENTED)
# * searches current directory only if -I. is in search
# path or #include directive uses double quotes rather
# than angle brackets.
# * dependency list is sent to standard output
# * follows all #include directives, even those protected
# by #if and #ifdef directives.
# * ignores include files not found in search path
# * Includes corresponding .C files for .H files including
# template definitions
# * No duplications in dependency list
#
# Author: Michael Welcome
# 4/26/95
# Lawrence Livermore National Laboratory
# ------------------------------------------------------------------
$debug = 0;
@incldir = ("");
$fortran = 0;
# search command line for -I and -X options
while ($ARGV[0] =~ /^-/) {
$_ = shift;
if (/^-I(.+)/) {
die "$1 does not exist\n" if (!-e $1);
die "$1 not a directory\n" if (!-d $1);
die "cannot read $1\n" if (!-r $1);
push(@incldir,("$1/"));
} elsif (/^-X(.+)/) {
die "Sorry, -X option not implemented\n";
push(@excldir,($1));
} elsif (/^-DBG/) {
$debug = 1;
} elsif (/^-fortran/) {
$fortran = 1;
} else {
die "invalid argument: $_\n";
}
}
foreach $ifile (@ARGV) {
print "PARSING FILE: @ARGV\n" if $debug;
die "cannot read $ifile\n" if (!(-e $ifile && -r _));
#define object file
# strip path from filename
($ofile = $ARGV[0]) =~ s#.*/##;
# change suffix to .o
($ofile = $ifile) =~ s/\.[^.\/]*$/.o/;
if ( $fortran ) {
@searchlist = ("$ifile\'");
} else {
@searchlist = ("$ifile\"");
}
%usedfiles = ();
%deptable = ();
$usedfiles{ $ifile } = 1;
while (@searchlist) {
# get next file off search list
$file = shift(@searchlist);
# NOTE: the last char in $file is either a double quote (") or
# a right angle bracket (>). Strip off this character and
# save it. If it is a quote, search current directory first.
# If its a right angle bracket, only search directories
# specified with -I options.
$incltype = chop $file;
# NOTE: if the first char in $file is a "/" indicating an absolute
# path, do not search directory list
$abspath = ($file =~ /^\// ? 1 : 0);
foreach $d (@incldir) {
if ($d ne "" && $abspath) {
# this is an absolute path, dont search current directory
next;
}
if ($d eq "" && $incltype eq ">") {
# dont search current directory
next;
}
$dep = "$d$file";
print "Will search $d for $file:: $dep\n" if $debug;
if (-e $dep) {
# file found, build dependency, enter in table
# print "$ofile: $dep\n";
$deptable{ $dep } = 1;
# grep file for includes and, if not seen before, add
# to end of search list
open(FL,"$dep") || die "cant open $dep\n";
while () {
if (/^\s*#\s*include\s+["<]\s*([^">]+[">])/) {
if ($usedfiles{ $1 }++ == 0) {
print " ::: including ::$1::\n" if $debug;
# this file not searched yet, add to list
# NOTE: last char is either double quote
# or right angle bracket.
push(@searchlist,($1));
}
} elsif ($fortran && /^[ \t]+include\s+'([^']+['])/i) {
if ($usedfiles{ $1 }++ == 0) {
print " ::: inluding ::$1::\n" if $debug;
push(@searchlist,($1));
}
}
}
# if this file is a header (.H) and it includes template
# declarations, add the corresponcing .C file to the
# searchlist.
# Assume the .C file is in the same directory as the .H
if ($file =~ /\S*\.[Hh]$/) {
$Cfile = $file;
$Cfile =~ s/\.H$/\.C/;
$Cfile =~ s/\.h$/\.c/;
print "Found Header file $dep\n" if $debug;
print " . . Corresponding .C file is: $Cfile\n" if $debug;
# position file pointer to beginning of file
seek(FL,0,0);
# search for template declarations
while () {
# search for string "template" not in a comment
s/\/\/.*//;
if (/template/) {
print "$dep contains template\n" if $debug;
print "$_" if $debug;
$inclCfile = $Cfile . $incltype;
if ($usedfiles{ $inclCfile } == 0) {
# print " ::: including ::$inclCfile::\n";
# this file not searched yet, add to list
# NOTE: last char is either double quote
# or right angle bracket.
push(@searchlist,($inclCfile));
}
# mark as used file
$usedfiles{ $inclCfile }++;
# stop searching for tempate
last;
}
}
}
# since file was found in search path, jump out of loop
last;
}
}
# print "@searchlist\n" id $debug;
}
# now generate dependency list
for $dep (keys %deptable) {
print "$ofile: $dep\n";
}
}
ccseapps-2.5/CCSEApps/scripts/compressor 0000644 0001750 0001750 00000003120 11634153073 021461 0 ustar amckinstry amckinstry #!/bin/ksh -p
#
# Prefix's for chk and plt files.
#
pidfile=compressor.pid
chk_prefix=chk
plt_prefix=plt
if [ -f $pidfile ]; then
echo 2>&1 "compressor lock file " $pidfile " already exists"
exit -1
fi
echo $$ > $pidfile
trap '/bin/rm -f $pidfile' EXIT HUP TERM XCPU KILL
#
# Number of seconds to sleep before checking again.
#
N=60
#
# Tar up and then remove plt and chk directories.
#
function tar_up_and_rm_files
{
if [ ! -f $pidfile ]; then
echo "compressor: $pidfile has been removed, exiting"
exit
fi
#
# Take all but the final chk file -- want job chaining to work.
# Strip out any tar files that are lying around.
#
chklist=$(ls -d ${chk_prefix}* 2>/dev/null | grep -v tar)
if [ "$chklist" ]
then
nl=$(echo "$chklist" | wc -l)
nl=$(expr $nl - 1)
if [ $nl -eq 0 ]
then
chklist=""
else
chklist=$(echo "$chklist" | head -$nl)
fi
fi
#
# Take all but the final plt file.
# We want to ensure they're completely written to disk.
# Strip out any tar files that are lying around.
#
pltlist=$(ls -d ${plt_prefix}* 2>/dev/null | grep -v tar)
if [ "$pltlist" ]
then
nl=$(echo "$pltlist" | wc -l)
nl=$(expr $nl - 1)
if [ $nl -eq 0 ]
then
pltlist=""
else
pltlist=$(echo "$pltlist" | head -$nl)
fi
fi
list="$chklist $pltlist"
for dir in ${list}
do
if [ -d ${dir} ]
then
if `tar cf ${dir}.tar ${dir}`
then
rm -rf ${dir}
fi
fi
done
}
#
# Looping waiting for plt and chk directories to appear.
#
while true
do
tar_up_and_rm_files
sleep $N
done
ccseapps-2.5/CCSEApps/pAmrDerive/ 0000755 0001750 0001750 00000000000 11634153073 017715 5 ustar amckinstry amckinstry ccseapps-2.5/CCSEApps/pAmrDerive/Make.package 0000644 0001750 0001750 00000000716 11634153073 022113 0 ustar amckinstry amckinstry CEXE_headers += DataServices.H AmrData.H XYPlotDataList.H AmrvisConstants.H
CEXE_sources += DataServices.cpp AmrData.cpp XYPlotDataList.cpp
ifeq ($(DIM),3)
FEXE_sources += DERIVE_3D.F FABUTIL_3D.F
else
FEXE_sources += DERIVE_2D.F FABUTIL_2D.F COORDSYS_2D.F
endif
ifeq ($(EBASE), AmrDeriveQuench)
include $(CHEMDIR)/Make.package
endif
ifeq ($(EBASE), AmrDeriveIntScalLen)
FEXE_headers += AmrDeriveIntScalLen_F.H
FEXE_sources += AmrDeriveIntScalLen_3D.F
endif
ccseapps-2.5/CCSEApps/pAmrDerive/AmrDerivePeriodicFab.cpp 0000644 0001750 0001750 00000012776 11634153073 024404 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
// ----------------------------------------------------------------------
// AmrDerivePeriodicFab.cpp
// ----------------------------------------------------------------------
#include
#include
#include
#include
#include
#include "REAL.H"
#include "Box.H"
#include "FArrayBox.H"
#include "ParmParse.H"
#include "ParallelDescriptor.H"
#include "Utility.H"
const int XDIR = 0;
const int YDIR = 1;
#if (BL_SPACEDIM == 3)
const int ZDIR = 2;
#endif
#define SHOWVAL(val) { \
cout << #val << " = " << val << '\n'; }
void PrintUsage(char *progName);
// ----------------------------------------------------------------------
int main(int argc, char *argv[]) {
if(argc == 1) {
PrintUsage(argv[0]);
}
ParmParse pp(argc-1,argv+1);
FArrayBox::setFormat(FABio::FAB_IEEE_32);
std::string iFile;
std::string oFile;
pp.get("infile", iFile);
pp.get("outfile", oFile);
SHOWVAL(iFile)
SHOWVAL(oFile)
ifstream inFabStream(iFile.c_str());
FArrayBox inFab(inFabStream);
SHOWVAL(inFab.box());
inFabStream.close();
Box grownBox(inFab.box());
bool bPerX(false), bPerY(false), bPerZ(false);
int nPerX(0), nPerY(0), nPerZ(0);
if(pp.contains("perx")) {
bPerX = true;
pp.query("perx", nPerX);
grownBox.growHi(XDIR, inFab.box().length(XDIR) * nPerX);
}
if(pp.contains("pery")) {
bPerY = true;
pp.query("pery", nPerY);
grownBox.growHi(YDIR, inFab.box().length(YDIR) * nPerY);
}
#if (BL_SPACEDIM == 3)
if(pp.contains("perz")) {
bPerZ = true;
pp.query("perz", nPerZ);
grownBox.growHi(ZDIR, inFab.box().length(ZDIR) * nPerZ);
}
#endif
SHOWVAL(grownBox);
FArrayBox grownFab(grownBox, inFab.nComp());
Box progressiveGrownBox(inFab.box());
int srcComp(0), destComp(0), nComps(inFab.nComp());
grownFab.copy(inFab, inFab.box());
if(bPerX) {
Box srcBox(progressiveGrownBox);
SHOWVAL(progressiveGrownBox);
for(int nShifts(1); nShifts <= nPerX; ++nShifts) { // start at 1
progressiveGrownBox.shift(XDIR, inFab.box().length(XDIR) * nShifts);
cout << "----- shifted: "; SHOWVAL(progressiveGrownBox);
cout << "----- copying from: "; SHOWVAL(srcBox);
cout << "----- copying to: "; SHOWVAL(progressiveGrownBox);
grownFab.copy(grownFab, srcBox, srcComp,
progressiveGrownBox, destComp, nComps);
progressiveGrownBox.shift(XDIR, -inFab.box().length(XDIR) * nShifts);
cout << "----- unshifted: "; SHOWVAL(progressiveGrownBox);
}
progressiveGrownBox.growHi(XDIR, inFab.box().length(XDIR) * nPerX);
}
if(bPerY) {
Box srcBox(progressiveGrownBox);
for(int nShifts(1); nShifts <= nPerY; ++nShifts) { // start at 1
progressiveGrownBox.shift(YDIR, inFab.box().length(YDIR) * nShifts);
grownFab.copy(grownFab, srcBox, srcComp,
progressiveGrownBox, destComp, nComps);
progressiveGrownBox.shift(YDIR, -inFab.box().length(YDIR) * nShifts);
}
progressiveGrownBox.growHi(YDIR, inFab.box().length(YDIR) * nPerY);
}
#if (BL_SPACEDIM == 3)
if(bPerZ) {
Box srcBox(progressiveGrownBox);
for(int nShifts(1); nShifts <= nPerZ; ++nShifts) { // start at 1
progressiveGrownBox.shift(ZDIR, inFab.box().length(ZDIR) * nShifts);
grownFab.copy(grownFab, srcBox, srcComp,
progressiveGrownBox, destComp, nComps);
progressiveGrownBox.shift(ZDIR, -inFab.box().length(ZDIR) * nShifts);
}
progressiveGrownBox.growHi(ZDIR, inFab.box().length(ZDIR) * nPerZ);
}
#endif
ofstream outFabStream(oFile.c_str());
grownFab.writeOn(outFabStream);
outFabStream.close();
}
// ----------------------------------------------------------------------
void PrintUsage(char *progName) {
cout << '\n';
cout << "Usage:" << '\n';
cout << progName << '\n';
cout << " infile = inputFileName" << '\n';
cout << " outfile = outputFileName" << '\n';
cout << " [perx = nTimes]" << '\n';
cout << " [pery = nTimes]" << '\n';
cout << " [perz = nTimes]" << '\n';
cout << '\n';
exit(-1);
}
// ----------------------------------------------------------------------
// ----------------------------------------------------------------------
ccseapps-2.5/CCSEApps/pAmrDerive/AmrDeriveYIntegrals.cpp 0000644 0001750 0001750 00000012505 11634153073 024304 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// This is another version of AmrDerive.cpp that calculates integrals of
// quantities and writes out scalars instead of plotfiles.
//
// currently hardcoded for sum_rhoYO2 (quantity 6)
// and sum_rhoYC2H2 (quantity 9)
//
// i'll update it to allow user input of quantity number. v.
//
#include
#include
#include
#include
using std::set_new_handler;
#include
#include "REAL.H"
#include "Box.H"
#include "FArrayBox.H"
#include "ParmParse.H"
#include "ParallelDescriptor.H"
#include "DataServices.H"
#include "Utility.H"
#include "VisMF.H"
#include "Derived.H"
static
void
PrintUsage (char* progName)
{
cout << "\nUsage:\n"
<< progName
<< "\n\tinfile = inputFileName"
<< "\n\t[-help]"
<< "\n\n";
exit(1);
}
static
Real
SumMass (AmrData& amrData, const int compNumber)
{
Real sum = 0;
//
// The component number of density in MultiFab.
//
const int ncomp = compNumber;
int finest_level = amrData.FinestLevel();
FArrayBox fab;
for (int iLevel = 0; iLevel <= finest_level; ++iLevel)
{
const Real* dx = amrData.DxLevel()[iLevel].dataPtr();
MultiFabIterator ntmfi(amrData.GetGrids(iLevel, ncomp));
for ( ; ntmfi.isValid(); ++ntmfi)
{
//
// Make copy of FAB so that we can change it.
//
fab.resize(ntmfi.fabbox(), 1);
//fab.copy(ntmfi(), ncomp, 0, 1);
fab.copy(ntmfi(), 0, 0, 1);
if (iLevel < finest_level)
{
const BoxArray& f_box = amrData.boxArray(iLevel+1);
for (int j = 0; j < f_box.length(); j++)
{
Box c_box = ::coarsen(f_box[j],amrData.RefRatio()[iLevel]);
c_box &= ntmfi.validbox();
if (c_box.ok())
fab.setVal(0.0, c_box, 0);
}
}
Real s;
const Real* dat = fab.dataPtr();
const int* dlo = fab.loVect();
const int* dhi = fab.hiVect();
const int* lo = ntmfi.validbox().loVect();
const int* hi = ntmfi.validbox().hiVect();
int nz = hi[1]-lo[1]+1;
Array tmp(nz);
FORT_SUMMASS(dat,ARLIM(dlo),ARLIM(dhi),ARLIM(lo),ARLIM(hi),
dx,&s,tmp.dataPtr());
sum += s;
}
}
ParallelDescriptor::ReduceRealSum(sum);
return sum;
}
int
main (int argc,
char* argv[])
{
//
// Make sure to catch new failures.
//
set_new_handler(Utility::OutOfMemory);
if (argc == 1)
PrintUsage(argv[0]);
//int iLevel;
ParallelDescriptor::StartParallel(&argc, &argv);
ParmParse pp(argc-1,argv+1);
if (pp.contains("help"))
PrintUsage(argv[0]);
FArrayBox::setFormat(FABio::FAB_IEEE_32);
//
// Set default info.
//
Real gam = 1.667;
FORT_SETGAMMA(&gam);
//
// Scan the arguments.
//
aString iFile;
pp.query("infile", iFile);
if (iFile.isNull())
BoxLib::Abort("You must specify `infile'");
DataServices::SetBatchMode();
FileType fileType(NEWPLT);
DataServices dataServices(iFile, fileType);
if ( ! dataServices.AmrDataOk())
{
//
// This calls ParallelDescriptor::EndParallel() and exit()
//
DataServices::Dispatch(DataServices::ExitRequest, NULL);
}
AmrData& amrData = dataServices.AmrDataRef();
BL_ASSERT(amrData.NComp() == NSTATECOMPS);
Real sum_rhoYO2 = SumMass(amrData, 6);
Real sum_rhoYC2H2 = SumMass(amrData, 9);
if (ParallelDescriptor::IOProcessor())
{
const Array& size = amrData.ProbSize();
Real volume = D_TERM(size[0],*size[1],*size[2]);
BL_ASSERT(volume > 0);
cout << "time = " << amrData.Time()
<< " sum_rhoYO2 = " << sum_rhoYO2
<< " sum_rhoYC2H2 = " << sum_rhoYC2H2
<< endl;
}
DataServices::Dispatch(DataServices::ExitRequest, NULL);
}
ccseapps-2.5/CCSEApps/pAmrDerive/AmrDeriveStochTD.cpp 0000644 0001750 0001750 00000200764 11634153073 023541 0 ustar amckinstry amckinstry /*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy. Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov. NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly. Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/
//
// $Id: AmrDeriveStochTD.cpp,v 1.27 2002/08/16 18:59:11 lijewski Exp $
//
// This is the time-dependent version that reads input from PlotFiles.
//
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#ifndef WIN32
#include
#endif
#include "REAL.H"
#include "Box.H"
#include "FArrayBox.H"
#include "ParmParse.H"
#include "ParallelDescriptor.H"
#include "DataServices.H"
#include "Utility.H"
#include "VisMF.H"
#include "Derived.H"
#include "Tuple.H"
#include "Profiler.H"
#include "Thread.H"
#include "WorkQueue.H"
#include "ChemKinDriver.H"
#include "Geometry.H"
#include "xtra_F.H"
//
// This MUST be defined if don't have pubsetbuf() in I/O Streams Library.
//
#ifdef BL_USE_SETBUF
#define pubsetbuf setbuf
#endif
//
// ParmParse'd arguments ...
//
static bool build_prob_dist = false;
static bool calc_lambda_max = false;
static bool do_not_write_trajs = false;
static bool do_not_write_events = false;
static bool write_intermediate_plotfiles = false;
static int seed = 12345;
static int init_spec;
static int n_particles;
D_TERM(static Real init_x = .0000125;,
static Real init_y = .0000125;,
static Real init_z = .0000125;);
static Real dt = .00001;
static Real dt_spec = -1;
static Real stop_time = 0;
static Real strt_time = 0;
static Real conc_epsilon = 1.0e-10;
static Real chem_limiter = 0.1;
static std::string TrajFile;
static std::string EventFile;
static std::string EdgeDataFile;
static std::string chemInFile;
static std::string chemOutFile;
static std::string thermInFile;
static std::string tranInFile;
static std::string TraceElement;
static std::string InitialSpecies;
static Array TimeSteps;
static Array PlotFiles;
//
// Stuff we set from the AmrData object after reading PlotFile.
//
static int is_rz;
static int finest_level;
static Array ref_ratio;
static Array prob_lo;
static Array prob_hi;
static Array prob_domain;
static Array geom;
static Array< Array > dx;
static Array< Array > dxinv;
D_TERM(static PArray A_mf(PArrayManage);,
static PArray C_mf(PArrayManage);,
static PArray E_mf(PArrayManage););
D_TERM(static PArray B_mf(PArrayManage);,
static PArray D_mf(PArrayManage);,
static PArray F_mf(PArrayManage););
static PArray U_mf(PArrayManage);
static PArray Rf_mf(PArrayManage);
static PArray Rr_mf(PArrayManage);
static PArray Conc_mf(PArrayManage);
static PArray Prob_mf(PArrayManage);
//
// Other global data.
//
static Array pedges;
static std::vector edgedata;
static Array< Array > AccumProb;
//
// Particles on our trajectory (includes time) ...
//
typedef Tuple PartPos;
//
// Position in space.
//
typedef Tuple X;
static
void
ScanArguments ()
{
ParmParse pp;
pp.query("dt", dt);
BL_ASSERT(dt != 0);
pp.query("dt_spec", dt_spec);
pp.query("strt_time", strt_time);
pp.query("stop_time", stop_time);
BL_ASSERT(stop_time > 0);
BL_ASSERT(strt_time >= 0);
BL_ASSERT(stop_time > strt_time);
BL_ASSERT(dt_spec != 0);
pp.query("seed", seed);
pp.query("edgedatafile", EdgeDataFile);
if (EdgeDataFile.empty())
BoxLib::Abort("You must specify `edgedatafile'");
pp.query("event_file", EventFile);
if (EventFile.empty())
BoxLib::Abort("You must specify `event_file'");
pp.query("traj_file", TrajFile);
if (TrajFile.empty())
BoxLib::Abort("You must specify `traj_file'");
if (pp.contains("plot_files"))
{
PlotFiles.resize(pp.countval("plot_files"));
for (int i = 0; i < PlotFiles.size(); i++)
pp.get("plot_files", PlotFiles[i], i);
//
// Calculate TimeSteps.
//
TimeSteps.resize(PlotFiles.size());
for (int i = 0; i < TimeSteps.size()-1; i++)
{
DataServices::SetBatchMode();
FileType fileType(NEWPLT);
DataServices dataServices(PlotFiles[i+1], fileType);
if (!dataServices.AmrDataOk())
//
// This calls ParallelDescriptor::EndParallel() and exit()
//
DataServices::Dispatch(DataServices::ExitRequest, NULL);
TimeSteps[i] = dataServices.AmrDataRef().Time();
}
TimeSteps[TimeSteps.size()-1] = stop_time;
for (int i = TimeSteps.size()-1; i > 0; i--)
BL_ASSERT(TimeSteps[i-1] < TimeSteps[i]);
}
BL_ASSERT(PlotFiles.size() > 0);
BL_ASSERT(TimeSteps.size() > 0);
BL_ASSERT(strt_time < TimeSteps[0]);
BL_ASSERT(TimeSteps.size() == PlotFiles.size());
pp.query("chem_infile", chemInFile);
if (chemInFile.empty())
BoxLib::Abort("You must specify `chem_infile'");
pp.query("chem_outfile", chemOutFile);
if (chemOutFile.empty())
BoxLib::Abort("You must specify `chem_outfile'");
pp.query("therm_infile", thermInFile);
if (thermInFile.empty())
BoxLib::Abort("You must specify `therm_infile'");
pp.query("tran_infile", tranInFile);
if (tranInFile.empty())
BoxLib::Abort("You must specify `tran_infile'");
pp.query("trace_element", TraceElement);
if (TraceElement.empty())
BoxLib::Abort("You must specify `trace_element'");
//
// Append `.seed=N' to EventFile & TrajFile
//
char buf[12];
TrajFile += ".seed="; EventFile += ".seed=";
sprintf(buf, "%d", seed);
TrajFile += buf; EventFile += buf;
pp.query("calc_lambda_max", calc_lambda_max);
pp.query("do_not_write_events", do_not_write_events);
pp.query("do_not_write_trajs", do_not_write_trajs);
pp.query("write_intermediate_plotfiles", write_intermediate_plotfiles);
pp.query("conc_epsilon", conc_epsilon);
pp.query("chem_limiter", chem_limiter);
BL_ASSERT(conc_epsilon > 0);
BL_ASSERT(chem_limiter > 0);
D_TERM(pp.query("init_x", init_x);,
pp.query("init_y", init_y);,
pp.query("init_z", init_z););
pp.query("initial_species", InitialSpecies);
pp.query("n_particles", n_particles);
BL_ASSERT(n_particles > 0);
pp.query("build_prob_dist", build_prob_dist);
if (ParallelDescriptor::IOProcessor())
{
std::cout << "dt = " << dt << '\n';
std::cout << "dt_spec = " << dt_spec << '\n';
std::cout << "strt_time = " << strt_time << '\n';
std::cout << "stop_time = " << stop_time << '\n';
std::cout << "seed = " << seed << '\n';
std::cout << "edgedatafile = " << EdgeDataFile << '\n';
std::cout << "plot_files =";
for (int i = 0; i < PlotFiles.size(); i++)
std::cout << ' ' << PlotFiles[i];
std::cout << std::endl;
std::cout << "time_steps =";
for (int i = 0; i < TimeSteps.size(); i++)
std::cout << ' ' << TimeSteps[i];
std::cout << std::endl;
std::cout << "traj_file = " << TrajFile << '\n';
std::cout << "event_file = " << EventFile << '\n';
std::cout << "chem_infile = " << chemInFile << '\n';
std::cout << "chem_outfile = " << chemOutFile << '\n';
std::cout << "therm_infile = " << thermInFile << '\n';
std::cout << "tran_infile = " << tranInFile << '\n';
std::cout << "trace_element = " << TraceElement << '\n';
if (calc_lambda_max)
std::cout << "calc_lambda_max = true" << '\n';
if (do_not_write_events)
std::cout << "do_not_write_events = true" << '\n';
if (do_not_write_trajs)
std::cout << "do_not_write_trajs = true" << '\n';
if (write_intermediate_plotfiles)
std::cout << "write_intermediate_plotfiles = true" << '\n';
std::cout << "Using conc_epsilon = " << conc_epsilon << '\n';
std::cout << "Using chem_limiter = " << chem_limiter << '\n';
D_TERM(std::cout << "init_x = " << init_x << '\n';,
std::cout << "init_y = " << init_y << '\n';,
std::cout << "init_z = " << init_z << '\n';);
std::cout << "initial_species = " << InitialSpecies << '\n';
std::cout << "n_particles = " << n_particles << '\n';
std::cout << "build_prob_dist = " << build_prob_dist << '\n';
}
}
static
void
PrintUsage (char* progName)
{
if (ParallelDescriptor::IOProcessor())
std::cout << "Usage: " << progName << " inputfile" << '\n';
exit(1);
}
static
Real
FFF (Real s)
{
const Real R1 = .007;
const Real R2 = .014;
const Real A = (R2*R2-R1*R1)/(4*std::log(R1/R2));
const Real B = (R1*R1*log(R2)-R2*R2*log(R1))/(4*log(R1/R2));
Real result = 8 * A * std::log(s);
s *= s;
result += (s + 8*B -4*A);
result *= s/16;
return result;
}
static Real LookupTable[1001];
static
void
BuildLookupTable ()
{
const Real R1 = .007;
const Real R2 = .014;
const Real Dx = .001*(R2-R1);
const Real FFFR1 = FFF(R1);
const Real FFFR2 = FFF(R2);
for (int i = 0; i < 1001; i++)
{
Real s = R1+i*Dx;
LookupTable[i] = (FFF(s)-FFFR1)/(FFFR2-FFFR1);
}
}
static
Real
RandomXPos (BoxLib::mt19937& rand)
{
const Real Rn = rand.d1_value();
const Real Rf = .006;
#if 1
//
// Carbon stuff.
//
return Rf * sqrt(1-sqrt(1-Rn));
#else
//
// Nitrogen stuff.
//
const Real Ratio1 = 220.0/3380.0;
const Real Ratio2 = 3160.0/3380.0;
const Real R1 = .007;
const Real R2 = .014;
const Real Dx = .001*(R2-R1);
if (Rn < Ratio1)
{
return Rf * sqrt(1-sqrt(1-Rn/Ratio1));
}
else
{
Real x = (Rn-Ratio1)/Ratio2;
int i = 0;
for ( ; i < 1000; i++)
if (x < LookupTable[i])
break;
return R1+(i-1+(x-LookupTable[i-1])/(LookupTable[i]-LookupTable[i-1]))*Dx;
}
#endif
}
static
void
ReadEdgeData ()
{
BL_ASSERT(!EdgeDataFile.empty());
if (ParallelDescriptor::IOProcessor())
std::cout << "Reading edgefile ... " << std::endl;
std::ifstream ifs;
ifs.open(EdgeDataFile.c_str(), std::ios::in);
if (!ifs.good()) BoxLib::FileOpenFailed(EdgeDataFile);
int N, cnt, tmp;
ifs >> N;
BL_ASSERT(N > 0);
pedges.resize(N);
if (ParallelDescriptor::IOProcessor())
std::cout << "N = " << N << '\n';
for (int i = 0; i < N; i++)
{
ifs >> cnt;
BL_ASSERT(cnt > 0);
pedges[i] = edgedata.size();
edgedata.push_back(cnt);
for (int j = 0; j < 4*cnt; j++)
{
ifs >> tmp;
edgedata.push_back(tmp);
}
}
if (!ifs.good()) BoxLib::Abort("Failure reading EdgeData file");
if (ParallelDescriptor::IOProcessor())
{
std::cout << "EdgeData on startup:\n";
for (int i = 0; i < pedges.size(); i++)
{
int cnt = edgedata[pedges[i]];
std::cout << cnt << ' ';
for (int j = 1; j <= 4*cnt; j++)
std::cout << edgedata[pedges[i]+j] << ' ';
std::cout << '\n';
}
}
}
static
void
TwiddleConc (PArray& conc)
{
std::cout << "Twiddling concentration ... " << std::endl;
//
// First normalize it.
//
for (int ispec = 0; ispec < conc[0].nComp(); ispec++)
{
Real c_floor = 0;
for (int lev = 0; lev < conc.size(); lev++)
{
for (MFIter mfi(conc[lev]); mfi.isValid(); ++mfi)
{
const Box& vb = mfi.validbox();
c_floor = std::max(c_floor,conc[lev][mfi].max(vb,ispec)*conc_epsilon);
}
}
if (ParallelDescriptor::IOProcessor())
{
std::cout << "c_floor(" << ispec << "): " << c_floor << std::endl;
}
for (int lev = 0; lev < conc.size(); lev++)
{
for (MFIter mfi(conc[lev]); mfi.isValid(); ++mfi)
{
const long N = conc[lev][mfi].box().numPts();
Real* data = conc[lev][mfi].dataPtr(ispec);
for (long i = 0; i < N; i++)
{
data[i] = std::max(data[i],c_floor);
}
}
}
}
std::cout << "Done twiddling concentration. " << std::endl;
}
static
void
MassageConc ()
{
std::cout << "Massaging concentration ... " << std::endl;
//
// We've already been Twiddle()d.
// We invert it so we can multiply by it instead of divide.
//
for (int lev = 0; lev < Conc_mf.size(); lev++)
{
for (MFIter mfi(Conc_mf[lev]); mfi.isValid(); ++mfi)
{
Conc_mf[lev][mfi].invert(1.0);
}
}
//
// We now set those cells covered by fine grid to zero.
// This simplified some of our algorithms.
//
const int Ncomp = Conc_mf[0].nComp();
for (int l = 0; l <= finest_level; l++)
{
for (MFIter mfi(Conc_mf[l]); mfi.isValid(); ++mfi)
{
if (l < finest_level)
{
const BoxArray& f_ba = Conc_mf[l+1].boxArray();
for (int j = 0; j < f_ba.size(); j++)
{
Box c_box = BoxLib::coarsen(f_ba[j],ref_ratio[l]);
if (c_box.intersects(Conc_mf[l][mfi].box()))
{
Box isect = c_box & Conc_mf[l][mfi].box();
Conc_mf[l][mfi].setVal(0,isect,0,Ncomp);
}
}
}
}
}
std::cout << "Done massaging concentration. " << std::endl;
}
static
void
Twiddle_DiffCoeffs ()
{
//
// B = A + B; C = A + B + C; D = A + B + C + D; ...
//
for (int l = 0; l <= finest_level; l++)
{
for (MFIter mfi(A_mf[l]); mfi.isValid(); ++mfi)
{
B_mf[l][mfi] += A_mf[l][mfi];
C_mf[l][mfi] += B_mf[l][mfi];
D_mf[l][mfi] += C_mf[l][mfi];
#if BL_SPACEDIM==3
E_mf[l][mfi] += D_mf[l][mfi];
F_mf[l][mfi] += E_mf[l][mfi];
#endif
}
}
}
static
void
ClonePlotfile (AmrData& amrData,
PArray& mfout,
std::string& oFile,
const Array& names)
{
//
// Sink up grow cells under valid region.
//
for (int i = 0; i < mfout.size(); i++)
mfout[i].FillBoundary();
if (ParallelDescriptor::IOProcessor())
if (!BoxLib::UtilCreateDirectory(oFile,0755))
BoxLib::CreateDirectoryFailed(oFile);
//
// Force other processors to wait till directory is built.
//
ParallelDescriptor::Barrier();
std::string oFileHeader(oFile);
oFileHeader += "/Header";
VisMF::IO_Buffer io_buffer(VisMF::IO_Buffer_Size);
std::ofstream os;
os.rdbuf()->pubsetbuf(io_buffer.dataPtr(), io_buffer.size());
if (ParallelDescriptor::IOProcessor())
std::cout << "Opening file = " << oFileHeader << '\n';
os.open(oFileHeader.c_str(), std::ios::out|std::ios::binary);
if (os.fail()) BoxLib::FileOpenFailed(oFileHeader);
//
// Start writing plotfile.
//
os << amrData.PlotFileVersion() << '\n';
int n_var = mfout[0].nComp();
os << n_var << '\n';
for (int n = 0; n < n_var; n++) os << names[n] << '\n';
os << BL_SPACEDIM << '\n';
os << amrData.Time() << '\n';
const int finestLevel = mfout.size() - 1;
os << finestLevel << '\n';
for (int i = 0; i < BL_SPACEDIM; i++) os << amrData.ProbLo()[i] << ' ';
os << '\n';
for (int i = 0; i < BL_SPACEDIM; i++) os << amrData.ProbHi()[i] << ' ';
os << '\n';
for (int i = 0; i < finestLevel; i++) os << amrData.RefRatio()[i] << ' ';
os << '\n';
for (int i = 0; i <= finestLevel; i++) os << amrData.ProbDomain()[i] << ' ';
os << '\n';
for (int i = 0; i <= finestLevel; i++) os << 0 << ' ';
os << '\n';
for (int i = 0; i <= finestLevel; i++)
{
for (int k = 0; k < BL_SPACEDIM; k++)
os << amrData.DxLevel()[i][k] << ' ';
os << '\n';
}
os << amrData.CoordSys() << '\n';
os << "0\n"; // The bndry data width.
//
// Write out level by level.
//
for (int iLevel = 0; iLevel <= finestLevel; ++iLevel)
{
//
// Write state data.
//
int nGrids = amrData.boxArray(iLevel).size();
char buf[64];
sprintf(buf, "Level_%d", iLevel);
if (ParallelDescriptor::IOProcessor())
{
os << iLevel << ' ' << nGrids << ' ' << amrData.Time() << '\n';
os << 0 << '\n';
for (int i = 0; i < nGrids; ++i)
{
for (int n = 0; n < BL_SPACEDIM; n++)
{
os << amrData.GridLocLo()[iLevel][i][n]
<< ' '
<< amrData.GridLocHi()[iLevel][i][n]
<< '\n';
}
}
//
// Build the directory to hold the MultiFabs at this level.
//
std::string Level(oFile);
Level += '/';
Level += buf;
if (!BoxLib::UtilCreateDirectory(Level, 0755))
BoxLib::CreateDirectoryFailed(Level);
}
//
// Force other processors to wait till directory is built.
//
ParallelDescriptor::Barrier();
//
// Now build the full relative pathname of the MultiFab.
//
static const std::string MultiFabBaseName("/MultiFab");
std::string PathName(oFile);
PathName += '/';
PathName += buf;
PathName += MultiFabBaseName;
if (ParallelDescriptor::IOProcessor())
{
//
// The full name relative to the Header file.
//
std::string RelativePathName(buf);
RelativePathName += MultiFabBaseName;
os << RelativePathName << '\n';
}
//
// Write out ghost cells as is ...
//
VisMF::Write(mfout[iLevel], PathName, VisMF::OneFilePerCPU, false);
}
os.close();
}
static
std::vector
Tokenize (const std::string& str,
const std::string& sep)
{
std::vector ptr;
//
// Make copy of line that we can modify.
//
char* line = new char[str.size()+1];
(void) strcpy(line, str.c_str());
char* token = 0;
if (!((token = strtok(line, sep.c_str())) == 0))
{
ptr.push_back(token);
while (!((token = strtok(0, sep.c_str())) == 0))
ptr.push_back(token);
}
vector