diff --git a/Exec/AMR-density/64sssss_20mpc.nyx b/Exec/AMR-density/64sssss_20mpc.nyx new file mode 120000 index 00000000..3c7b0271 --- /dev/null +++ b/Exec/AMR-density/64sssss_20mpc.nyx @@ -0,0 +1 @@ +../LyA/64sssss_20mpc.nyx \ No newline at end of file diff --git a/Exec/AMR-density/GNUmakefile b/Exec/AMR-density/GNUmakefile new file mode 100644 index 00000000..53a57329 --- /dev/null +++ b/Exec/AMR-density/GNUmakefile @@ -0,0 +1,40 @@ +# AMREX_HOME defines the directory in which we will find all the AMReX code +AMREX_HOME ?= ../../../amrex + +HPGMG_DIR ?= ../../Util/hpgmg/finite-volume +CVODE_LIB_DIR ?= $(CVODE_LIB) + +# TOP defines the directory in which we will find Source, Exec, etc +TOP = ../.. + +# compilation options +COMP = intel # gnu +USE_MPI = FALSE +USE_OMP = FALSE + +PROFILE = TRUE +TRACE_PROFILE = FALSE +COMM_PROFILE = FALSE +TINY_PROFILE = FALSE + +PRECISION = DOUBLE +USE_SINGLE_PRECISION_PARTICLES = TRUE +DEBUG = FALSE + +GIMLET = FALSE +REEBER = FALSE + +USE_HPGMG = FALSE + +# physics +DIM = 3 +USE_GRAV = TRUE +USE_HEATCOOL = TRUE +USE_AGN = FALSE +USE_CVODE = FALSE + +Bpack := ./Make.package +Blocs := . + +include $(TOP)/Exec/Make.Nyx + diff --git a/Exec/AMR-density/Make.package b/Exec/AMR-density/Make.package new file mode 100644 index 00000000..13af1531 --- /dev/null +++ b/Exec/AMR-density/Make.package @@ -0,0 +1,2 @@ +f90EXE_sources += Prob_${DIM}d.f90 +f90EXE_sources += probdata.f90 diff --git a/Exec/AMR-density/Nyx_error.cpp b/Exec/AMR-density/Nyx_error.cpp new file mode 100644 index 00000000..723fb724 --- /dev/null +++ b/Exec/AMR-density/Nyx_error.cpp @@ -0,0 +1,18 @@ + +#include "Nyx.H" +#include "Nyx_error_F.H" + +using namespace amrex; + +void +Nyx::error_setup() +{ + err_list.add("total_density",1,ErrorRec::UseAverage, + BL_FORT_PROC_CALL(TAG_OVERDENSITY, tag_overdensity)); +} + +void +Nyx::manual_tags_placement (TagBoxArray& tags, + const Vector& bf_lev) +{ +} diff --git a/Exec/AMR-density/Prob_3d.f90 b/Exec/AMR-density/Prob_3d.f90 new file mode 100644 index 00000000..2e82541f --- /dev/null +++ b/Exec/AMR-density/Prob_3d.f90 @@ -0,0 +1,132 @@ + + subroutine amrex_probinit (init,name,namlen,problo,probhi) bind(c) + + use amrex_fort_module, only : rt => amrex_real + use probdata_module + implicit none + + integer init, namlen + integer name(namlen) + real(rt) problo(3), probhi(3) + + integer untin,i + + namelist /fortin/ max_num_part + +! +! Build "probin" filename -- the name of file containing fortin namelist. +! + integer maxlen + parameter (maxlen=256) + character probin*(maxlen) + + if (namlen .gt. maxlen) then + write(6,*) 'probin file name too long' + stop + end if + + do i = 1, namlen + probin(i:i) = char(name(i)) + end do + +! Read namelists + untin = 9 + open(untin,file=probin(1:namlen),form='formatted',status='old') + read(untin,fortin) + close(unit=untin) + + end + +! ::: ----------------------------------------------------------- +! ::: This routine is called at problem setup time and is used +! ::: to initialize data on each grid. +! ::: +! ::: NOTE: all arrays have one cell of ghost zones surrounding +! ::: the grid interior. Values in these cells need not +! ::: be set here. +! ::: +! ::: INPUTS/OUTPUTS: +! ::: +! ::: level => amr level of grid +! ::: time => time at which to init data +! ::: lo,hi => index limits of grid interior (cell centered) +! ::: nstate => number of state components. You should know +! ::: this already! +! ::: state <= Scalar array +! ::: delta => cell size +! ::: xlo,xhi => physical locations of lower left and upper +! ::: right hand corner of grid. (does not include +! ::: ghost region). +! ::: ----------------------------------------------------------- + subroutine fort_initdata(level,time,lo,hi, & + ns, state ,s_l1,s_l2,s_l3,s_h1,s_h2,s_h3, & + nd, diag_eos,d_l1,d_l2,d_l3,d_h1,d_h2,d_h3, & + delta,xlo,xhi) & + bind(C, name="fort_initdata") + + use amrex_fort_module, only : rt => amrex_real + use amrex_parmparse_module + use probdata_module + use atomic_rates_module, only : XHYDROGEN + use meth_params_module, only : URHO, UMX, UMZ, UEDEN, UEINT, UFS, & + small_dens, TEMP_COMP, NE_COMP, ZHI_COMP + + implicit none + + integer level, ns, nd + integer lo(3), hi(3) + integer s_l1,s_l2,s_l3,s_h1,s_h2,s_h3 + integer d_l1,d_l2,d_l3,d_h1,d_h2,d_h3 + real(rt) xlo(3), xhi(3), time, delta(3) + real(rt) state(s_l1:s_h1,s_l2:s_h2,s_l3:s_h3,ns) + real(rt) diag_eos(d_l1:d_h1,d_l2:d_h2,d_l3:d_h3,nd) + + integer i,j,k + real(rt) z_in + + type(amrex_parmparse) :: pp + + call amrex_parmparse_build(pp, "nyx") + call pp%query("initial_z", z_in) + call amrex_parmparse_destroy(pp) + + ! This is the case where we have compiled with states defined + ! but they have only one component each so we fill them this way. + if (ns.eq.1 .and. nd.eq.1) then + + state(:,:,:,1) = 0.0d0 + diag_eos(:,:,:,1) = 0.0d0 + + ! This is the regular case with NO_HYDRO = FALSE + else if (ns.gt.1 .and. nd.ge.2) then + + do k = lo(3), hi(3) + do j = lo(2), hi(2) + do i = lo(1), hi(1) + + state(i,j,k,URHO) = 1.5d0 * small_dens + state(i,j,k,UMX:UMZ) = 0.0d0 + + ! These will both be set later in the call to init_e. + state(i,j,k,UEINT) = 0.d0 + state(i,j,k,UEDEN) = 0.d0 + + if (UFS .gt. -1) then + state(i,j,k,UFS ) = XHYDROGEN + state(i,j,k,UFS+1) = (1.d0 - XHYDROGEN) + end if + + diag_eos(i,j,k,TEMP_COMP) = 0.021d0*(1.0d0 + z_in)**2 + diag_eos(i,j,k, NE_COMP) = 0.d0 + + if (ZHI_COMP .gt. -1) then + diag_eos(i,j,k, ZHI_COMP) = 7.5d0 + endif + + enddo + enddo + enddo + + end if + + end subroutine fort_initdata diff --git a/Exec/AMR-density/TREECOOL_middle b/Exec/AMR-density/TREECOOL_middle new file mode 100644 index 00000000..c548b2ec --- /dev/null +++ b/Exec/AMR-density/TREECOOL_middle @@ -0,0 +1,301 @@ +0.000000 5.700000e-14 3.100000e-14 1.121650e-16 3.560837e-25 4.486095e-25 5.008400e-27 +0.021189 7.131077e-14 3.942314e-14 1.290508e-16 4.465957e-25 5.631802e-25 5.728569e-27 +0.041393 8.817069e-14 4.881653e-14 1.564290e-16 5.546459e-25 6.943841e-25 6.874023e-27 +0.060698 1.080520e-13 6.036742e-14 1.892055e-16 6.806021e-25 8.499327e-25 8.214962e-27 +0.079181 1.313927e-13 7.381091e-14 2.281519e-16 8.287477e-25 1.030083e-24 9.775263e-27 +0.096910 1.574751e-13 8.920400e-14 2.740300e-16 9.950685e-25 1.237482e-24 1.157747e-26 +0.113943 1.870916e-13 1.066446e-13 3.274889e-16 1.184974e-24 1.471890e-24 1.363982e-26 +0.130334 2.201403e-13 1.260925e-13 3.893120e-16 1.397618e-24 1.732952e-24 1.598488e-26 +0.146128 2.558537e-13 1.472511e-13 4.603516e-16 1.627616e-24 2.017452e-24 1.863681e-26 +0.161368 2.977649e-13 1.718511e-13 5.410824e-16 1.893292e-24 2.347358e-24 2.160698e-26 +0.176091 3.428995e-13 1.987396e-13 6.320781e-16 2.183324e-24 2.708677e-24 2.490966e-26 +0.190332 3.912293e-13 2.276695e-13 7.337759e-16 2.493622e-24 3.095318e-24 2.855453e-26 +0.204120 4.463107e-13 2.603846e-13 8.467451e-16 2.838601e-24 3.523196e-24 3.255534e-26 +0.217484 5.046292e-13 2.943905e-13 9.710171e-16 3.208211e-24 3.984673e-24 3.690837e-26 +0.230449 5.642777e-13 3.291591e-13 1.106241e-15 3.588006e-24 4.460281e-24 4.159783e-26 +0.243038 6.309768e-13 3.700881e-13 1.252896e-15 4.013032e-24 4.994599e-24 4.663438e-26 +0.255273 7.003212e-13 4.118066e-13 1.409787e-15 4.451985e-24 5.544954e-24 5.197583e-26 +0.267172 7.734476e-13 4.548221e-13 1.577197e-15 4.911441e-24 6.119276e-24 5.762626e-26 +0.278754 8.509889e-13 5.012864e-13 1.753469e-15 5.402579e-24 6.737064e-24 6.352996e-26 +0.290035 9.292096e-13 5.484886e-13 1.937662e-15 5.899552e-24 7.363681e-24 6.965391e-26 +0.301030 1.014903e-12 6.006439e-13 2.128940e-15 6.455638e-24 8.031408e-24 7.596822e-26 +0.311754 1.100000e-12 6.524997e-13 2.325220e-15 7.009520e-24 8.691806e-24 8.240606e-26 +0.322219 1.122007e-12 6.649298e-13 2.524680e-15 7.152800e-24 8.855698e-24 8.890910e-26 +0.332438 1.137809e-12 6.737611e-13 2.725227e-15 7.256136e-24 8.971874e-24 9.541154e-26 +0.342423 1.145552e-12 6.779476e-13 2.924501e-15 7.292276e-24 9.018775e-24 1.018411e-25 +0.352183 1.154360e-12 6.828133e-13 3.119812e-15 7.336837e-24 9.075818e-24 1.081175e-25 +0.361728 1.162594e-12 6.880686e-13 3.308180e-15 7.389919e-24 9.129358e-24 1.141534e-25 +0.371068 1.173550e-12 6.950557e-13 3.486392e-15 7.462784e-24 9.205408e-24 1.198566e-25 +0.380211 1.187979e-12 7.039418e-13 3.651000e-15 7.551576e-24 9.306058e-24 1.251293e-25 +0.389166 1.198634e-12 7.104930e-13 3.797474e-15 7.612901e-24 9.375911e-24 1.298449e-25 +0.397940 1.207275e-12 7.158272e-13 3.924431e-15 7.664101e-24 9.427544e-24 1.339643e-25 +0.406540 1.213105e-12 7.194667e-13 4.033722e-15 7.705948e-24 9.444720e-24 1.375349e-25 +0.414973 1.216342e-12 7.215532e-13 4.127912e-15 7.730928e-24 9.444007e-24 1.406245e-25 +0.423246 1.219054e-12 7.229159e-13 4.207614e-15 7.750458e-24 9.437258e-24 1.432369e-25 +0.431364 1.219149e-12 7.226487e-13 4.274178e-15 7.752770e-24 9.411277e-24 1.454154e-25 +0.439333 1.221622e-12 7.238018e-13 4.326827e-15 7.768263e-24 9.401333e-24 1.471344e-25 +0.447158 1.218366e-12 7.215375e-13 4.364575e-15 7.740295e-24 9.333136e-24 1.483636e-25 +0.454845 1.222231e-12 7.235103e-13 4.388926e-15 7.757998e-24 9.322051e-24 1.491523e-25 +0.462398 1.220561e-12 7.219019e-13 4.397603e-15 7.745418e-24 9.272144e-24 1.494253e-25 +0.469822 1.209901e-12 7.148017e-13 4.393478e-15 7.678796e-24 9.156752e-24 1.492791e-25 +0.477121 1.199432e-12 7.078630e-13 4.374113e-15 7.613336e-24 9.044882e-24 1.486322e-25 +0.484300 1.193909e-12 7.040435e-13 4.342413e-15 7.575579e-24 8.958947e-24 1.475807e-25 +0.491362 1.190000e-12 7.012368e-13 4.297156e-15 7.547275e-24 8.883588e-24 1.460851e-25 +0.498311 1.178629e-12 6.940542e-13 4.239794e-15 7.471795e-24 8.754437e-24 1.441924e-25 +0.505150 1.160855e-12 6.828258e-13 4.171646e-15 7.359487e-24 8.569961e-24 1.419469e-25 +0.511883 1.150522e-12 6.759325e-13 4.091439e-15 7.295230e-24 8.440136e-24 1.393048e-25 +0.518514 1.136042e-12 6.666341e-13 4.002124e-15 7.204632e-24 8.281918e-24 1.363635e-25 +0.525045 1.123528e-12 6.584897e-13 3.904306e-15 7.121947e-24 8.137490e-24 1.331418e-25 +0.531479 1.115864e-12 6.531880e-13 3.797318e-15 7.067108e-24 8.027796e-24 1.296183e-25 +0.537819 1.095126e-12 6.402568e-13 3.683704e-15 6.929647e-24 7.825678e-24 1.258756e-25 +0.544068 1.072765e-12 6.264631e-13 3.564253e-15 6.785092e-24 7.612582e-24 1.219386e-25 +0.550228 1.061742e-12 6.193867e-13 3.439655e-15 6.716654e-24 7.478913e-24 1.178297e-25 +0.556303 1.046184e-12 6.096776e-13 3.310320e-15 6.619508e-24 7.314394e-24 1.135611e-25 +0.562293 1.036077e-12 6.031568e-13 3.177940e-15 6.556823e-24 7.189026e-24 1.091889e-25 +0.568202 1.022056e-12 5.945533e-13 3.043303e-15 6.470033e-24 7.035863e-24 1.047366e-25 +0.574031 1.005956e-12 5.847470e-13 2.907188e-15 6.370046e-24 6.869274e-24 1.002312e-25 +0.579784 9.912223e-13 5.757424e-13 2.770379e-15 6.278681e-24 6.712955e-24 9.569790e-26 +0.585461 9.680384e-13 5.618682e-13 2.633502e-15 6.132892e-24 6.504294e-24 9.115552e-26 +0.591065 9.544885e-13 5.536352e-13 2.497385e-15 6.046844e-24 6.366674e-24 8.663305e-26 +0.596597 9.306970e-13 5.394692e-13 2.362745e-15 5.895920e-24 6.161646e-24 8.215325e-26 +0.602060 9.143101e-13 5.296034e-13 2.230116e-15 5.791908e-24 6.006705e-24 7.773418e-26 +0.607455 8.991008e-13 5.202923e-13 6.307590e-16 5.694157e-24 5.863423e-24 3.786485e-26 +0.612784 8.823489e-13 5.100061e-13 3.181031e-16 5.585858e-24 5.712746e-24 2.016526e-26 +0.618048 8.751899e-13 5.052654e-13 2.134829e-16 5.538291e-24 5.624235e-24 1.429888e-26 +0.623249 8.637173e-13 4.980317e-13 1.608417e-16 5.463416e-24 5.507808e-24 1.139137e-26 +0.628389 8.528019e-13 4.915248e-13 1.289660e-16 5.396334e-24 5.407943e-24 1.052143e-26 +0.633468 8.428606e-13 4.856804e-13 1.037051e-16 5.336487e-24 5.317448e-24 9.806648e-27 +0.638489 8.382619e-13 4.829132e-13 8.621439e-17 5.310497e-24 5.260379e-24 8.760179e-27 +0.643453 8.336445e-13 4.801335e-13 7.325023e-17 5.284443e-24 5.202720e-24 8.019994e-27 +0.648360 8.267178e-13 4.759967e-13 6.313902e-17 5.244351e-24 5.141382e-24 7.475048e-27 +0.653213 8.196424e-13 4.717560e-13 5.492792e-17 5.203728e-24 5.086392e-24 6.126590e-27 +0.658011 8.135775e-13 4.680948e-13 5.019306e-17 5.169572e-24 5.037542e-24 5.049079e-27 +0.662758 8.065499e-13 4.638777e-13 4.592255e-17 5.129351e-24 4.982595e-24 4.934280e-27 +0.667453 8.027916e-13 4.615450e-13 4.201102e-17 5.109119e-24 4.948612e-24 4.841405e-27 +0.672098 7.961321e-13 4.575691e-13 3.837703e-17 5.066971e-24 4.900394e-24 4.766620e-27 +0.676694 7.886928e-13 4.531439e-13 3.495599e-17 5.019863e-24 4.847315e-24 3.977646e-27 +0.681241 7.815721e-13 4.489005e-13 3.301013e-17 4.974785e-24 4.796134e-24 3.250959e-27 +0.685742 7.747680e-13 4.448374e-13 3.108054e-17 4.931723e-24 4.746826e-24 3.256814e-27 +0.690196 7.690636e-13 4.415922e-13 2.915607e-17 4.898378e-24 4.709738e-24 3.265612e-27 +0.694605 7.642091e-13 4.389615e-13 2.722633e-17 4.872297e-24 4.681562e-24 3.277108e-27 +0.698970 7.569034e-13 4.349242e-13 2.528152e-17 4.830632e-24 4.638383e-24 2.779312e-27 +0.703291 7.496390e-13 4.309116e-13 2.415028e-17 4.789259e-24 4.595466e-24 2.292495e-27 +0.707570 7.426188e-13 4.270404e-13 2.297740e-17 4.749480e-24 4.554057e-24 2.318147e-27 +0.711807 7.358775e-13 4.234541e-13 2.175971e-17 4.710133e-24 4.516890e-24 2.344472e-27 +0.716003 7.254846e-13 4.177967e-13 2.049395e-17 4.647062e-24 4.457929e-24 2.371451e-27 +0.720159 7.152903e-13 4.122517e-13 1.917677e-17 4.585242e-24 4.400158e-24 2.060401e-27 +0.724276 7.051901e-13 4.067590e-13 1.834401e-17 4.524005e-24 4.342938e-24 1.747728e-27 +0.728354 6.953706e-13 4.014265e-13 1.746429e-17 4.464550e-24 4.287421e-24 1.774039e-27 +0.732394 6.824911e-13 3.941022e-13 1.653568e-17 4.386103e-24 4.210623e-24 1.800666e-27 +0.736397 6.764605e-13 3.906762e-13 1.555619e-17 4.351803e-24 4.175464e-24 1.827609e-27 +0.740363 6.671800e-13 3.853730e-13 1.452373e-17 4.296577e-24 4.120238e-24 1.582864e-27 +0.744293 6.580179e-13 3.801378e-13 1.387060e-17 4.242072e-24 4.065723e-24 1.333318e-27 +0.748188 6.544022e-13 3.781067e-13 1.317574e-17 4.223321e-24 4.045477e-24 1.355995e-27 +0.752048 6.481107e-13 3.742073e-13 1.243778e-17 4.185266e-24 4.006934e-24 1.378892e-27 +0.755875 6.441856e-13 3.714595e-13 1.165528e-17 4.161120e-24 3.981845e-24 1.402009e-27 +0.759668 6.390398e-13 3.680078e-13 1.082679e-17 4.129089e-24 3.949210e-24 1.255493e-27 +0.763428 6.353209e-13 3.653779e-13 1.022687e-17 4.106278e-24 3.925395e-24 1.104912e-27 +0.767156 6.297119e-13 3.616611e-13 9.589602e-18 4.071249e-24 3.889899e-24 1.124369e-27 +0.770852 6.265970e-13 3.595083e-13 8.913869e-18 4.052667e-24 3.870932e-24 1.144009e-27 +0.774517 6.224705e-13 3.573013e-13 8.198515e-18 4.028825e-24 3.850199e-24 1.163833e-27 +0.778151 6.193681e-13 3.556826e-13 7.442358e-18 4.011619e-24 3.835816e-24 1.005099e-27 +0.781755 6.051062e-13 3.476532e-13 6.941549e-18 3.922097e-24 3.752257e-24 8.413854e-28 +0.785330 5.877877e-13 3.378617e-13 6.410901e-18 3.812656e-24 3.649568e-24 8.565593e-28 +0.788875 5.676714e-13 3.264544e-13 5.849590e-18 3.684930e-24 3.529277e-24 8.718795e-28 +0.792392 5.495041e-13 3.167119e-13 5.256778e-18 3.571577e-24 3.427850e-24 8.873461e-28 +0.795880 5.363643e-13 3.106727e-13 4.631610e-18 3.493560e-24 3.367904e-24 7.118943e-28 +0.799341 5.169618e-13 3.009645e-13 4.299132e-18 3.374552e-24 3.268043e-24 5.304775e-28 +0.802774 4.995822e-13 2.923781e-13 3.947483e-18 3.268479e-24 3.180164e-24 5.402246e-28 +0.806180 4.877927e-13 2.870282e-13 3.576173e-18 3.198812e-24 3.127367e-24 5.500706e-28 +0.809560 4.759080e-13 2.816036e-13 3.184706e-18 3.128429e-24 3.073691e-24 5.600157e-28 +0.812913 4.623742e-13 2.752620e-13 2.772580e-18 3.047217e-24 3.011775e-24 4.368394e-28 +0.816241 4.520541e-13 2.711678e-13 2.571902e-18 2.987705e-24 2.981882e-24 3.092253e-28 +0.819544 4.443370e-13 2.686641e-13 2.360065e-18 2.945518e-24 2.969691e-24 3.148907e-28 +0.822822 4.345795e-13 2.649609e-13 2.136800e-18 2.889947e-24 2.944484e-24 3.206155e-28 +0.826075 4.272450e-13 2.627744e-13 1.901832e-18 2.850653e-24 2.936413e-24 3.263997e-28 +0.829304 4.200690e-13 2.607429e-13 1.654885e-18 2.812654e-24 2.930479e-24 2.576582e-28 +0.832509 4.130429e-13 2.588692e-13 1.528682e-18 2.775929e-24 2.926771e-24 1.863881e-28 +0.835691 4.062667e-13 2.568159e-13 1.395797e-18 2.739122e-24 2.916111e-24 1.897383e-28 +0.838849 3.995945e-13 2.547881e-13 1.256074e-18 2.702749e-24 2.904734e-24 1.931235e-28 +0.841985 3.930652e-13 2.529187e-13 1.109356e-18 2.667606e-24 2.895517e-24 1.965440e-28 +0.845098 3.847176e-13 2.499429e-13 9.554854e-19 2.620375e-24 2.873967e-24 1.518516e-28 +0.848189 3.667928e-13 2.407400e-13 8.818350e-19 2.507890e-24 2.780786e-24 1.055345e-28 +0.851258 3.528143e-13 2.340834e-13 8.044452e-19 2.422216e-24 2.716796e-24 1.073845e-28 +0.854306 3.393126e-13 2.275320e-13 7.232325e-19 2.338935e-24 2.654234e-24 1.092536e-28 +0.857332 3.274144e-13 2.212584e-13 6.381125e-19 2.263375e-24 2.596005e-24 1.111419e-28 +0.860338 3.155981e-13 2.150280e-13 5.490001e-19 2.188337e-24 2.538177e-24 8.680585e-29 +0.863323 3.038634e-13 2.088406e-13 5.043857e-19 2.113816e-24 2.480749e-24 6.160051e-29 +0.866287 2.922076e-13 2.026948e-13 4.576116e-19 2.039797e-24 2.423706e-24 6.264938e-29 +0.869232 2.806318e-13 1.965913e-13 4.086313e-19 1.966287e-24 2.367056e-24 6.370885e-29 +0.872156 2.691342e-13 1.905289e-13 3.573978e-19 1.893271e-24 2.310788e-24 6.477896e-29 +0.875061 2.581002e-13 1.846475e-13 3.038639e-19 1.822827e-24 2.254911e-24 4.829715e-29 +0.877947 2.486829e-13 1.793655e-13 2.810482e-19 1.761161e-24 2.199478e-24 3.124579e-29 +0.880814 2.393272e-13 1.741182e-13 2.571572e-19 1.699900e-24 2.144408e-24 3.176211e-29 +0.883661 2.300330e-13 1.689053e-13 2.321684e-19 1.639041e-24 2.089699e-24 3.228351e-29 +0.886491 2.207996e-13 1.637267e-13 2.060592e-19 1.578580e-24 2.035351e-24 3.281002e-29 +0.889302 2.116261e-13 1.585815e-13 1.788069e-19 1.518513e-24 1.981352e-24 2.619701e-29 +0.892095 2.025115e-13 1.534694e-13 1.640604e-19 1.458830e-24 1.927701e-24 1.935953e-29 +0.894870 1.934552e-13 1.483901e-13 1.486533e-19 1.399530e-24 1.874395e-24 1.966965e-29 +0.897627 1.860132e-13 1.437805e-13 1.325724e-19 1.349538e-24 1.824350e-24 1.998274e-29 +0.900367 1.790063e-13 1.393093e-13 1.158044e-19 1.302091e-24 1.775350e-24 2.029880e-29 +0.903090 1.720436e-13 1.348662e-13 9.833555e-20 1.254941e-24 1.726661e-24 2.061784e-29 +0.905796 1.651244e-13 1.304507e-13 8.015240e-20 1.208085e-24 1.678274e-24 2.093989e-29 +0.908485 1.582476e-13 1.260626e-13 6.124118e-20 1.161519e-24 1.630186e-24 2.126493e-29 +0.911158 1.514133e-13 1.217015e-13 4.158803e-20 1.115240e-24 1.582395e-24 2.159299e-29 +0.913814 1.446210e-13 1.173673e-13 2.117900e-20 1.069246e-24 1.534897e-24 2.192407e-29 +0.916454 1.378694e-13 1.130588e-13 0.000000e+00 1.023525e-24 1.487683e-24 0.000000e+00 +0.919078 1.326935e-13 1.093997e-13 0.000000e+00 9.870744e-25 1.444549e-24 0.000000e+00 +0.921686 1.275485e-13 1.057624e-13 0.000000e+00 9.508408e-25 1.401672e-24 0.000000e+00 +0.924279 1.224342e-13 1.021468e-13 0.000000e+00 9.148230e-25 1.359051e-24 0.000000e+00 +0.926857 1.173502e-13 9.855261e-14 0.000000e+00 8.790185e-25 1.316683e-24 0.000000e+00 +0.929419 1.122961e-13 9.497961e-14 0.000000e+00 8.434253e-25 1.274565e-24 0.000000e+00 +0.931966 1.072719e-13 9.142766e-14 0.000000e+00 8.080418e-25 1.232694e-24 0.000000e+00 +0.934498 1.022771e-13 8.789657e-14 0.000000e+00 7.728660e-25 1.191069e-24 0.000000e+00 +0.937016 9.731088e-14 8.438562e-14 0.000000e+00 7.378909e-25 1.149682e-24 0.000000e+00 +0.939519 9.371704e-14 8.160445e-14 0.000000e+00 7.115605e-25 1.114961e-24 0.000000e+00 +0.942008 9.014364e-14 7.883910e-14 0.000000e+00 6.853799e-25 1.080437e-24 0.000000e+00 +0.944483 8.659053e-14 7.608948e-14 0.000000e+00 6.593480e-25 1.046108e-24 0.000000e+00 +0.946943 8.305762e-14 7.335546e-14 0.000000e+00 6.334640e-25 1.011975e-24 0.000000e+00 +0.949390 7.954452e-14 7.063678e-14 0.000000e+00 6.077250e-25 9.780345e-25 0.000000e+00 +0.951823 7.605111e-14 6.793334e-14 0.000000e+00 5.821304e-25 9.442834e-25 0.000000e+00 +0.954243 7.257733e-14 6.524508e-14 0.000000e+00 5.566797e-25 9.107219e-25 0.000000e+00 +0.956649 6.912279e-14 6.257172e-14 0.000000e+00 5.313699e-25 8.773464e-25 0.000000e+00 +0.959041 6.628733e-14 6.031097e-14 0.000000e+00 5.105714e-25 8.483019e-25 0.000000e+00 +0.961421 6.386646e-14 5.832717e-14 0.000000e+00 4.927940e-25 8.221747e-25 0.000000e+00 +0.963788 6.145870e-14 5.635417e-14 0.000000e+00 4.751132e-25 7.961892e-25 0.000000e+00 +0.966142 5.906407e-14 5.439189e-14 0.000000e+00 4.575287e-25 7.703451e-25 0.000000e+00 +0.968483 5.668231e-14 5.244018e-14 0.000000e+00 4.400386e-25 7.446403e-25 0.000000e+00 +0.970812 3.834510e-14 4.402700e-14 0.000000e+00 2.595247e-25 0.000000e+00 0.000000e+00 +0.973128 4.188557e-15 4.802124e-15 0.000000e+00 6.018460e-26 0.000000e+00 0.000000e+00 +0.975432 1.865695e-15 2.134670e-15 0.000000e+00 3.180310e-26 0.000000e+00 0.000000e+00 +0.977724 1.174019e-15 1.340458e-15 0.000000e+00 2.064471e-26 0.000000e+00 0.000000e+00 +0.980003 8.471102e-16 9.651459e-16 0.000000e+00 1.519086e-26 0.000000e+00 0.000000e+00 +0.982271 6.565596e-16 7.464321e-16 0.000000e+00 1.200737e-26 0.000000e+00 0.000000e+00 +0.984527 5.315749e-16 6.030196e-16 0.000000e+00 9.923108e-27 0.000000e+00 0.000000e+00 +0.986772 4.431324e-16 5.015781e-16 0.000000e+00 8.451805e-27 0.000000e+00 0.000000e+00 +0.989005 3.771366e-16 4.259206e-16 0.000000e+00 7.356993e-27 0.000000e+00 0.000000e+00 +0.991226 3.259163e-16 3.672376e-16 0.000000e+00 6.509960e-27 0.000000e+00 0.000000e+00 +0.993436 2.849390e-16 3.203243e-16 0.000000e+00 5.834653e-27 0.000000e+00 0.000000e+00 +0.995635 2.513551e-16 2.819082e-16 0.000000e+00 5.283248e-27 0.000000e+00 0.000000e+00 +0.997823 2.232830e-16 2.498288e-16 0.000000e+00 4.824163e-27 0.000000e+00 0.000000e+00 +1.000000 1.994308e-16 2.226022e-16 0.000000e+00 4.435703e-27 0.000000e+00 0.000000e+00 +1.002166 1.788819e-16 1.991761e-16 0.000000e+00 4.102474e-27 0.000000e+00 0.000000e+00 +1.004321 1.609682e-16 1.787834e-16 0.000000e+00 3.813247e-27 0.000000e+00 0.000000e+00 +1.006466 1.451916e-16 1.608518e-16 0.000000e+00 3.559640e-27 0.000000e+00 0.000000e+00 +1.008600 1.311728e-16 1.449461e-16 0.000000e+00 3.335270e-27 0.000000e+00 0.000000e+00 +1.010724 1.186187e-16 1.307295e-16 0.000000e+00 3.135191e-27 0.000000e+00 0.000000e+00 +1.012837 1.072987e-16 1.179375e-16 0.000000e+00 2.955509e-27 0.000000e+00 0.000000e+00 +1.014940 9.702979e-17 1.063595e-16 0.000000e+00 2.743582e-27 0.000000e+00 0.000000e+00 +1.017033 8.802750e-17 9.623278e-17 0.000000e+00 2.495225e-27 0.000000e+00 0.000000e+00 +1.019116 8.019337e-17 8.744034e-17 0.000000e+00 2.264206e-27 0.000000e+00 0.000000e+00 +1.021189 7.332056e-17 7.974478e-17 0.000000e+00 2.063345e-27 0.000000e+00 0.000000e+00 +1.023252 6.724845e-17 7.296182e-17 0.000000e+00 1.887445e-27 0.000000e+00 0.000000e+00 +1.025306 6.185044e-17 6.694622e-17 0.000000e+00 1.732417e-27 0.000000e+00 0.000000e+00 +1.027350 5.702533e-17 6.158191e-17 0.000000e+00 1.595002e-27 0.000000e+00 0.000000e+00 +1.029384 5.269128e-17 5.677508e-17 0.000000e+00 1.472571e-27 0.000000e+00 0.000000e+00 +1.031408 4.878134e-17 5.244901e-17 0.000000e+00 1.362982e-27 0.000000e+00 0.000000e+00 +1.033424 4.524024e-17 4.854037e-17 0.000000e+00 1.264471e-27 0.000000e+00 0.000000e+00 +1.035430 4.202191e-17 4.499644e-17 0.000000e+00 1.175576e-27 0.000000e+00 0.000000e+00 +1.037426 3.908766e-17 4.177292e-17 0.000000e+00 1.095070e-27 0.000000e+00 0.000000e+00 +1.039414 3.640472e-17 3.883237e-17 0.000000e+00 1.021924e-27 0.000000e+00 0.000000e+00 +1.041393 2.545887e-17 2.710715e-17 0.000000e+00 9.552614e-28 0.000000e+00 0.000000e+00 +1.043362 2.376379e-17 2.525780e-17 0.000000e+00 8.943373e-28 0.000000e+00 0.000000e+00 +1.045323 2.220278e-17 2.355856e-17 0.000000e+00 8.385110e-28 0.000000e+00 0.000000e+00 +1.047275 2.076240e-17 2.199408e-17 0.000000e+00 7.872305e-28 0.000000e+00 0.000000e+00 +1.049218 1.943092e-17 2.055102e-17 0.000000e+00 7.400175e-28 0.000000e+00 0.000000e+00 +1.051153 1.819806e-17 1.921769e-17 0.000000e+00 6.964559e-28 0.000000e+00 0.000000e+00 +1.053078 1.705478e-17 1.798381e-17 0.000000e+00 6.561819e-28 0.000000e+00 0.000000e+00 +1.054996 1.599309e-17 1.684033e-17 0.000000e+00 6.188765e-28 0.000000e+00 0.000000e+00 +1.056905 1.500588e-17 1.577919e-17 0.000000e+00 5.842588e-28 0.000000e+00 0.000000e+00 +1.058805 1.408684e-17 1.479325e-17 0.000000e+00 5.520808e-28 0.000000e+00 0.000000e+00 +1.060698 1.323032e-17 1.387614e-17 0.000000e+00 5.221225e-28 0.000000e+00 0.000000e+00 +1.062582 1.243127e-17 1.302215e-17 0.000000e+00 4.941885e-28 0.000000e+00 0.000000e+00 +1.064458 1.168513e-17 1.222615e-17 0.000000e+00 4.681045e-28 0.000000e+00 0.000000e+00 +1.066326 1.098779e-17 1.148352e-17 0.000000e+00 4.437148e-28 0.000000e+00 0.000000e+00 +1.068186 1.033555e-17 1.079010e-17 0.000000e+00 4.208798e-28 0.000000e+00 0.000000e+00 +1.070038 9.725022e-18 1.014211e-17 0.000000e+00 3.994742e-28 0.000000e+00 0.000000e+00 +1.071882 9.153161e-18 9.536141e-18 0.000000e+00 3.793849e-28 0.000000e+00 0.000000e+00 +1.073718 8.617175e-18 8.969074e-18 0.000000e+00 3.605101e-28 0.000000e+00 0.000000e+00 +1.075547 8.114517e-18 8.438075e-18 0.000000e+00 3.427577e-28 0.000000e+00 0.000000e+00 +1.077368 7.642860e-18 7.940556e-18 0.000000e+00 3.260441e-28 0.000000e+00 0.000000e+00 +1.079181 7.200066e-18 7.474148e-18 0.000000e+00 3.102934e-28 0.000000e+00 0.000000e+00 +1.080987 6.784177e-18 7.036681e-18 0.000000e+00 2.954367e-28 0.000000e+00 0.000000e+00 +1.082785 6.393389e-18 6.626162e-18 0.000000e+00 2.814110e-28 0.000000e+00 0.000000e+00 +1.084576 6.026038e-18 6.240760e-18 0.000000e+00 2.681590e-28 0.000000e+00 0.000000e+00 +1.086360 5.680592e-18 5.878787e-18 0.000000e+00 2.556281e-28 0.000000e+00 0.000000e+00 +1.088136 5.355632e-18 5.538686e-18 0.000000e+00 2.437701e-28 0.000000e+00 0.000000e+00 +1.089905 5.049847e-18 5.219021e-18 0.000000e+00 2.325410e-28 0.000000e+00 0.000000e+00 +1.091667 4.762020e-18 4.918463e-18 0.000000e+00 2.219002e-28 0.000000e+00 0.000000e+00 +1.093422 4.491023e-18 4.635780e-18 0.000000e+00 2.118103e-28 0.000000e+00 0.000000e+00 +1.095169 4.235808e-18 4.369832e-18 0.000000e+00 2.022369e-28 0.000000e+00 0.000000e+00 +1.096910 3.995401e-18 4.119560e-18 0.000000e+00 1.931483e-28 0.000000e+00 0.000000e+00 +1.098644 3.768894e-18 3.883981e-18 0.000000e+00 1.845150e-28 0.000000e+00 0.000000e+00 +1.100371 3.555441e-18 3.662180e-18 0.000000e+00 1.763099e-28 0.000000e+00 0.000000e+00 +1.102091 3.354254e-18 3.453305e-18 0.000000e+00 1.685079e-28 0.000000e+00 0.000000e+00 +1.103804 3.164596e-18 3.256564e-18 0.000000e+00 1.610855e-28 0.000000e+00 0.000000e+00 +1.105510 2.985780e-18 3.071217e-18 0.000000e+00 1.540212e-28 0.000000e+00 0.000000e+00 +1.107210 2.817162e-18 2.896573e-18 0.000000e+00 1.472945e-28 0.000000e+00 0.000000e+00 +1.108903 2.658141e-18 2.731988e-18 0.000000e+00 1.408869e-28 0.000000e+00 0.000000e+00 +1.110590 2.508153e-18 2.576860e-18 0.000000e+00 1.347807e-28 0.000000e+00 0.000000e+00 +1.112270 2.366670e-18 2.430625e-18 0.000000e+00 1.289597e-28 0.000000e+00 0.000000e+00 +1.113943 2.233198e-18 2.292757e-18 0.000000e+00 1.234084e-28 0.000000e+00 0.000000e+00 +1.115611 2.107271e-18 2.162761e-18 0.000000e+00 1.181128e-28 0.000000e+00 0.000000e+00 +1.117271 1.988454e-18 2.040175e-18 0.000000e+00 1.130593e-28 0.000000e+00 0.000000e+00 +1.118926 1.876339e-18 1.924565e-18 0.000000e+00 1.082354e-28 0.000000e+00 0.000000e+00 +1.120574 1.770540e-18 1.815525e-18 0.000000e+00 1.036294e-28 0.000000e+00 0.000000e+00 +1.122216 1.670697e-18 1.712674e-18 0.000000e+00 9.923029e-29 0.000000e+00 0.000000e+00 +1.123852 1.576469e-18 1.615653e-18 0.000000e+00 9.502763e-29 0.000000e+00 0.000000e+00 +1.125481 1.487538e-18 1.524125e-18 0.000000e+00 9.101169e-29 0.000000e+00 0.000000e+00 +1.127105 1.403603e-18 1.437776e-18 0.000000e+00 8.717329e-29 0.000000e+00 0.000000e+00 +1.128722 1.324380e-18 1.356307e-18 0.000000e+00 8.350379e-29 0.000000e+00 0.000000e+00 +1.130334 1.249604e-18 1.279439e-18 0.000000e+00 7.999501e-29 0.000000e+00 0.000000e+00 +1.131939 1.179024e-18 1.206910e-18 0.000000e+00 7.663928e-29 0.000000e+00 0.000000e+00 +1.133539 1.112403e-18 1.138472e-18 0.000000e+00 7.342931e-29 0.000000e+00 0.000000e+00 +1.135133 1.049518e-18 1.073893e-18 0.000000e+00 7.035825e-29 0.000000e+00 0.000000e+00 +1.136721 0.000000e+00 1.012954e-18 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.138303 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.139879 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.141450 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.143015 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.144574 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.146128 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.147676 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.149219 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.150756 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.152288 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.153815 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.155336 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.156852 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.158362 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.159868 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.161368 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.162863 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.164353 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.165838 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.167317 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.168792 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.170262 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.171726 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.173186 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.174641 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.176091 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.177536 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.178977 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.180413 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.181844 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.183270 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.184691 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.186108 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.187521 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.188928 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.190332 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.191730 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.193125 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.194514 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.195900 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.197281 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.198657 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.200029 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.201397 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.202761 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.204120 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 diff --git a/Exec/AMR-density/Tagging_3d.f90 b/Exec/AMR-density/Tagging_3d.f90 new file mode 100644 index 00000000..fdd1fa21 --- /dev/null +++ b/Exec/AMR-density/Tagging_3d.f90 @@ -0,0 +1,54 @@ +! ::: ----------------------------------------------------------- +! ::: This routine will tag high error cells based on overdensity +! ::: +! ::: INPUTS/OUTPUTS: +! ::: +! ::: tag <= integer tag array +! ::: lo,hi => index extent of tag array +! ::: set => integer value to tag cell for refinement +! ::: clear => integer value to untag cell +! ::: den => density array +! ::: nc => number of components in density array +! ::: domlo,hi => index extent of problem domain +! ::: delta => cell spacing +! ::: xlo => physical location of lower left hand +! ::: corner of tag array +! ::: problo => phys loc of lower left corner of prob domain +! ::: time => problem evolution time +! ::: level => refinement level of this array +! ::: ----------------------------------------------------------- + subroutine tag_overdensity(tag,tagl1,tagl2,tagl3,tagh1,tagh2,tagh3, & + set,clear, & + den,denl1,denl2,denl3,denh1,denh2,denh3, & + lo,hi,nc,domlo,domhi,delta,level,avg_den) + + use amrex_fort_module, only : rt => amrex_real + use probdata_module + implicit none + + integer :: set, clear, nc, level + integer :: tagl1,tagl2,tagl3,tagh1,tagh2,tagh3 + integer :: denl1,denl2,denl3,denh1,denh2,denh3 + integer :: lo(3), hi(3), domlo(3), domhi(3) + integer :: tag(tagl1:tagh1,tagl2:tagh2,tagl3:tagh3) + real(rt) :: den(denl1:denh1,denl2:denh2,denl3:denh3,nc) + real(rt) :: delta(3), avg_den + + integer :: i,j,k + real(rt) :: over_den + + over_den = avg_den * 8**(level+1) + + ! Tag on regions of overdensity + do k = lo(3), hi(3) + do j = lo(2), hi(2) + do i = lo(1), hi(1) + if ( den(i,j,k,1) .gt. over_den ) then + tag(i,j,k) = set + endif + enddo + enddo + enddo + + end subroutine tag_overdensity + diff --git a/Exec/AMR-density/inputs b/Exec/AMR-density/inputs new file mode 100644 index 00000000..7af6b5fd --- /dev/null +++ b/Exec/AMR-density/inputs @@ -0,0 +1,164 @@ +# ------------------ INPUTS TO MAIN PROGRAM ------------------- +max_step = 10000000 + +amr.mffile_nstreams = 4 +amr.precreateDirectories = 1 +amr.prereadFAHeaders = 1 +#amr.plot_headerversion = 1 +amr.checkpoint_headerversion = 2 + +#### vismf.headerversion = 2 +vismf.groupsets = 0 +vismf.setbuf = 1 +vismf.usesingleread = 1 +vismf.usesinglewrite = 1 +vismf.checkfilepositions = 1 +vismf.usepersistentifstreams = 1 +vismf.usesynchronousreads = 0 +vismf.usedynamicsetselection = 1 + + +nyx.ppm_type = 1 +nyx.ppm_reference = 1 +nyx.use_colglaz = 0 +nyx.corner_coupling = 1 + +nyx.strang_split = 1 +nyx.add_ext_src = 1 +nyx.heat_cool_type = 3 +#nyx.simd_width = 8 + +nyx.small_dens = 1.e-2 +nyx.small_temp = 1.e-2 + +nyx.do_santa_barbara = 1 +nyx.init_sb_vels = 1 +gravity.ml_tol = 1.e-10 +gravity.sl_tol = 1.e-10 + +nyx.initial_z = 159.0 +nyx.final_z = 2.0 + +#File written during the run: nstep | time | dt | redshift | a +amr.data_log = runlog +#amr.grid_log = grdlog + +#This is how we restart from a checkpoint and write an ascii particle file +#Leave this commented out in cvs version +#amr.restart = chk00100 +#max_step = 4 +#particles.particle_output_file = particle_output + +gravity.gravity_type = PoissonGrav +gravity.no_sync = 1 +gravity.no_composite = 1 +gravity.solve_with_mlmg = 1 +gravity.solve_with_hpgmg = 0 + +mg.bottom_solver = 4 + +# PROBLEM SIZE & GEOMETRY +geometry.is_periodic = 1 1 1 +geometry.coord_sys = 0 + +geometry.prob_lo = 0 0 0 + +#Domain size in Mpc +geometry.prob_hi = 28.49002849 28.49002849 28.49002849 + +amr.n_cell = 64 64 64 +amr.max_grid_size = 32 +fabarray.mfiter_tile_size = 1024000 8 8 + +# >>>>>>>>>>>>> BC FLAGS <<<<<<<<<<<<<<<< +# 0 = Interior 3 = Symmetry +# 1 = Inflow 4 = SlipWall +# 2 = Outflow +# >>>>>>>>>>>>> BC FLAGS <<<<<<<<<<<<<<<< +nyx.lo_bc = 0 0 0 +nyx.hi_bc = 0 0 0 + +# WHICH PHYSICS +nyx.do_hydro = 1 +nyx.do_grav = 1 + +# COSMOLOGY +nyx.comoving_OmM = 0.275 +nyx.comoving_OmB = 0.046 +nyx.comoving_h = 0.702d0 + +# UVB and reionization +nyx.inhomo_reion = 0 +nyx.inhomo_zhi_file = "zhi.bin" +nyx.inhomo_grid = 512 +nyx.uvb_rates_file = "TREECOOL_middle" +nyx.uvb_density_A = 1.0 +nyx.uvb_density_B = 0.0 +nyx.reionization_zHI_flash = -1.0 +nyx.reionization_zHeII_flash = -1.0 +nyx.reionization_T_zHI = 2.0e4 +nyx.reionization_T_zHeII = 1.5e4 + +# PARTICLES +nyx.do_dm_particles = 1 + +# >>>>>>>>>>>>> PARTICLE INIT OPTIONS <<<<<<<<<<<<<<<< +# "AsciiFile" "Random" "Cosmological" +# >>>>>>>>>>>>> PARTICLE INIT OPTIONS <<<<<<<<<<<<<<<< +nyx.particle_init_type = BinaryFile +nyx.binary_particle_file = 64sssss_20mpc.nyx +particles.nparts_per_read = 2097152 + +# >>>>>>>>>>>>> PARTICLE MOVE OPTIONS <<<<<<<<<<<<<<<< +# "Gravitational" "Random" +# >>>>>>>>>>>>> PARTICLE MOVE OPTIONS <<<<<<<<<<<<<<<< +nyx.particle_move_type = Gravitational + +# TIME STEP CONTROL +nyx.relative_max_change_a = 0.01 # max change in scale factor +particles.cfl = 0.5 # 'cfl' for particles +nyx.cfl = 0.5 # cfl number for hyperbolic system +nyx.init_shrink = 1.0 # scale back initial timestep +nyx.change_max = 2.0 # factor by which timestep can change +nyx.dt_cutoff = 5.e-20 # level 0 timestep below which we halt + +# DIAGNOSTICS & VERBOSITY +nyx.print_fortran_warnings = 0 +nyx.sum_interval = -1 # timesteps between computing mass +nyx.v = 1 # verbosity in Nyx.cpp +gravity.v = 1 # verbosity in Gravity.cpp +amr.v = 1 # verbosity in Amr.cpp +mg.v = 1 # verbosity in Amr.cpp +particles.v = 2 # verbosity in Particle class + +# REFINEMENT / REGRIDDING +amr.max_level = 2 # maximum level number allowed, base grid = 0 +amr.ref_ratio = 2 2 2 2 # refinement ratio at different levels: 2 or 4 +amr.blocking_factor = 16 # min grid size +amr.subcycling_mode = Auto # Auto or None + +amr.regrid_int = 2 2 2 2 +amr.n_error_buf = 2 2 2 2 +amr.refine_grid_layout = 1 +amr.regrid_on_restart = 1 + +# CHECKPOINT FILES +amr.checkpoint_files_output = 1 +amr.check_file = chk +amr.check_int = 100 +amr.checkpoint_nfiles = 64 + +# PLOTFILES +fab.format = NATIVE_32 +amr.plot_files_output = 0 +amr.plot_file = plt +amr.plot_int = -1 +amr.plot_nfiles = 64 +nyx.plot_z_values = 7.0 6.0 5.0 4.0 3.0 2.0 +particles.write_in_plotfile = 1 + +amr.plot_vars = density xmom ymom zmom rho_e Temp phi_grav +amr.derive_plot_vars = particle_mass_density + +#PROBIN FILENAME +amr.probin_file = probin diff --git a/Exec/AMR-density/inputs.rt b/Exec/AMR-density/inputs.rt new file mode 100644 index 00000000..f083122d --- /dev/null +++ b/Exec/AMR-density/inputs.rt @@ -0,0 +1,145 @@ +# ------------------ INPUTS TO MAIN PROGRAM ------------------- +max_step = 310 +amr.restart = chk00300_for_rt + +amr.mffile_nstreams = 4 +amr.precreateDirectories = 1 +amr.prereadFAHeaders = 1 +#amr.plot_headerversion = 1 +amr.checkpoint_headerversion = 2 + +nyx.ppm_type = 1 +nyx.ppm_reference = 1 +nyx.use_colglaz = 0 +nyx.corner_coupling = 1 + +nyx.strang_split = 1 +nyx.add_ext_src = 1 +nyx.heat_cool_type = 3 +#nyx.simd_width = 8 + +nyx.small_dens = 1.e-2 +nyx.small_temp = 1.e-2 + +nyx.do_santa_barbara = 1 +nyx.init_sb_vels = 1 +gravity.ml_tol = 1.e-10 +gravity.sl_tol = 1.e-10 + +nyx.initial_z = 159.0 +nyx.final_z = 2.0 + +#File written during the run: nstep | time | dt | redshift | a +amr.data_log = runlog + +gravity.gravity_type = PoissonGrav +gravity.no_sync = 1 +gravity.no_composite = 1 +gravity.solve_with_cpp = 0 +gravity.solve_with_hpgmg = 0 + +mg.bottom_solver = 4 + +# PROBLEM SIZE & GEOMETRY +geometry.is_periodic = 1 1 1 +geometry.coord_sys = 0 + +geometry.prob_lo = 0 0 0 + +#Domain size in Mpc +geometry.prob_hi = 28.49002849 28.49002849 28.49002849 + +amr.n_cell = 64 64 64 +amr.max_grid_size = 32 +fabarray.mfiter_tile_size = 1024000 8 8 + +# >>>>>>>>>>>>> BC FLAGS <<<<<<<<<<<<<<<< +# 0 = Interior 3 = Symmetry +# 1 = Inflow 4 = SlipWall +# 2 = Outflow +# >>>>>>>>>>>>> BC FLAGS <<<<<<<<<<<<<<<< +nyx.lo_bc = 0 0 0 +nyx.hi_bc = 0 0 0 + +# WHICH PHYSICS +nyx.do_hydro = 1 +nyx.do_grav = 1 + +# COSMOLOGY +nyx.comoving_OmM = 0.275 +nyx.comoving_OmB = 0.046 +nyx.comoving_h = 0.702d0 + +# UVB and reionization +nyx.inhomo_reion = 0 +nyx.inhomo_zhi_file = "zhi.bin" +nyx.inhomo_grid = 512 +nyx.uvb_rates_file = "TREECOOL_middle" +nyx.uvb_density_A = 1.0 +nyx.uvb_density_B = 0.0 +nyx.reionization_zHI_flash = -1.0 +nyx.reionization_zHeII_flash = -1.0 +nyx.reionization_T_zHI = 2.0e4 +nyx.reionization_T_zHeII = 1.5e4 + +# PARTICLES +nyx.do_dm_particles = 1 + +# >>>>>>>>>>>>> PARTICLE INIT OPTIONS <<<<<<<<<<<<<<<< +# "AsciiFile" "Random" "Cosmological" +# >>>>>>>>>>>>> PARTICLE INIT OPTIONS <<<<<<<<<<<<<<<< +nyx.particle_init_type = BinaryFile +nyx.binary_particle_file = 64sssss_20mpc.nyx +particles.nparts_per_read = 2097152 + +# >>>>>>>>>>>>> PARTICLE MOVE OPTIONS <<<<<<<<<<<<<<<< +# "Gravitational" "Random" +# >>>>>>>>>>>>> PARTICLE MOVE OPTIONS <<<<<<<<<<<<<<<< +nyx.particle_move_type = Gravitational + +# TIME STEP CONTROL +nyx.relative_max_change_a = 0.01 # max change in scale factor +particles.cfl = 0.5 # 'cfl' for particles +nyx.cfl = 0.5 # cfl number for hyperbolic system +nyx.init_shrink = 1.0 # scale back initial timestep +nyx.change_max = 2.0 # factor by which timestep can change +nyx.dt_cutoff = 5.e-20 # level 0 timestep below which we halt + +# DIAGNOSTICS & VERBOSITY +nyx.print_fortran_warnings = 0 +nyx.sum_interval = -1 # timesteps between computing mass +nyx.v = 1 # verbosity in Nyx.cpp +gravity.v = 1 # verbosity in Gravity.cpp +amr.v = 1 # verbosity in Amr.cpp +mg.v = 1 # verbosity in Amr.cpp +particles.v = 2 # verbosity in Particle class + +# REFINEMENT / REGRIDDING +amr.max_level = 2 # maximum level number allowed +amr.ref_ratio = 2 2 2 2 +amr.regrid_int = 4 4 4 4 +amr.n_error_buf = 0 0 0 8 +amr.refine_grid_layout = 1 +amr.regrid_on_restart = 1 +amr.blocking_factor = 16 +#amr.nosub = 1 + +# CHECKPOINT FILES +amr.checkpoint_files_output = 0 +amr.check_file = chk +amr.check_int = 100 +amr.checkpoint_nfiles = 64 + +# PLOTFILES +fab.format = NATIVE_32 +amr.plot_files_output = 1 +amr.plot_file = plt +amr.plot_int = 10 +amr.plot_nfiles = 64 +particles.write_in_plotfile = 1 + +amr.plot_vars = density xmom ymom zmom rho_e Temp phi_grav +amr.derive_plot_vars = particle_mass_density + +#PROBIN FILENAME +amr.probin_file = probin diff --git a/Exec/AMR-density/probdata.f90 b/Exec/AMR-density/probdata.f90 new file mode 100644 index 00000000..5f8b7617 --- /dev/null +++ b/Exec/AMR-density/probdata.f90 @@ -0,0 +1,6 @@ +module probdata_module + +! Tagging variables + integer, save :: max_num_part + +end module probdata_module diff --git a/Exec/AMR-density/probin b/Exec/AMR-density/probin new file mode 100644 index 00000000..230d8100 --- /dev/null +++ b/Exec/AMR-density/probin @@ -0,0 +1,3 @@ +&fortin + max_num_part = 0 +/ diff --git a/Exec/AMR-density/rhsfn.f90 b/Exec/AMR-density/rhsfn.f90 new file mode 100644 index 00000000..952b9506 --- /dev/null +++ b/Exec/AMR-density/rhsfn.f90 @@ -0,0 +1,37 @@ +module rhs + implicit none + + contains + + integer(c_int) function RhsFn(tn, sunvec_y, sunvec_f, user_data) & + result(ierr) bind(C,name='RhsFn') + + use, intrinsic :: iso_c_binding + use fnvector_serial + use cvode_interface + implicit none + + real(c_double), value :: tn + type(c_ptr), value :: sunvec_y + type(c_ptr), value :: sunvec_f + type(c_ptr), value :: user_data + + ! pointers to data in SUNDAILS vectors + real(c_double), pointer :: yvec(:) + real(c_double), pointer :: fvec(:) + + real(c_double) :: energy + + integer(c_long), parameter :: neq = 1 + + ! get data arrays from SUNDIALS vectors + call N_VGetData_Serial(sunvec_y, neq, yvec) + call N_VGetData_Serial(sunvec_f, neq, fvec) + + call f_rhs(1, tn, yvec(1), energy, 0.0, 0) + + fvec(1) = energy + + ierr = 0 + end function RhsFn +end module rhs diff --git a/Exec/AMR-zoom/64_cref_l1.nyx b/Exec/AMR-zoom/64_cref_l1.nyx new file mode 100644 index 00000000..ff77b6b2 Binary files /dev/null and b/Exec/AMR-zoom/64_cref_l1.nyx differ diff --git a/Exec/AMR-zoom/GNUmakefile b/Exec/AMR-zoom/GNUmakefile new file mode 100644 index 00000000..53a57329 --- /dev/null +++ b/Exec/AMR-zoom/GNUmakefile @@ -0,0 +1,40 @@ +# AMREX_HOME defines the directory in which we will find all the AMReX code +AMREX_HOME ?= ../../../amrex + +HPGMG_DIR ?= ../../Util/hpgmg/finite-volume +CVODE_LIB_DIR ?= $(CVODE_LIB) + +# TOP defines the directory in which we will find Source, Exec, etc +TOP = ../.. + +# compilation options +COMP = intel # gnu +USE_MPI = FALSE +USE_OMP = FALSE + +PROFILE = TRUE +TRACE_PROFILE = FALSE +COMM_PROFILE = FALSE +TINY_PROFILE = FALSE + +PRECISION = DOUBLE +USE_SINGLE_PRECISION_PARTICLES = TRUE +DEBUG = FALSE + +GIMLET = FALSE +REEBER = FALSE + +USE_HPGMG = FALSE + +# physics +DIM = 3 +USE_GRAV = TRUE +USE_HEATCOOL = TRUE +USE_AGN = FALSE +USE_CVODE = FALSE + +Bpack := ./Make.package +Blocs := . + +include $(TOP)/Exec/Make.Nyx + diff --git a/Exec/AMR-zoom/Make.package b/Exec/AMR-zoom/Make.package new file mode 100644 index 00000000..13af1531 --- /dev/null +++ b/Exec/AMR-zoom/Make.package @@ -0,0 +1,2 @@ +f90EXE_sources += Prob_${DIM}d.f90 +f90EXE_sources += probdata.f90 diff --git a/Exec/AMR-zoom/Nyx_error.cpp b/Exec/AMR-zoom/Nyx_error.cpp new file mode 100644 index 00000000..723fb724 --- /dev/null +++ b/Exec/AMR-zoom/Nyx_error.cpp @@ -0,0 +1,18 @@ + +#include "Nyx.H" +#include "Nyx_error_F.H" + +using namespace amrex; + +void +Nyx::error_setup() +{ + err_list.add("total_density",1,ErrorRec::UseAverage, + BL_FORT_PROC_CALL(TAG_OVERDENSITY, tag_overdensity)); +} + +void +Nyx::manual_tags_placement (TagBoxArray& tags, + const Vector& bf_lev) +{ +} diff --git a/Exec/AMR-zoom/Prob_3d.f90 b/Exec/AMR-zoom/Prob_3d.f90 new file mode 100644 index 00000000..2e82541f --- /dev/null +++ b/Exec/AMR-zoom/Prob_3d.f90 @@ -0,0 +1,132 @@ + + subroutine amrex_probinit (init,name,namlen,problo,probhi) bind(c) + + use amrex_fort_module, only : rt => amrex_real + use probdata_module + implicit none + + integer init, namlen + integer name(namlen) + real(rt) problo(3), probhi(3) + + integer untin,i + + namelist /fortin/ max_num_part + +! +! Build "probin" filename -- the name of file containing fortin namelist. +! + integer maxlen + parameter (maxlen=256) + character probin*(maxlen) + + if (namlen .gt. maxlen) then + write(6,*) 'probin file name too long' + stop + end if + + do i = 1, namlen + probin(i:i) = char(name(i)) + end do + +! Read namelists + untin = 9 + open(untin,file=probin(1:namlen),form='formatted',status='old') + read(untin,fortin) + close(unit=untin) + + end + +! ::: ----------------------------------------------------------- +! ::: This routine is called at problem setup time and is used +! ::: to initialize data on each grid. +! ::: +! ::: NOTE: all arrays have one cell of ghost zones surrounding +! ::: the grid interior. Values in these cells need not +! ::: be set here. +! ::: +! ::: INPUTS/OUTPUTS: +! ::: +! ::: level => amr level of grid +! ::: time => time at which to init data +! ::: lo,hi => index limits of grid interior (cell centered) +! ::: nstate => number of state components. You should know +! ::: this already! +! ::: state <= Scalar array +! ::: delta => cell size +! ::: xlo,xhi => physical locations of lower left and upper +! ::: right hand corner of grid. (does not include +! ::: ghost region). +! ::: ----------------------------------------------------------- + subroutine fort_initdata(level,time,lo,hi, & + ns, state ,s_l1,s_l2,s_l3,s_h1,s_h2,s_h3, & + nd, diag_eos,d_l1,d_l2,d_l3,d_h1,d_h2,d_h3, & + delta,xlo,xhi) & + bind(C, name="fort_initdata") + + use amrex_fort_module, only : rt => amrex_real + use amrex_parmparse_module + use probdata_module + use atomic_rates_module, only : XHYDROGEN + use meth_params_module, only : URHO, UMX, UMZ, UEDEN, UEINT, UFS, & + small_dens, TEMP_COMP, NE_COMP, ZHI_COMP + + implicit none + + integer level, ns, nd + integer lo(3), hi(3) + integer s_l1,s_l2,s_l3,s_h1,s_h2,s_h3 + integer d_l1,d_l2,d_l3,d_h1,d_h2,d_h3 + real(rt) xlo(3), xhi(3), time, delta(3) + real(rt) state(s_l1:s_h1,s_l2:s_h2,s_l3:s_h3,ns) + real(rt) diag_eos(d_l1:d_h1,d_l2:d_h2,d_l3:d_h3,nd) + + integer i,j,k + real(rt) z_in + + type(amrex_parmparse) :: pp + + call amrex_parmparse_build(pp, "nyx") + call pp%query("initial_z", z_in) + call amrex_parmparse_destroy(pp) + + ! This is the case where we have compiled with states defined + ! but they have only one component each so we fill them this way. + if (ns.eq.1 .and. nd.eq.1) then + + state(:,:,:,1) = 0.0d0 + diag_eos(:,:,:,1) = 0.0d0 + + ! This is the regular case with NO_HYDRO = FALSE + else if (ns.gt.1 .and. nd.ge.2) then + + do k = lo(3), hi(3) + do j = lo(2), hi(2) + do i = lo(1), hi(1) + + state(i,j,k,URHO) = 1.5d0 * small_dens + state(i,j,k,UMX:UMZ) = 0.0d0 + + ! These will both be set later in the call to init_e. + state(i,j,k,UEINT) = 0.d0 + state(i,j,k,UEDEN) = 0.d0 + + if (UFS .gt. -1) then + state(i,j,k,UFS ) = XHYDROGEN + state(i,j,k,UFS+1) = (1.d0 - XHYDROGEN) + end if + + diag_eos(i,j,k,TEMP_COMP) = 0.021d0*(1.0d0 + z_in)**2 + diag_eos(i,j,k, NE_COMP) = 0.d0 + + if (ZHI_COMP .gt. -1) then + diag_eos(i,j,k, ZHI_COMP) = 7.5d0 + endif + + enddo + enddo + enddo + + end if + + end subroutine fort_initdata diff --git a/Exec/AMR-zoom/TREECOOL_middle b/Exec/AMR-zoom/TREECOOL_middle new file mode 100644 index 00000000..c548b2ec --- /dev/null +++ b/Exec/AMR-zoom/TREECOOL_middle @@ -0,0 +1,301 @@ +0.000000 5.700000e-14 3.100000e-14 1.121650e-16 3.560837e-25 4.486095e-25 5.008400e-27 +0.021189 7.131077e-14 3.942314e-14 1.290508e-16 4.465957e-25 5.631802e-25 5.728569e-27 +0.041393 8.817069e-14 4.881653e-14 1.564290e-16 5.546459e-25 6.943841e-25 6.874023e-27 +0.060698 1.080520e-13 6.036742e-14 1.892055e-16 6.806021e-25 8.499327e-25 8.214962e-27 +0.079181 1.313927e-13 7.381091e-14 2.281519e-16 8.287477e-25 1.030083e-24 9.775263e-27 +0.096910 1.574751e-13 8.920400e-14 2.740300e-16 9.950685e-25 1.237482e-24 1.157747e-26 +0.113943 1.870916e-13 1.066446e-13 3.274889e-16 1.184974e-24 1.471890e-24 1.363982e-26 +0.130334 2.201403e-13 1.260925e-13 3.893120e-16 1.397618e-24 1.732952e-24 1.598488e-26 +0.146128 2.558537e-13 1.472511e-13 4.603516e-16 1.627616e-24 2.017452e-24 1.863681e-26 +0.161368 2.977649e-13 1.718511e-13 5.410824e-16 1.893292e-24 2.347358e-24 2.160698e-26 +0.176091 3.428995e-13 1.987396e-13 6.320781e-16 2.183324e-24 2.708677e-24 2.490966e-26 +0.190332 3.912293e-13 2.276695e-13 7.337759e-16 2.493622e-24 3.095318e-24 2.855453e-26 +0.204120 4.463107e-13 2.603846e-13 8.467451e-16 2.838601e-24 3.523196e-24 3.255534e-26 +0.217484 5.046292e-13 2.943905e-13 9.710171e-16 3.208211e-24 3.984673e-24 3.690837e-26 +0.230449 5.642777e-13 3.291591e-13 1.106241e-15 3.588006e-24 4.460281e-24 4.159783e-26 +0.243038 6.309768e-13 3.700881e-13 1.252896e-15 4.013032e-24 4.994599e-24 4.663438e-26 +0.255273 7.003212e-13 4.118066e-13 1.409787e-15 4.451985e-24 5.544954e-24 5.197583e-26 +0.267172 7.734476e-13 4.548221e-13 1.577197e-15 4.911441e-24 6.119276e-24 5.762626e-26 +0.278754 8.509889e-13 5.012864e-13 1.753469e-15 5.402579e-24 6.737064e-24 6.352996e-26 +0.290035 9.292096e-13 5.484886e-13 1.937662e-15 5.899552e-24 7.363681e-24 6.965391e-26 +0.301030 1.014903e-12 6.006439e-13 2.128940e-15 6.455638e-24 8.031408e-24 7.596822e-26 +0.311754 1.100000e-12 6.524997e-13 2.325220e-15 7.009520e-24 8.691806e-24 8.240606e-26 +0.322219 1.122007e-12 6.649298e-13 2.524680e-15 7.152800e-24 8.855698e-24 8.890910e-26 +0.332438 1.137809e-12 6.737611e-13 2.725227e-15 7.256136e-24 8.971874e-24 9.541154e-26 +0.342423 1.145552e-12 6.779476e-13 2.924501e-15 7.292276e-24 9.018775e-24 1.018411e-25 +0.352183 1.154360e-12 6.828133e-13 3.119812e-15 7.336837e-24 9.075818e-24 1.081175e-25 +0.361728 1.162594e-12 6.880686e-13 3.308180e-15 7.389919e-24 9.129358e-24 1.141534e-25 +0.371068 1.173550e-12 6.950557e-13 3.486392e-15 7.462784e-24 9.205408e-24 1.198566e-25 +0.380211 1.187979e-12 7.039418e-13 3.651000e-15 7.551576e-24 9.306058e-24 1.251293e-25 +0.389166 1.198634e-12 7.104930e-13 3.797474e-15 7.612901e-24 9.375911e-24 1.298449e-25 +0.397940 1.207275e-12 7.158272e-13 3.924431e-15 7.664101e-24 9.427544e-24 1.339643e-25 +0.406540 1.213105e-12 7.194667e-13 4.033722e-15 7.705948e-24 9.444720e-24 1.375349e-25 +0.414973 1.216342e-12 7.215532e-13 4.127912e-15 7.730928e-24 9.444007e-24 1.406245e-25 +0.423246 1.219054e-12 7.229159e-13 4.207614e-15 7.750458e-24 9.437258e-24 1.432369e-25 +0.431364 1.219149e-12 7.226487e-13 4.274178e-15 7.752770e-24 9.411277e-24 1.454154e-25 +0.439333 1.221622e-12 7.238018e-13 4.326827e-15 7.768263e-24 9.401333e-24 1.471344e-25 +0.447158 1.218366e-12 7.215375e-13 4.364575e-15 7.740295e-24 9.333136e-24 1.483636e-25 +0.454845 1.222231e-12 7.235103e-13 4.388926e-15 7.757998e-24 9.322051e-24 1.491523e-25 +0.462398 1.220561e-12 7.219019e-13 4.397603e-15 7.745418e-24 9.272144e-24 1.494253e-25 +0.469822 1.209901e-12 7.148017e-13 4.393478e-15 7.678796e-24 9.156752e-24 1.492791e-25 +0.477121 1.199432e-12 7.078630e-13 4.374113e-15 7.613336e-24 9.044882e-24 1.486322e-25 +0.484300 1.193909e-12 7.040435e-13 4.342413e-15 7.575579e-24 8.958947e-24 1.475807e-25 +0.491362 1.190000e-12 7.012368e-13 4.297156e-15 7.547275e-24 8.883588e-24 1.460851e-25 +0.498311 1.178629e-12 6.940542e-13 4.239794e-15 7.471795e-24 8.754437e-24 1.441924e-25 +0.505150 1.160855e-12 6.828258e-13 4.171646e-15 7.359487e-24 8.569961e-24 1.419469e-25 +0.511883 1.150522e-12 6.759325e-13 4.091439e-15 7.295230e-24 8.440136e-24 1.393048e-25 +0.518514 1.136042e-12 6.666341e-13 4.002124e-15 7.204632e-24 8.281918e-24 1.363635e-25 +0.525045 1.123528e-12 6.584897e-13 3.904306e-15 7.121947e-24 8.137490e-24 1.331418e-25 +0.531479 1.115864e-12 6.531880e-13 3.797318e-15 7.067108e-24 8.027796e-24 1.296183e-25 +0.537819 1.095126e-12 6.402568e-13 3.683704e-15 6.929647e-24 7.825678e-24 1.258756e-25 +0.544068 1.072765e-12 6.264631e-13 3.564253e-15 6.785092e-24 7.612582e-24 1.219386e-25 +0.550228 1.061742e-12 6.193867e-13 3.439655e-15 6.716654e-24 7.478913e-24 1.178297e-25 +0.556303 1.046184e-12 6.096776e-13 3.310320e-15 6.619508e-24 7.314394e-24 1.135611e-25 +0.562293 1.036077e-12 6.031568e-13 3.177940e-15 6.556823e-24 7.189026e-24 1.091889e-25 +0.568202 1.022056e-12 5.945533e-13 3.043303e-15 6.470033e-24 7.035863e-24 1.047366e-25 +0.574031 1.005956e-12 5.847470e-13 2.907188e-15 6.370046e-24 6.869274e-24 1.002312e-25 +0.579784 9.912223e-13 5.757424e-13 2.770379e-15 6.278681e-24 6.712955e-24 9.569790e-26 +0.585461 9.680384e-13 5.618682e-13 2.633502e-15 6.132892e-24 6.504294e-24 9.115552e-26 +0.591065 9.544885e-13 5.536352e-13 2.497385e-15 6.046844e-24 6.366674e-24 8.663305e-26 +0.596597 9.306970e-13 5.394692e-13 2.362745e-15 5.895920e-24 6.161646e-24 8.215325e-26 +0.602060 9.143101e-13 5.296034e-13 2.230116e-15 5.791908e-24 6.006705e-24 7.773418e-26 +0.607455 8.991008e-13 5.202923e-13 6.307590e-16 5.694157e-24 5.863423e-24 3.786485e-26 +0.612784 8.823489e-13 5.100061e-13 3.181031e-16 5.585858e-24 5.712746e-24 2.016526e-26 +0.618048 8.751899e-13 5.052654e-13 2.134829e-16 5.538291e-24 5.624235e-24 1.429888e-26 +0.623249 8.637173e-13 4.980317e-13 1.608417e-16 5.463416e-24 5.507808e-24 1.139137e-26 +0.628389 8.528019e-13 4.915248e-13 1.289660e-16 5.396334e-24 5.407943e-24 1.052143e-26 +0.633468 8.428606e-13 4.856804e-13 1.037051e-16 5.336487e-24 5.317448e-24 9.806648e-27 +0.638489 8.382619e-13 4.829132e-13 8.621439e-17 5.310497e-24 5.260379e-24 8.760179e-27 +0.643453 8.336445e-13 4.801335e-13 7.325023e-17 5.284443e-24 5.202720e-24 8.019994e-27 +0.648360 8.267178e-13 4.759967e-13 6.313902e-17 5.244351e-24 5.141382e-24 7.475048e-27 +0.653213 8.196424e-13 4.717560e-13 5.492792e-17 5.203728e-24 5.086392e-24 6.126590e-27 +0.658011 8.135775e-13 4.680948e-13 5.019306e-17 5.169572e-24 5.037542e-24 5.049079e-27 +0.662758 8.065499e-13 4.638777e-13 4.592255e-17 5.129351e-24 4.982595e-24 4.934280e-27 +0.667453 8.027916e-13 4.615450e-13 4.201102e-17 5.109119e-24 4.948612e-24 4.841405e-27 +0.672098 7.961321e-13 4.575691e-13 3.837703e-17 5.066971e-24 4.900394e-24 4.766620e-27 +0.676694 7.886928e-13 4.531439e-13 3.495599e-17 5.019863e-24 4.847315e-24 3.977646e-27 +0.681241 7.815721e-13 4.489005e-13 3.301013e-17 4.974785e-24 4.796134e-24 3.250959e-27 +0.685742 7.747680e-13 4.448374e-13 3.108054e-17 4.931723e-24 4.746826e-24 3.256814e-27 +0.690196 7.690636e-13 4.415922e-13 2.915607e-17 4.898378e-24 4.709738e-24 3.265612e-27 +0.694605 7.642091e-13 4.389615e-13 2.722633e-17 4.872297e-24 4.681562e-24 3.277108e-27 +0.698970 7.569034e-13 4.349242e-13 2.528152e-17 4.830632e-24 4.638383e-24 2.779312e-27 +0.703291 7.496390e-13 4.309116e-13 2.415028e-17 4.789259e-24 4.595466e-24 2.292495e-27 +0.707570 7.426188e-13 4.270404e-13 2.297740e-17 4.749480e-24 4.554057e-24 2.318147e-27 +0.711807 7.358775e-13 4.234541e-13 2.175971e-17 4.710133e-24 4.516890e-24 2.344472e-27 +0.716003 7.254846e-13 4.177967e-13 2.049395e-17 4.647062e-24 4.457929e-24 2.371451e-27 +0.720159 7.152903e-13 4.122517e-13 1.917677e-17 4.585242e-24 4.400158e-24 2.060401e-27 +0.724276 7.051901e-13 4.067590e-13 1.834401e-17 4.524005e-24 4.342938e-24 1.747728e-27 +0.728354 6.953706e-13 4.014265e-13 1.746429e-17 4.464550e-24 4.287421e-24 1.774039e-27 +0.732394 6.824911e-13 3.941022e-13 1.653568e-17 4.386103e-24 4.210623e-24 1.800666e-27 +0.736397 6.764605e-13 3.906762e-13 1.555619e-17 4.351803e-24 4.175464e-24 1.827609e-27 +0.740363 6.671800e-13 3.853730e-13 1.452373e-17 4.296577e-24 4.120238e-24 1.582864e-27 +0.744293 6.580179e-13 3.801378e-13 1.387060e-17 4.242072e-24 4.065723e-24 1.333318e-27 +0.748188 6.544022e-13 3.781067e-13 1.317574e-17 4.223321e-24 4.045477e-24 1.355995e-27 +0.752048 6.481107e-13 3.742073e-13 1.243778e-17 4.185266e-24 4.006934e-24 1.378892e-27 +0.755875 6.441856e-13 3.714595e-13 1.165528e-17 4.161120e-24 3.981845e-24 1.402009e-27 +0.759668 6.390398e-13 3.680078e-13 1.082679e-17 4.129089e-24 3.949210e-24 1.255493e-27 +0.763428 6.353209e-13 3.653779e-13 1.022687e-17 4.106278e-24 3.925395e-24 1.104912e-27 +0.767156 6.297119e-13 3.616611e-13 9.589602e-18 4.071249e-24 3.889899e-24 1.124369e-27 +0.770852 6.265970e-13 3.595083e-13 8.913869e-18 4.052667e-24 3.870932e-24 1.144009e-27 +0.774517 6.224705e-13 3.573013e-13 8.198515e-18 4.028825e-24 3.850199e-24 1.163833e-27 +0.778151 6.193681e-13 3.556826e-13 7.442358e-18 4.011619e-24 3.835816e-24 1.005099e-27 +0.781755 6.051062e-13 3.476532e-13 6.941549e-18 3.922097e-24 3.752257e-24 8.413854e-28 +0.785330 5.877877e-13 3.378617e-13 6.410901e-18 3.812656e-24 3.649568e-24 8.565593e-28 +0.788875 5.676714e-13 3.264544e-13 5.849590e-18 3.684930e-24 3.529277e-24 8.718795e-28 +0.792392 5.495041e-13 3.167119e-13 5.256778e-18 3.571577e-24 3.427850e-24 8.873461e-28 +0.795880 5.363643e-13 3.106727e-13 4.631610e-18 3.493560e-24 3.367904e-24 7.118943e-28 +0.799341 5.169618e-13 3.009645e-13 4.299132e-18 3.374552e-24 3.268043e-24 5.304775e-28 +0.802774 4.995822e-13 2.923781e-13 3.947483e-18 3.268479e-24 3.180164e-24 5.402246e-28 +0.806180 4.877927e-13 2.870282e-13 3.576173e-18 3.198812e-24 3.127367e-24 5.500706e-28 +0.809560 4.759080e-13 2.816036e-13 3.184706e-18 3.128429e-24 3.073691e-24 5.600157e-28 +0.812913 4.623742e-13 2.752620e-13 2.772580e-18 3.047217e-24 3.011775e-24 4.368394e-28 +0.816241 4.520541e-13 2.711678e-13 2.571902e-18 2.987705e-24 2.981882e-24 3.092253e-28 +0.819544 4.443370e-13 2.686641e-13 2.360065e-18 2.945518e-24 2.969691e-24 3.148907e-28 +0.822822 4.345795e-13 2.649609e-13 2.136800e-18 2.889947e-24 2.944484e-24 3.206155e-28 +0.826075 4.272450e-13 2.627744e-13 1.901832e-18 2.850653e-24 2.936413e-24 3.263997e-28 +0.829304 4.200690e-13 2.607429e-13 1.654885e-18 2.812654e-24 2.930479e-24 2.576582e-28 +0.832509 4.130429e-13 2.588692e-13 1.528682e-18 2.775929e-24 2.926771e-24 1.863881e-28 +0.835691 4.062667e-13 2.568159e-13 1.395797e-18 2.739122e-24 2.916111e-24 1.897383e-28 +0.838849 3.995945e-13 2.547881e-13 1.256074e-18 2.702749e-24 2.904734e-24 1.931235e-28 +0.841985 3.930652e-13 2.529187e-13 1.109356e-18 2.667606e-24 2.895517e-24 1.965440e-28 +0.845098 3.847176e-13 2.499429e-13 9.554854e-19 2.620375e-24 2.873967e-24 1.518516e-28 +0.848189 3.667928e-13 2.407400e-13 8.818350e-19 2.507890e-24 2.780786e-24 1.055345e-28 +0.851258 3.528143e-13 2.340834e-13 8.044452e-19 2.422216e-24 2.716796e-24 1.073845e-28 +0.854306 3.393126e-13 2.275320e-13 7.232325e-19 2.338935e-24 2.654234e-24 1.092536e-28 +0.857332 3.274144e-13 2.212584e-13 6.381125e-19 2.263375e-24 2.596005e-24 1.111419e-28 +0.860338 3.155981e-13 2.150280e-13 5.490001e-19 2.188337e-24 2.538177e-24 8.680585e-29 +0.863323 3.038634e-13 2.088406e-13 5.043857e-19 2.113816e-24 2.480749e-24 6.160051e-29 +0.866287 2.922076e-13 2.026948e-13 4.576116e-19 2.039797e-24 2.423706e-24 6.264938e-29 +0.869232 2.806318e-13 1.965913e-13 4.086313e-19 1.966287e-24 2.367056e-24 6.370885e-29 +0.872156 2.691342e-13 1.905289e-13 3.573978e-19 1.893271e-24 2.310788e-24 6.477896e-29 +0.875061 2.581002e-13 1.846475e-13 3.038639e-19 1.822827e-24 2.254911e-24 4.829715e-29 +0.877947 2.486829e-13 1.793655e-13 2.810482e-19 1.761161e-24 2.199478e-24 3.124579e-29 +0.880814 2.393272e-13 1.741182e-13 2.571572e-19 1.699900e-24 2.144408e-24 3.176211e-29 +0.883661 2.300330e-13 1.689053e-13 2.321684e-19 1.639041e-24 2.089699e-24 3.228351e-29 +0.886491 2.207996e-13 1.637267e-13 2.060592e-19 1.578580e-24 2.035351e-24 3.281002e-29 +0.889302 2.116261e-13 1.585815e-13 1.788069e-19 1.518513e-24 1.981352e-24 2.619701e-29 +0.892095 2.025115e-13 1.534694e-13 1.640604e-19 1.458830e-24 1.927701e-24 1.935953e-29 +0.894870 1.934552e-13 1.483901e-13 1.486533e-19 1.399530e-24 1.874395e-24 1.966965e-29 +0.897627 1.860132e-13 1.437805e-13 1.325724e-19 1.349538e-24 1.824350e-24 1.998274e-29 +0.900367 1.790063e-13 1.393093e-13 1.158044e-19 1.302091e-24 1.775350e-24 2.029880e-29 +0.903090 1.720436e-13 1.348662e-13 9.833555e-20 1.254941e-24 1.726661e-24 2.061784e-29 +0.905796 1.651244e-13 1.304507e-13 8.015240e-20 1.208085e-24 1.678274e-24 2.093989e-29 +0.908485 1.582476e-13 1.260626e-13 6.124118e-20 1.161519e-24 1.630186e-24 2.126493e-29 +0.911158 1.514133e-13 1.217015e-13 4.158803e-20 1.115240e-24 1.582395e-24 2.159299e-29 +0.913814 1.446210e-13 1.173673e-13 2.117900e-20 1.069246e-24 1.534897e-24 2.192407e-29 +0.916454 1.378694e-13 1.130588e-13 0.000000e+00 1.023525e-24 1.487683e-24 0.000000e+00 +0.919078 1.326935e-13 1.093997e-13 0.000000e+00 9.870744e-25 1.444549e-24 0.000000e+00 +0.921686 1.275485e-13 1.057624e-13 0.000000e+00 9.508408e-25 1.401672e-24 0.000000e+00 +0.924279 1.224342e-13 1.021468e-13 0.000000e+00 9.148230e-25 1.359051e-24 0.000000e+00 +0.926857 1.173502e-13 9.855261e-14 0.000000e+00 8.790185e-25 1.316683e-24 0.000000e+00 +0.929419 1.122961e-13 9.497961e-14 0.000000e+00 8.434253e-25 1.274565e-24 0.000000e+00 +0.931966 1.072719e-13 9.142766e-14 0.000000e+00 8.080418e-25 1.232694e-24 0.000000e+00 +0.934498 1.022771e-13 8.789657e-14 0.000000e+00 7.728660e-25 1.191069e-24 0.000000e+00 +0.937016 9.731088e-14 8.438562e-14 0.000000e+00 7.378909e-25 1.149682e-24 0.000000e+00 +0.939519 9.371704e-14 8.160445e-14 0.000000e+00 7.115605e-25 1.114961e-24 0.000000e+00 +0.942008 9.014364e-14 7.883910e-14 0.000000e+00 6.853799e-25 1.080437e-24 0.000000e+00 +0.944483 8.659053e-14 7.608948e-14 0.000000e+00 6.593480e-25 1.046108e-24 0.000000e+00 +0.946943 8.305762e-14 7.335546e-14 0.000000e+00 6.334640e-25 1.011975e-24 0.000000e+00 +0.949390 7.954452e-14 7.063678e-14 0.000000e+00 6.077250e-25 9.780345e-25 0.000000e+00 +0.951823 7.605111e-14 6.793334e-14 0.000000e+00 5.821304e-25 9.442834e-25 0.000000e+00 +0.954243 7.257733e-14 6.524508e-14 0.000000e+00 5.566797e-25 9.107219e-25 0.000000e+00 +0.956649 6.912279e-14 6.257172e-14 0.000000e+00 5.313699e-25 8.773464e-25 0.000000e+00 +0.959041 6.628733e-14 6.031097e-14 0.000000e+00 5.105714e-25 8.483019e-25 0.000000e+00 +0.961421 6.386646e-14 5.832717e-14 0.000000e+00 4.927940e-25 8.221747e-25 0.000000e+00 +0.963788 6.145870e-14 5.635417e-14 0.000000e+00 4.751132e-25 7.961892e-25 0.000000e+00 +0.966142 5.906407e-14 5.439189e-14 0.000000e+00 4.575287e-25 7.703451e-25 0.000000e+00 +0.968483 5.668231e-14 5.244018e-14 0.000000e+00 4.400386e-25 7.446403e-25 0.000000e+00 +0.970812 3.834510e-14 4.402700e-14 0.000000e+00 2.595247e-25 0.000000e+00 0.000000e+00 +0.973128 4.188557e-15 4.802124e-15 0.000000e+00 6.018460e-26 0.000000e+00 0.000000e+00 +0.975432 1.865695e-15 2.134670e-15 0.000000e+00 3.180310e-26 0.000000e+00 0.000000e+00 +0.977724 1.174019e-15 1.340458e-15 0.000000e+00 2.064471e-26 0.000000e+00 0.000000e+00 +0.980003 8.471102e-16 9.651459e-16 0.000000e+00 1.519086e-26 0.000000e+00 0.000000e+00 +0.982271 6.565596e-16 7.464321e-16 0.000000e+00 1.200737e-26 0.000000e+00 0.000000e+00 +0.984527 5.315749e-16 6.030196e-16 0.000000e+00 9.923108e-27 0.000000e+00 0.000000e+00 +0.986772 4.431324e-16 5.015781e-16 0.000000e+00 8.451805e-27 0.000000e+00 0.000000e+00 +0.989005 3.771366e-16 4.259206e-16 0.000000e+00 7.356993e-27 0.000000e+00 0.000000e+00 +0.991226 3.259163e-16 3.672376e-16 0.000000e+00 6.509960e-27 0.000000e+00 0.000000e+00 +0.993436 2.849390e-16 3.203243e-16 0.000000e+00 5.834653e-27 0.000000e+00 0.000000e+00 +0.995635 2.513551e-16 2.819082e-16 0.000000e+00 5.283248e-27 0.000000e+00 0.000000e+00 +0.997823 2.232830e-16 2.498288e-16 0.000000e+00 4.824163e-27 0.000000e+00 0.000000e+00 +1.000000 1.994308e-16 2.226022e-16 0.000000e+00 4.435703e-27 0.000000e+00 0.000000e+00 +1.002166 1.788819e-16 1.991761e-16 0.000000e+00 4.102474e-27 0.000000e+00 0.000000e+00 +1.004321 1.609682e-16 1.787834e-16 0.000000e+00 3.813247e-27 0.000000e+00 0.000000e+00 +1.006466 1.451916e-16 1.608518e-16 0.000000e+00 3.559640e-27 0.000000e+00 0.000000e+00 +1.008600 1.311728e-16 1.449461e-16 0.000000e+00 3.335270e-27 0.000000e+00 0.000000e+00 +1.010724 1.186187e-16 1.307295e-16 0.000000e+00 3.135191e-27 0.000000e+00 0.000000e+00 +1.012837 1.072987e-16 1.179375e-16 0.000000e+00 2.955509e-27 0.000000e+00 0.000000e+00 +1.014940 9.702979e-17 1.063595e-16 0.000000e+00 2.743582e-27 0.000000e+00 0.000000e+00 +1.017033 8.802750e-17 9.623278e-17 0.000000e+00 2.495225e-27 0.000000e+00 0.000000e+00 +1.019116 8.019337e-17 8.744034e-17 0.000000e+00 2.264206e-27 0.000000e+00 0.000000e+00 +1.021189 7.332056e-17 7.974478e-17 0.000000e+00 2.063345e-27 0.000000e+00 0.000000e+00 +1.023252 6.724845e-17 7.296182e-17 0.000000e+00 1.887445e-27 0.000000e+00 0.000000e+00 +1.025306 6.185044e-17 6.694622e-17 0.000000e+00 1.732417e-27 0.000000e+00 0.000000e+00 +1.027350 5.702533e-17 6.158191e-17 0.000000e+00 1.595002e-27 0.000000e+00 0.000000e+00 +1.029384 5.269128e-17 5.677508e-17 0.000000e+00 1.472571e-27 0.000000e+00 0.000000e+00 +1.031408 4.878134e-17 5.244901e-17 0.000000e+00 1.362982e-27 0.000000e+00 0.000000e+00 +1.033424 4.524024e-17 4.854037e-17 0.000000e+00 1.264471e-27 0.000000e+00 0.000000e+00 +1.035430 4.202191e-17 4.499644e-17 0.000000e+00 1.175576e-27 0.000000e+00 0.000000e+00 +1.037426 3.908766e-17 4.177292e-17 0.000000e+00 1.095070e-27 0.000000e+00 0.000000e+00 +1.039414 3.640472e-17 3.883237e-17 0.000000e+00 1.021924e-27 0.000000e+00 0.000000e+00 +1.041393 2.545887e-17 2.710715e-17 0.000000e+00 9.552614e-28 0.000000e+00 0.000000e+00 +1.043362 2.376379e-17 2.525780e-17 0.000000e+00 8.943373e-28 0.000000e+00 0.000000e+00 +1.045323 2.220278e-17 2.355856e-17 0.000000e+00 8.385110e-28 0.000000e+00 0.000000e+00 +1.047275 2.076240e-17 2.199408e-17 0.000000e+00 7.872305e-28 0.000000e+00 0.000000e+00 +1.049218 1.943092e-17 2.055102e-17 0.000000e+00 7.400175e-28 0.000000e+00 0.000000e+00 +1.051153 1.819806e-17 1.921769e-17 0.000000e+00 6.964559e-28 0.000000e+00 0.000000e+00 +1.053078 1.705478e-17 1.798381e-17 0.000000e+00 6.561819e-28 0.000000e+00 0.000000e+00 +1.054996 1.599309e-17 1.684033e-17 0.000000e+00 6.188765e-28 0.000000e+00 0.000000e+00 +1.056905 1.500588e-17 1.577919e-17 0.000000e+00 5.842588e-28 0.000000e+00 0.000000e+00 +1.058805 1.408684e-17 1.479325e-17 0.000000e+00 5.520808e-28 0.000000e+00 0.000000e+00 +1.060698 1.323032e-17 1.387614e-17 0.000000e+00 5.221225e-28 0.000000e+00 0.000000e+00 +1.062582 1.243127e-17 1.302215e-17 0.000000e+00 4.941885e-28 0.000000e+00 0.000000e+00 +1.064458 1.168513e-17 1.222615e-17 0.000000e+00 4.681045e-28 0.000000e+00 0.000000e+00 +1.066326 1.098779e-17 1.148352e-17 0.000000e+00 4.437148e-28 0.000000e+00 0.000000e+00 +1.068186 1.033555e-17 1.079010e-17 0.000000e+00 4.208798e-28 0.000000e+00 0.000000e+00 +1.070038 9.725022e-18 1.014211e-17 0.000000e+00 3.994742e-28 0.000000e+00 0.000000e+00 +1.071882 9.153161e-18 9.536141e-18 0.000000e+00 3.793849e-28 0.000000e+00 0.000000e+00 +1.073718 8.617175e-18 8.969074e-18 0.000000e+00 3.605101e-28 0.000000e+00 0.000000e+00 +1.075547 8.114517e-18 8.438075e-18 0.000000e+00 3.427577e-28 0.000000e+00 0.000000e+00 +1.077368 7.642860e-18 7.940556e-18 0.000000e+00 3.260441e-28 0.000000e+00 0.000000e+00 +1.079181 7.200066e-18 7.474148e-18 0.000000e+00 3.102934e-28 0.000000e+00 0.000000e+00 +1.080987 6.784177e-18 7.036681e-18 0.000000e+00 2.954367e-28 0.000000e+00 0.000000e+00 +1.082785 6.393389e-18 6.626162e-18 0.000000e+00 2.814110e-28 0.000000e+00 0.000000e+00 +1.084576 6.026038e-18 6.240760e-18 0.000000e+00 2.681590e-28 0.000000e+00 0.000000e+00 +1.086360 5.680592e-18 5.878787e-18 0.000000e+00 2.556281e-28 0.000000e+00 0.000000e+00 +1.088136 5.355632e-18 5.538686e-18 0.000000e+00 2.437701e-28 0.000000e+00 0.000000e+00 +1.089905 5.049847e-18 5.219021e-18 0.000000e+00 2.325410e-28 0.000000e+00 0.000000e+00 +1.091667 4.762020e-18 4.918463e-18 0.000000e+00 2.219002e-28 0.000000e+00 0.000000e+00 +1.093422 4.491023e-18 4.635780e-18 0.000000e+00 2.118103e-28 0.000000e+00 0.000000e+00 +1.095169 4.235808e-18 4.369832e-18 0.000000e+00 2.022369e-28 0.000000e+00 0.000000e+00 +1.096910 3.995401e-18 4.119560e-18 0.000000e+00 1.931483e-28 0.000000e+00 0.000000e+00 +1.098644 3.768894e-18 3.883981e-18 0.000000e+00 1.845150e-28 0.000000e+00 0.000000e+00 +1.100371 3.555441e-18 3.662180e-18 0.000000e+00 1.763099e-28 0.000000e+00 0.000000e+00 +1.102091 3.354254e-18 3.453305e-18 0.000000e+00 1.685079e-28 0.000000e+00 0.000000e+00 +1.103804 3.164596e-18 3.256564e-18 0.000000e+00 1.610855e-28 0.000000e+00 0.000000e+00 +1.105510 2.985780e-18 3.071217e-18 0.000000e+00 1.540212e-28 0.000000e+00 0.000000e+00 +1.107210 2.817162e-18 2.896573e-18 0.000000e+00 1.472945e-28 0.000000e+00 0.000000e+00 +1.108903 2.658141e-18 2.731988e-18 0.000000e+00 1.408869e-28 0.000000e+00 0.000000e+00 +1.110590 2.508153e-18 2.576860e-18 0.000000e+00 1.347807e-28 0.000000e+00 0.000000e+00 +1.112270 2.366670e-18 2.430625e-18 0.000000e+00 1.289597e-28 0.000000e+00 0.000000e+00 +1.113943 2.233198e-18 2.292757e-18 0.000000e+00 1.234084e-28 0.000000e+00 0.000000e+00 +1.115611 2.107271e-18 2.162761e-18 0.000000e+00 1.181128e-28 0.000000e+00 0.000000e+00 +1.117271 1.988454e-18 2.040175e-18 0.000000e+00 1.130593e-28 0.000000e+00 0.000000e+00 +1.118926 1.876339e-18 1.924565e-18 0.000000e+00 1.082354e-28 0.000000e+00 0.000000e+00 +1.120574 1.770540e-18 1.815525e-18 0.000000e+00 1.036294e-28 0.000000e+00 0.000000e+00 +1.122216 1.670697e-18 1.712674e-18 0.000000e+00 9.923029e-29 0.000000e+00 0.000000e+00 +1.123852 1.576469e-18 1.615653e-18 0.000000e+00 9.502763e-29 0.000000e+00 0.000000e+00 +1.125481 1.487538e-18 1.524125e-18 0.000000e+00 9.101169e-29 0.000000e+00 0.000000e+00 +1.127105 1.403603e-18 1.437776e-18 0.000000e+00 8.717329e-29 0.000000e+00 0.000000e+00 +1.128722 1.324380e-18 1.356307e-18 0.000000e+00 8.350379e-29 0.000000e+00 0.000000e+00 +1.130334 1.249604e-18 1.279439e-18 0.000000e+00 7.999501e-29 0.000000e+00 0.000000e+00 +1.131939 1.179024e-18 1.206910e-18 0.000000e+00 7.663928e-29 0.000000e+00 0.000000e+00 +1.133539 1.112403e-18 1.138472e-18 0.000000e+00 7.342931e-29 0.000000e+00 0.000000e+00 +1.135133 1.049518e-18 1.073893e-18 0.000000e+00 7.035825e-29 0.000000e+00 0.000000e+00 +1.136721 0.000000e+00 1.012954e-18 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.138303 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.139879 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.141450 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.143015 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.144574 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.146128 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.147676 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.149219 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.150756 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.152288 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.153815 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.155336 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.156852 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.158362 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.159868 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.161368 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.162863 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.164353 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.165838 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.167317 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.168792 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.170262 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.171726 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.173186 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.174641 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.176091 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.177536 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.178977 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.180413 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.181844 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.183270 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.184691 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.186108 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.187521 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.188928 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.190332 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.191730 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.193125 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.194514 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.195900 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.197281 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.198657 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.200029 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.201397 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.202761 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.204120 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 diff --git a/Exec/AMR-zoom/Tagging_3d.f90 b/Exec/AMR-zoom/Tagging_3d.f90 new file mode 100644 index 00000000..06196c5d --- /dev/null +++ b/Exec/AMR-zoom/Tagging_3d.f90 @@ -0,0 +1,48 @@ +! ::: ----------------------------------------------------------- +! ::: This routine will tag cells based on position +! ::: +! ::: INPUTS/OUTPUTS: +! ::: +! ::: tag <= integer tag array +! ::: lo,hi => index extent of tag array +! ::: set => integer value to tag cell for refinement +! ::: clear => integer value to untag cell +! ::: den => density array +! ::: nc => number of components in density array +! ::: domlo,hi => index extent of problem domain +! ::: delta => cell spacing +! ::: xlo => physical location of lower left hand +! ::: corner of tag array +! ::: problo => phys loc of lower left corner of prob domain +! ::: time => problem evolution time +! ::: level => refinement level of this array +! ::: ----------------------------------------------------------- + subroutine tag_overdensity(tag,tagl1,tagl2,tagl3,tagh1,tagh2,tagh3, & + set,clear, & + den,denl1,denl2,denl3,denh1,denh2,denh3, & + lo,hi,nc,domlo,domhi,delta,level,avg_den) + + use amrex_fort_module, only : rt => amrex_real + use probdata_module + implicit none + + integer :: set, clear, nc, level + integer :: tagl1,tagl2,tagl3,tagh1,tagh2,tagh3 + integer :: denl1,denl2,denl3,denh1,denh2,denh3 + integer :: lo(3), hi(3), domlo(3), domhi(3) + integer :: tag(tagl1:tagh1,tagl2:tagh2,tagl3:tagh3) + real(rt) :: den(denl1:denh1,denl2:denh2,denl3:denh3,nc) + real(rt) :: delta(3), avg_den + + integer :: i,j,k + integer :: ref_size(3), center(3), ilo(3), ihi(3) + + ref_size = domhi / (2*2**(level+1)) + center = (domhi-domlo+1) / 2 + ilo = max(center-ref_size+1, lo) + ihi = min(center+ref_size, hi) + + ! Tag the region + tag(ilo(1):ihi(1),ilo(2):ihi(2),ilo(3):ihi(3)) = set + + end subroutine tag_overdensity diff --git a/Exec/AMR-zoom/inputs b/Exec/AMR-zoom/inputs new file mode 100644 index 00000000..10647498 --- /dev/null +++ b/Exec/AMR-zoom/inputs @@ -0,0 +1,164 @@ +# ------------------ INPUTS TO MAIN PROGRAM ------------------- +max_step = 10000000 + +amr.mffile_nstreams = 4 +amr.precreateDirectories = 1 +amr.prereadFAHeaders = 1 +#amr.plot_headerversion = 1 +amr.checkpoint_headerversion = 2 + +#### vismf.headerversion = 2 +vismf.groupsets = 0 +vismf.setbuf = 1 +vismf.usesingleread = 1 +vismf.usesinglewrite = 1 +vismf.checkfilepositions = 1 +vismf.usepersistentifstreams = 1 +vismf.usesynchronousreads = 0 +vismf.usedynamicsetselection = 1 + + +nyx.ppm_type = 1 +nyx.ppm_reference = 1 +nyx.use_colglaz = 0 +nyx.corner_coupling = 1 + +nyx.strang_split = 1 +nyx.add_ext_src = 1 +nyx.heat_cool_type = 3 +#nyx.simd_width = 8 + +nyx.small_dens = 1.e-2 +nyx.small_temp = 1.e-2 + +nyx.do_santa_barbara = 1 +nyx.init_sb_vels = 1 +gravity.ml_tol = 1.e-10 +gravity.sl_tol = 1.e-10 + +nyx.initial_z = 159.0 +nyx.final_z = 2.0 + +#File written during the run: nstep | time | dt | redshift | a +amr.data_log = runlog +#amr.grid_log = grdlog + +#This is how we restart from a checkpoint and write an ascii particle file +#Leave this commented out in cvs version +#amr.restart = chk00100 +#max_step = 4 +#particles.particle_output_file = particle_output + +gravity.gravity_type = PoissonGrav +gravity.no_sync = 1 +gravity.no_composite = 1 +gravity.solve_with_mlmg = 1 +gravity.solve_with_hpgmg = 0 + +mg.bottom_solver = 4 + +# PROBLEM SIZE & GEOMETRY +geometry.is_periodic = 1 1 1 +geometry.coord_sys = 0 + +geometry.prob_lo = 0 0 0 + +#Domain size in Mpc +geometry.prob_hi = 59.667143854649644 59.667143854649644 59.667143854649644 + +amr.n_cell = 64 64 64 +amr.max_grid_size = 32 +fabarray.mfiter_tile_size = 1024000 8 8 + +# >>>>>>>>>>>>> BC FLAGS <<<<<<<<<<<<<<<< +# 0 = Interior 3 = Symmetry +# 1 = Inflow 4 = SlipWall +# 2 = Outflow +# >>>>>>>>>>>>> BC FLAGS <<<<<<<<<<<<<<<< +nyx.lo_bc = 0 0 0 +nyx.hi_bc = 0 0 0 + +# WHICH PHYSICS +nyx.do_hydro = 1 +nyx.do_grav = 1 + +# COSMOLOGY +nyx.comoving_OmM = 0.319181 +nyx.comoving_OmB = 0.049648 +nyx.comoving_h = 0.6703857 + +# UVB and reionization +nyx.inhomo_reion = 0 +nyx.inhomo_zhi_file = "zhi.bin" +nyx.inhomo_grid = 512 +nyx.uvb_rates_file = "TREECOOL_middle" +nyx.uvb_density_A = 1.0 +nyx.uvb_density_B = 0.0 +nyx.reionization_zHI_flash = -1.0 +nyx.reionization_zHeII_flash = -1.0 +nyx.reionization_T_zHI = 2.0e4 +nyx.reionization_T_zHeII = 1.5e4 + +# PARTICLES +nyx.do_dm_particles = 1 + +# >>>>>>>>>>>>> PARTICLE INIT OPTIONS <<<<<<<<<<<<<<<< +# "AsciiFile" "Random" "Cosmological" +# >>>>>>>>>>>>> PARTICLE INIT OPTIONS <<<<<<<<<<<<<<<< +nyx.particle_init_type = BinaryFile +nyx.binary_particle_file = 64_cref_l1.nyx +particles.nparts_per_read = 2097152 + +# >>>>>>>>>>>>> PARTICLE MOVE OPTIONS <<<<<<<<<<<<<<<< +# "Gravitational" "Random" +# >>>>>>>>>>>>> PARTICLE MOVE OPTIONS <<<<<<<<<<<<<<<< +nyx.particle_move_type = Gravitational + +# TIME STEP CONTROL +nyx.relative_max_change_a = 0.01 # max change in scale factor +particles.cfl = 0.5 # 'cfl' for particles +nyx.cfl = 0.5 # cfl number for hyperbolic system +nyx.init_shrink = 1.0 # scale back initial timestep +nyx.change_max = 2.0 # factor by which timestep can change +nyx.dt_cutoff = 5.e-20 # level 0 timestep below which we halt + +# DIAGNOSTICS & VERBOSITY +nyx.print_fortran_warnings = 0 +nyx.sum_interval = -1 # timesteps between computing mass +nyx.v = 1 # verbosity in Nyx.cpp +gravity.v = 1 # verbosity in Gravity.cpp +amr.v = 1 # verbosity in Amr.cpp +mg.v = 1 # verbosity in Amr.cpp +particles.v = 2 # verbosity in Particle class + +# REFINEMENT / REGRIDDING +amr.max_level = 1 # maximum level number allowed, base grid = 0 +amr.ref_ratio = 2 2 2 2 # refinement ratio at different levels: 2 or 4 +amr.blocking_factor = 16 # min grid size +amr.subcycling_mode = Auto # Auto or None + +amr.regrid_int = 2 2 2 2 +amr.n_error_buf = 2 2 2 2 +amr.refine_grid_layout = 1 +amr.regrid_on_restart = 1 + +# CHECKPOINT FILES +amr.checkpoint_files_output = 1 +amr.check_file = chk +amr.check_int = 100 +amr.checkpoint_nfiles = 64 + +# PLOTFILES +fab.format = NATIVE_32 +amr.plot_files_output = 0 +amr.plot_file = plt +amr.plot_int = -1 +amr.plot_nfiles = 64 +nyx.plot_z_values = 7.0 6.0 5.0 4.0 3.0 2.0 +particles.write_in_plotfile = 1 + +amr.plot_vars = density xmom ymom zmom rho_e Temp phi_grav +amr.derive_plot_vars = particle_mass_density + +#PROBIN FILENAME +amr.probin_file = probin diff --git a/Exec/AMR-zoom/probdata.f90 b/Exec/AMR-zoom/probdata.f90 new file mode 100644 index 00000000..5f8b7617 --- /dev/null +++ b/Exec/AMR-zoom/probdata.f90 @@ -0,0 +1,6 @@ +module probdata_module + +! Tagging variables + integer, save :: max_num_part + +end module probdata_module diff --git a/Exec/AMR-zoom/probin b/Exec/AMR-zoom/probin new file mode 100644 index 00000000..230d8100 --- /dev/null +++ b/Exec/AMR-zoom/probin @@ -0,0 +1,3 @@ +&fortin + max_num_part = 0 +/ diff --git a/Exec/AMR-zoom/rhsfn.f90 b/Exec/AMR-zoom/rhsfn.f90 new file mode 100644 index 00000000..952b9506 --- /dev/null +++ b/Exec/AMR-zoom/rhsfn.f90 @@ -0,0 +1,37 @@ +module rhs + implicit none + + contains + + integer(c_int) function RhsFn(tn, sunvec_y, sunvec_f, user_data) & + result(ierr) bind(C,name='RhsFn') + + use, intrinsic :: iso_c_binding + use fnvector_serial + use cvode_interface + implicit none + + real(c_double), value :: tn + type(c_ptr), value :: sunvec_y + type(c_ptr), value :: sunvec_f + type(c_ptr), value :: user_data + + ! pointers to data in SUNDAILS vectors + real(c_double), pointer :: yvec(:) + real(c_double), pointer :: fvec(:) + + real(c_double) :: energy + + integer(c_long), parameter :: neq = 1 + + ! get data arrays from SUNDIALS vectors + call N_VGetData_Serial(sunvec_y, neq, yvec) + call N_VGetData_Serial(sunvec_f, neq, fvec) + + call f_rhs(1, tn, yvec(1), energy, 0.0, 0) + + fvec(1) = energy + + ierr = 0 + end function RhsFn +end module rhs diff --git a/Exec/HydroTests/TurbForce/Nyx_setup.cpp b/Exec/HydroTests/TurbForce/Nyx_setup.cpp index f272895d..288adece 100644 --- a/Exec/HydroTests/TurbForce/Nyx_setup.cpp +++ b/Exec/HydroTests/TurbForce/Nyx_setup.cpp @@ -131,46 +131,6 @@ Nyx::variable_setup() error_setup(); } -void -Nyx::variable_setup_for_new_comp_procs() -{ -std::cout << "***** fix Nyx::variable_setup_for_new_comp_procs()" << std::endl; -/* - BL_ASSERT(desc_lst.size() == 0); -// desc_lst.clear(); -// derive_lst.clear(); - - // Initialize the network - network_init(); - - - - - // Get options, set phys_bc - read_params(); - -#ifdef NO_HYDRO - no_hydro_setup(); - -#else - if (do_hydro == 1) - { - hydro_setup(); - } -#ifdef GRAVITY - else - { - no_hydro_setup(); - } -#endif -#endif - - // - // DEFINE ERROR ESTIMATION QUANTITIES - // - error_setup(); -*/ -} #ifndef NO_HYDRO void diff --git a/Exec/LyA/inputs.rt b/Exec/LyA/inputs.rt index d78fa0de..5466fd61 100644 --- a/Exec/LyA/inputs.rt +++ b/Exec/LyA/inputs.rt @@ -37,6 +37,8 @@ gravity.gravity_type = PoissonGrav gravity.no_sync = 1 gravity.no_composite = 1 +gravity.use_mlmg_solver = 1 + mg.bottom_solver = 4 # PROBLEM SIZE & GEOMETRY diff --git a/Exec/LyA/inputs.small.dsc b/Exec/LyA/inputs.small.dsc index 8b4009fe..6e87d2da 100644 --- a/Exec/LyA/inputs.small.dsc +++ b/Exec/LyA/inputs.small.dsc @@ -1,6 +1,3 @@ -# This is an example script that shows how to run a small Nyx problem with -# sidecars doing post-processing. The sidecar-specific parameters are at the -# end of the inputs file. # ------------------ INPUTS TO MAIN PROGRAM ------------------- max_step = 20 @@ -132,29 +129,3 @@ amr.derive_plot_vars = particle_count particle_mass_density pressure magvel #PROBIN FILENAME amr.probin_file = probin -# >>>>>>>>>>>>>>>>>>>> SIDECARS <<<<<<<<<<<<<<<<<<<< -# how many MPI procs to use for sidecars? -# Reeber needs at least 8. -nSidecars = 8 -# how to distribute grids on sidecar procs? "2" means random -how = 2 -# time step interval for doing Gimlet analysis -nyx.gimlet_int = 5 - -# Parameters to Reeber. Remember that nyx.halo_int and reeber.halo_int need to -# be the same. -reeber.halo_int = 5 -reeber.component = 0 -reeber.negate = 1 -reeber.merge_tree_file = merge-tree-density -reeber.merge_tree_int = 10 -reeber.compute_persistence_diagram = 1 -reeber.persistence_diagram_file = persistence-diagram-density -reeber.persistence_diagram_int = 1 -reeber.persistence_diagram_eps = 1.0e9 -reeber.compute_halos = 1 -reeber.halo_extrema_threshold = 7.0e9 -reeber.halo_component_threshold = 6.0e9 -reeber.halo_extrema_threshold = 7.5e9 -reeber.halo_component_threshold = 7.0e9 -# >>>>>>>>>>>>>>>>>>>> SIDECARS <<<<<<<<<<<<<<<<<<<< diff --git a/Exec/LyA/inputs_gimlet_in_transit.dsc b/Exec/LyA/inputs_gimlet_in_transit.dsc index ef3ceca4..3b50c947 100644 --- a/Exec/LyA/inputs_gimlet_in_transit.dsc +++ b/Exec/LyA/inputs_gimlet_in_transit.dsc @@ -1,6 +1,3 @@ -# This is an example script that shows how to run a larger Nyx problem with -# sidecars doing post-processing. The sidecar-specific parameters are at the -# end of the inputs file. # ------------------ INPUTS TO MAIN PROGRAM ------------------- max_step = 400 @@ -138,11 +135,3 @@ amr.plot_vars = density #PROBIN FILENAME amr.probin_file = probin -# >>>>>>>>>>>>>>>>>>>> SIDECARS <<<<<<<<<<<<<<<<<<<< -# how many MPI procs to use for sidecars? -nSidecars = 256 -# how to distribute grids on sidecar procs? "2" means random -how = 2 -# time step interval for doing Gimlet analysis -nyx.gimlet_int = 5 -# >>>>>>>>>>>>>>>>>>>> SIDECARS <<<<<<<<<<<<<<<<<<<< diff --git a/Exec/Make.Nyx b/Exec/Make.Nyx index c229a201..6e381454 100644 --- a/Exec/Make.Nyx +++ b/Exec/Make.Nyx @@ -2,6 +2,16 @@ EBASE = Nyx USE_PARTICLES = TRUE +ifeq ($(USE_HPGMG), TRUE) + HPGMG_F_CYCLES = 20 + HPGMG_V_CYCLES = 0 + HPGMG_HELMHOLTZ = FALSE + HPGMG_STENCIL_VARIABLE_COEFFICIENT = FALSE + HPGMG_USE_SUBCOMM = TRUE + HPGMG_BOTTOM_SOLVER= CG + HPGMG_SMOOTHER = GSRB +endif + include $(AMREX_HOME)/Tools/GNUMake/Make.defs NYX = TRUE @@ -13,6 +23,10 @@ ifeq ($(USE_SINGLE_PRECISION_PARTICLES), TRUE) DEFINES += -DBL_SINGLE_PRECISION_PARTICLES endif +ifeq ($(USE_HENSON), TRUE) + DEFINES += -DHENSON +endif + ifeq ($(USE_GRAV), TRUE) DEFINES += -DGRAVITY endif @@ -107,9 +121,6 @@ include $(Bpack) INCLUDE_LOCATIONS += $(Blocs) VPATH_LOCATIONS += $(Blocs) -#INCLUDE_LOCATIONS += $(TOP)/Source/MG -#VPATH_LOCATIONS += $(TOP)/Source/MG - #These are the directories in AMReX Pdirs := Base AmrCore Amr Boundary Particle Extern/amrdata @@ -128,29 +139,15 @@ USE_MG = FALSE ifeq ($(USE_GRAV), TRUE) USE_MG = TRUE endif - -ifeq ($(USE_MG), TRUE) - include $(AMREX_HOME)/Src/LinearSolvers/C_to_F_MG/Make.package - INCLUDE_LOCATIONS += $(AMREX_HOME)/Src/LinearSolvers/C_to_F_MG - VPATH_LOCATIONS += $(AMREX_HOME)/Src/LinearSolvers/C_to_F_MG +ifeq ($(USE_MG), TRUE) include $(AMREX_HOME)/Src/LinearSolvers/C_CellMG/Make.package INCLUDE_LOCATIONS += $(AMREX_HOME)/Src/LinearSolvers/C_CellMG VPATH_LOCATIONS += $(AMREX_HOME)/Src/LinearSolvers/C_CellMG - include $(AMREX_HOME)/Src/LinearSolvers/F_MG/FParallelMG.mak - INCLUDE_LOCATIONS += $(AMREX_HOME)/Src/LinearSolvers/F_MG - VPATH_LOCATIONS += $(AMREX_HOME)/Src/LinearSolvers/F_MG -endif - -ifeq ($(USE_HPGMG), TRUE) - HPGMG_F_CYCLES = 20 - HPGMG_V_CYCLES = 0 - HPGMG_HELMHOLTZ = FALSE - HPGMG_STENCIL_VARIABLE_COEFFICIENT = FALSE - HPGMG_USE_SUBCOMM = TRUE - HPGMG_BOTTOM_SOLVER= CG - HPGMG_SMOOTHER = GSRB + include $(AMREX_HOME)/Src/LinearSolvers/MLMG/Make.package + INCLUDE_LOCATIONS += $(AMREX_HOME)/Src/LinearSolvers/MLMG + VPATH_LOCATIONS += $(AMREX_HOME)/Src/LinearSolvers/MLMG endif include $(AMREX_HOME)/Src/F_BaseLib/FParallelMG.mak diff --git a/Exec/MiniSB/inputs.32 b/Exec/MiniSB/inputs.32 index 88ca697b..6f79108b 100644 --- a/Exec/MiniSB/inputs.32 +++ b/Exec/MiniSB/inputs.32 @@ -29,6 +29,7 @@ gravity.gravity_type = PoissonGrav gravity.no_sync = 1 gravity.no_composite = 1 gravity.solve_with_hpgmg = 0 +gravity.use_mlmg_solver = 1 mg.bottom_solver = 1 diff --git a/Exec/MiniSB/inputs.32.ref b/Exec/MiniSB/inputs.32.ref index 23cebc8c..66ffe36b 100644 --- a/Exec/MiniSB/inputs.32.ref +++ b/Exec/MiniSB/inputs.32.ref @@ -30,6 +30,7 @@ amr.data_log = runlog gravity.gravity_type = PoissonGrav gravity.no_sync = 1 gravity.no_composite = 1 +gravity.use_mlmg_solver = 1 mg.bottom_solver = 1 diff --git a/Source/AGN/agn_3d.f90 b/Source/AGN/agn_3d.f90 index 214e27b0..02b4b907 100644 --- a/Source/AGN/agn_3d.f90 +++ b/Source/AGN/agn_3d.f90 @@ -21,6 +21,9 @@ subroutine nyx_compute_overlap(np, particles, ng, ghosts, delta_x) & r2 = sum((particles(i)%pos - particles(j)%pos)**2) if (r2 <= cutoff*cutoff) then + ! print *, "found overlap particles", particles(i)%id, particles(j)%id + ! If one of the particles is already invalidated, don't do anything + if (particles(i)%id .eq. -1 .or. particles(j)%id .eq. -1) cycle ! We only remove the newer (aka of lower mass) particle if (particles(i)%mass .lt. particles(j)%mass) then particles(i)%id = -1 @@ -38,7 +41,7 @@ subroutine nyx_compute_overlap(np, particles, ng, ghosts, delta_x) & r2 = sum((particles(i)%pos - ghosts(j)%pos)**2) if (r2 <= cutoff*cutoff) then - + ! print *, "found overlap ghost particles", particles(i)%id, ghosts(j)%id ! We only remove a particle if it is both 1) valid 2) newer (aka of lower mass) if (particles(i)%mass .lt. ghosts(j)%mass) then particles(i)%id = -1 @@ -69,12 +72,13 @@ subroutine agn_merge_particles(np, particles, ng, ghosts, delta_x) & type(agn_particle_t), intent(in ) :: ghosts(ng) real(amrex_real) , intent(in ) :: delta_x(3) - real(amrex_real) r2, vrelsq, r + real(amrex_real) r2, vrelsq, r, mergetime real(amrex_real) cutoff, larger_mass integer i, j - cutoff = delta_x(1) - + cutoff = 2. * delta_x(1) + mergetime = 10. *3.154*1e13 /3.086e19 + do i = 1, np do j = i+1, np @@ -89,8 +93,11 @@ subroutine agn_merge_particles(np, particles, ng, ghosts, delta_x) & larger_mass = max(particles(i)%mass, particles(j)%mass) r = sqrt(r2) - if ( (vrelsq * r) < Gconst * larger_mass) then - + !if ( (vrelsq * r) < Gconst * larger_mass) then + if ( sqrt(vrelsq) * mergetime < r) then + !print *, "found merging particles", particles(i)%id, particles(j)%id + ! If one of the particles is already invalidated, don't do anything + if (particles(i)%id .eq. -1 .or. particles(j)%id .eq. -1) cycle ! Merge lighter particle into heavier one. ! Set particle ID of lighter particle to -1 if (particles(i)%mass >= particles(j)%mass) then @@ -107,6 +114,7 @@ subroutine agn_merge_particles(np, particles, ng, ghosts, delta_x) & end do end do + !this is merging ghost particles do i = 1, np do j = 1, ng @@ -118,8 +126,9 @@ subroutine agn_merge_particles(np, particles, ng, ghosts, delta_x) & larger_mass = max(particles(i)%mass, ghosts(j)%mass) - if ( (vrelsq * r2) < (Gconst * larger_mass)**2) then - + !if ( (vrelsq * sqrt(r2)) < Gconst * larger_mass) then + if ( sqrt(vrelsq) * mergetime < sqrt(r2) ) then + !print *, "found merging ghost particles", particles(i)%id, ghosts(j)%id if (particles(i)%mass > ghosts(j)%mass) then ! The bigger particle "i" is in the valid region, ! so we put all the mass onto it. @@ -213,6 +222,7 @@ subroutine agn_particle_velocity(np, particles, & momz = sum((state_new(i-1:i+1, j-1:j+1, k-1:k+1, UMZ) - & state_old(i-1:i+1, j-1:j+1, k-1:k+1, UMZ)) * weight) * vol + !print *, "momentums", n, momx, momy, momz mass = particles(n)%mass ! Update velocity of particle so as to reduce momentum in the amount diff --git a/Source/AGNParticleContainer.H b/Source/AGNParticleContainer.H index ba3d0ef1..ccb11b26 100644 --- a/Source/AGNParticleContainer.H +++ b/Source/AGNParticleContainer.H @@ -4,54 +4,30 @@ #include #include -#include "AMReX_Particles.H" +#include +#include #include "NyxParticleContainer.H" -namespace { - -struct NeighborCommTag { - - NeighborCommTag(int pid, int gid, int tid) - : proc_id(pid), grid_id(gid), tile_id(tid) - {} - - int proc_id; - int grid_id; - int tile_id; -}; - -bool operator<(const NeighborCommTag& l, const NeighborCommTag& r) { - return (l.proc_id < r.proc_id || - (l.proc_id == r.proc_id && l.grid_id < r.grid_id) || - (l.proc_id == r.proc_id && l.grid_id == r.grid_id && l.tile_id < r.tile_id )); -} - -} - class AGNParticleContainer - : public NyxParticleContainer<3+BL_SPACEDIM> + : public NyxParticleContainer<3+BL_SPACEDIM, 0, 0, 0> { public: - + using MyParIter = amrex::ParIter<3+BL_SPACEDIM>; - using PairIndex = std::pair; - using NeighborCommMap = std::map >; AGNParticleContainer (amrex::Amr* amr, int nghost) - : NyxParticleContainer<3+BL_SPACEDIM>(amr), - mask_defined(false), - ng(nghost) + : NyxParticleContainer<3+BL_SPACEDIM>(amr, nghost) { - real_comp_names.clear(); - real_comp_names.push_back("mass"); - real_comp_names.push_back("xvel"); - real_comp_names.push_back("yvel"); - real_comp_names.push_back("zvel"); - real_comp_names.push_back("energy"); - real_comp_names.push_back("mdot"); + real_comp_names.clear(); + real_comp_names.push_back("mass"); + real_comp_names.push_back("xvel"); + real_comp_names.push_back("yvel"); + real_comp_names.push_back("zvel"); + real_comp_names.push_back("energy"); + real_comp_names.push_back("mdot"); } - + virtual ~AGNParticleContainer () {} const int NumberOfParticles(MyParIter& pti) { return pti.GetArrayOfStructs().size(); } @@ -69,13 +45,13 @@ public: amrex::Real a_new = 1.0, amrex::Real a_half = 1.0); - void AddOneParticle (int lev, - int grid, - int tile, - amrex::Real mass, - amrex::Real x, - amrex::Real y, - amrex::Real z) + void AddOneParticle (int lev, + int grid, + int tile, + amrex::Real mass, + amrex::Real x, + amrex::Real y, + amrex::Real z) { auto& particle_tile = this->GetParticles(lev)[std::make_pair(grid,tile)]; AddOneParticle(particle_tile, mass, x, y, z); @@ -139,56 +115,21 @@ public: /// /// Release energy if it exceeds thermal feedback threshold. /// - void ReleaseEnergy(int lev, - amrex::MultiFab& state, - amrex::MultiFab& D_new, - amrex::Real a); - - /// - /// This fills the ghost buffers for each tile with the proper data - /// - void fillNeighbors(int lev); - - /// - /// Each tile clears its ghosts, freeing the memory - /// - void clearNeighbors(int lev); + void ReleaseEnergy(int lev, + amrex::MultiFab& state, + amrex::MultiFab& D_new, + amrex::Real a); /// /// Write out all particles at a level /// void writeAllAtLevel(int lev); -private: - - /// - /// Apply periodic shift to particle position, so naive distance calculation - /// between neighbors and regular particles will be correct. - /// - void applyPeriodicShift(int lev, ParticleType& p, const amrex::IntVect& neighbor_cell); - - /// - /// Pack a particle's data into the proper neighbor buffer, or put it into - /// the structure to be sent to the other processes - /// - void packNeighborParticle(int lev, - const amrex::IntVect& neighbor_cell, - const amrex::BaseFab& mask, - const ParticleType& p, - NeighborCommMap& ghosts_to_comm); - - /// - /// Perform the MPI communication neccesary to fill ghost buffers - /// - void fillNeighborsMPI(NeighborCommMap& ghosts_to_comm); - - void defineMask(); + protected: + + bool sub_cycle; + amrex::Vector real_comp_names; - const size_t pdata_size = sizeof(ParticleType); - int ng; - amrex::FabArray > mask; - bool mask_defined; - std::map > ghosts; }; #endif /* _AGNParticleContainer_H_ */ diff --git a/Source/AGNParticleContainer.cpp b/Source/AGNParticleContainer.cpp index 699c274f..63f0a137 100644 --- a/Source/AGNParticleContainer.cpp +++ b/Source/AGNParticleContainer.cpp @@ -164,10 +164,10 @@ void AGNParticleContainer::ComputeOverlap(int lev) int Np = particles.size(); PairIndex index(pti.index(), pti.LocalTileIndex()); - int Ng = ghosts[index].size() / pdata_size; + int Ng = neighbors[index].size() / pdata_size; nyx_compute_overlap(&Np, particles.data(), - &Ng, ghosts[index].dataPtr(), dx); + &Ng, neighbors[index].dataPtr(), dx); } } @@ -185,10 +185,10 @@ void AGNParticleContainer::Merge(int lev) int Np = particles.size(); PairIndex index(pti.index(), pti.LocalTileIndex()); - int Ng = ghosts[index].size() / pdata_size; + int Ng = neighbors[index].size() / pdata_size; agn_merge_particles(&Np, particles.data(), - &Ng, ghosts[index].dataPtr(), dx); + &Ng, neighbors[index].dataPtr(), dx); } } @@ -272,299 +272,6 @@ void AGNParticleContainer::ReleaseEnergy(int lev, amrex::MultiFab& state, amrex: } } -void AGNParticleContainer::defineMask() -{ - BL_PROFILE("AGNParticleContainer::defineMask()"); - const int lev = 0; - const BoxArray& ba = m_gdb->ParticleBoxArray(lev); - const DistributionMapping& dm = m_gdb->ParticleDistributionMap(lev); - const Geometry& gm = m_gdb->Geom(lev); - - mask.define(ba, dm, 2, ng); - mask.setVal(-1, ng); - - for (MFIter mfi = MakeMFIter(lev); mfi.isValid(); ++mfi) { - const Box& box = mfi.tilebox(); - const int grid_id = mfi.index(); - const int tile_id = mfi.LocalTileIndex(); - mask.setVal(grid_id, box, 0, 1); - mask.setVal(tile_id, box, 1, 1); - } - - mask.FillBoundary(gm.periodicity()); - mask_defined = true; -} - -void AGNParticleContainer::fillNeighbors(int lev) -{ - BL_PROFILE("AGNParticleContainer::fillNeighbors()"); - BL_ASSERT(lev == 0); - if (!mask_defined) defineMask(); - - NeighborCommMap ghosts_to_comm; - for (MyParIter pti(*this, lev); pti.isValid(); ++pti) { - const Box& tile_box = pti.tilebox(); - const IntVect& lo = tile_box.smallEnd(); - const IntVect& hi = tile_box.bigEnd(); - - Box shrink_box = pti.tilebox(); - shrink_box.grow(-ng); - - auto& particles = pti.GetArrayOfStructs(); - for (unsigned i = 0; i < pti.numParticles(); ++i) { - const ParticleType& p = particles[i]; - const IntVect& iv = Index(p, lev); - - // if the particle is more than one cell away from - // the tile boundary, it's not anybody's neighbor - if (shrink_box.contains(iv)) continue; - - // shift stores whether we are near the tile boundary in each direction. - // -1 means lo, 1 means hi, 0 means not near the boundary - IntVect shift = IntVect::TheZeroVector(); - for (int idim = 0; idim < BL_SPACEDIM; ++idim) { - if (iv[idim] == lo[idim]) - shift[idim] = -ng; - else if (iv[idim] == hi[idim]) - shift[idim] = ng; - } - - // Based on the value of shift, we add the particle to a map to be sent - // to the neighbors. A particle can be sent to up to 3 neighbors in 2D - // and up to 7 in 3D, depending on whether is near the tile box corners, - // edges, or just the faces. First, add the particle for the "face" neighbors - for (int idim = 0; idim < BL_SPACEDIM; ++idim) { - if (shift[idim] == 0) continue; - IntVect neighbor_cell = iv; - neighbor_cell.shift(idim, shift[idim]); - BL_ASSERT(mask[pti].box().contains(neighbor_cell)); - packNeighborParticle(lev, neighbor_cell, mask[pti], p, ghosts_to_comm); - } - - // Now add the particle to the "edge" neighbors - for (int idim = 0; idim < BL_SPACEDIM; ++idim) { - for (int jdim = 0; jdim < idim; ++jdim) { - if (shift[idim] != 0 and shift[jdim] != 0) { - IntVect neighbor_cell = iv; - neighbor_cell.shift(idim, shift[idim]); - neighbor_cell.shift(jdim, shift[jdim]); - BL_ASSERT(mask[pti].box().contains(neighbor_cell)); - packNeighborParticle(lev, neighbor_cell, mask[pti], p, ghosts_to_comm); - } - } - } - - // Finally, add the particle for the "vertex" neighbors (only relevant in 3D) - if (shift[0] != 0 and shift[1] != 0 and shift[2] != 0) { - IntVect neighbor_cell = iv; - neighbor_cell.shift(shift); - BL_ASSERT(mask[pti].box().contains(neighbor_cell)); - packNeighborParticle(lev, neighbor_cell, mask[pti], p, ghosts_to_comm); - } - } - } - - fillNeighborsMPI(ghosts_to_comm); -} - -void AGNParticleContainer::clearNeighbors(int lev) -{ - BL_PROFILE("AGNParticleContainer::clearNeighbors()"); - ghosts.clear(); -} - -void AGNParticleContainer::applyPeriodicShift(int lev, ParticleType& p, - const IntVect& neighbor_cell) -{ - BL_PROFILE("AGNParticleContainer::applyPeriodicShift()"); - const Periodicity& periodicity = Geom(lev).periodicity(); - if (not periodicity.isAnyPeriodic()) return; - - const Box& domain = Geom(lev).Domain(); - const IntVect& lo = domain.smallEnd(); - const IntVect& hi = domain.bigEnd(); - const RealBox& prob_domain = Geom(lev).ProbDomain(); - - for (int dir = 0; dir < BL_SPACEDIM; ++dir) { - if (not periodicity.isPeriodic(dir)) continue; - if (neighbor_cell[dir] < lo[dir]) { - p.pos(dir) += prob_domain.length(dir); - } - else if (neighbor_cell[dir] > hi[dir]) { - p.pos(dir) -= prob_domain.length(dir); - } - } -} - -void AGNParticleContainer::packNeighborParticle(int lev, - const IntVect& neighbor_cell, - const BaseFab& mask, - const ParticleType& p, - NeighborCommMap& ghosts_to_comm) -{ - BL_PROFILE("AGNParticleContainer::packNeighborParticle()"); - const int neighbor_grid = mask(neighbor_cell, 0); - if (neighbor_grid >= 0) { - const int who = ParticleDistributionMap(lev)[neighbor_grid]; - const int MyProc = ParallelDescriptor::MyProc(); - const int neighbor_tile = mask(neighbor_cell, 1); - PairIndex dst_index(neighbor_grid, neighbor_tile); - ParticleType particle = p; - applyPeriodicShift(lev, particle, neighbor_cell); - if (who == MyProc) { - size_t old_size = ghosts[dst_index].size(); - size_t new_size = ghosts[dst_index].size() + pdata_size; - ghosts[dst_index].resize(new_size); - std::memcpy(&ghosts[dst_index][old_size], &particle, pdata_size); - } else { - NeighborCommTag tag(who, neighbor_grid, neighbor_tile); - Vector& buffer = ghosts_to_comm[tag]; - size_t old_size = buffer.size(); - size_t new_size = buffer.size() + pdata_size; - buffer.resize(new_size); - std::memcpy(&buffer[old_size], &particle, pdata_size); - } - } -} - -void AGNParticleContainer::fillNeighborsMPI(NeighborCommMap& ghosts_to_comm) -{ - BL_PROFILE("AGNParticleContainer::fillNeighborsMPI()"); -#ifdef BL_USE_MPI - const int MyProc = ParallelDescriptor::MyProc(); - const int NProcs = ParallelDescriptor::NProcs(); - - // count the number of tiles to be sent to each proc - std::map tile_counts; - for (const auto& kv: ghosts_to_comm) { - tile_counts[kv.first.proc_id] += 1; - } - - // flatten all the data for each proc into a single buffer - // once this is done, each dst proc will have an Vector - // the buffer will be packed like: - // ntiles, gid1, tid1, size1, data1.... gid2, tid2, size2, data2... etc. - std::map > send_data; - for (const auto& kv: ghosts_to_comm) { - Vector& buffer = send_data[kv.first.proc_id]; - buffer.resize(sizeof(int)); - std::memcpy(&buffer[0], &tile_counts[kv.first.proc_id], sizeof(int)); - } - - for (auto& kv : ghosts_to_comm) { - int data_size = kv.second.size(); - Vector& buffer = send_data[kv.first.proc_id]; - size_t old_size = buffer.size(); - size_t new_size = buffer.size() + 2*sizeof(int) + sizeof(int) + data_size; - buffer.resize(new_size); - char* dst = &buffer[old_size]; - std::memcpy(dst, &(kv.first.grid_id), sizeof(int)); dst += sizeof(int); - std::memcpy(dst, &(kv.first.tile_id), sizeof(int)); dst += sizeof(int); - std::memcpy(dst, &data_size, sizeof(int)); dst += sizeof(int); - if (data_size == 0) continue; - std::memcpy(dst, &kv.second[0], data_size); - Vector().swap(kv.second); - } - - // each proc figures out how many bytes it will send, and how - // many it will receive - Vector snds(NProcs, 0), rcvs(NProcs, 0); - long num_snds = 0; - for (const auto& kv : send_data) { - num_snds += kv.second.size(); - snds[kv.first] = kv.second.size(); - } - ParallelDescriptor::ReduceLongMax(num_snds); - if (num_snds == 0) return; - - // communicate that information - BL_COMM_PROFILE(BLProfiler::Alltoall, sizeof(long), - ParallelDescriptor::MyProc(), BLProfiler::BeforeCall()); - - BL_MPI_REQUIRE( MPI_Alltoall(snds.dataPtr(), - 1, - ParallelDescriptor::Mpi_typemap::type(), - rcvs.dataPtr(), - 1, - ParallelDescriptor::Mpi_typemap::type(), - ParallelDescriptor::Communicator()) ); - BL_ASSERT(rcvs[MyProc] == 0); - - BL_COMM_PROFILE(BLProfiler::Alltoall, sizeof(long), - ParallelDescriptor::MyProc(), BLProfiler::AfterCall()); - - Vector RcvProc; - Vector rOffset; // Offset (in bytes) in the receive buffer - - std::size_t TotRcvBytes = 0; - for (int i = 0; i < NProcs; ++i) { - if (rcvs[i] > 0) { - RcvProc.push_back(i); - rOffset.push_back(TotRcvBytes); - TotRcvBytes += rcvs[i]; - } - } - - const int nrcvs = RcvProc.size(); - Vector stats(nrcvs); - Vector rreqs(nrcvs); - - const int SeqNum = ParallelDescriptor::SeqNum(); - - // Allocate data for rcvs as one big chunk. - Vector recvdata(TotRcvBytes); - - // Post receives. - for (int i = 0; i < nrcvs; ++i) { - const auto Who = RcvProc[i]; - const auto offset = rOffset[i]; - const auto Cnt = rcvs[Who]; - - BL_ASSERT(Cnt > 0); - BL_ASSERT(Cnt < std::numeric_limits::max()); - BL_ASSERT(Who >= 0 && Who < NProcs); - - rreqs[i] = ParallelDescriptor::Arecv(&recvdata[offset], Cnt, Who, SeqNum).req(); - } - - // Send. - for (const auto& kv : send_data) { - const auto Who = kv.first; - const auto Cnt = kv.second.size(); - - BL_ASSERT(Cnt > 0); - BL_ASSERT(Who >= 0 && Who < NProcs); - BL_ASSERT(Cnt < std::numeric_limits::max()); - - ParallelDescriptor::Send(kv.second.data(), Cnt, Who, SeqNum); - } - - // unpack the received data and put them into the proper ghost buffers - if (nrcvs > 0) { - BL_MPI_REQUIRE( MPI_Waitall(nrcvs, rreqs.data(), stats.data()) ); - for (int i = 0; i < nrcvs; ++i) { - const int offset = rOffset[i]; - char* buffer = &recvdata[offset]; - int num_tiles, gid, tid, size; - std::memcpy(&num_tiles, buffer, sizeof(int)); buffer += sizeof(int); - for (int j = 0; j < num_tiles; ++j) { - std::memcpy(&gid, buffer, sizeof(int)); buffer += sizeof(int); - std::memcpy(&tid, buffer, sizeof(int)); buffer += sizeof(int); - std::memcpy(&size, buffer, sizeof(int)); buffer += sizeof(int); - - if (size == 0) continue; - - PairIndex dst_index(gid, tid); - size_t old_size = ghosts[dst_index].size(); - size_t new_size = ghosts[dst_index].size() + size; - ghosts[dst_index].resize(new_size); - std::memcpy(&ghosts[dst_index][old_size], buffer, size); buffer += size; - } - } - } -#endif -} - void AGNParticleContainer::writeAllAtLevel(int lev) { BL_PROFILE("AGNParticleContainer::writeAllAtLevel()"); diff --git a/Source/DarkMatterParticleContainer.H b/Source/DarkMatterParticleContainer.H index d7a3dd99..f7731205 100644 --- a/Source/DarkMatterParticleContainer.H +++ b/Source/DarkMatterParticleContainer.H @@ -5,7 +5,7 @@ #include "NyxParticleContainer.H" // We make DarkMatterParticleContainer a class instead of a typedef so that -// we can have Nyx-specific functions here instead of in BoxLib +// we can have Nyx-specific functions here instead of in amrex class DarkMatterParticleContainer : public NyxParticleContainer<1+BL_SPACEDIM> { diff --git a/Source/EOS/eos_hc.f90 b/Source/EOS/eos_hc.f90 index d3274293..bb5c594e 100644 --- a/Source/EOS/eos_hc.f90 +++ b/Source/EOS/eos_hc.f90 @@ -561,10 +561,13 @@ subroutine iterate_ne(JH, JHe, z, U, t, nh, ne, nh0, nhp, nhe0, nhep, nhepp) if (abs(dne) < xacc) exit -! if (i .gt. 13) & -! print*, "ITERATION: ", i, " NUMBERS: ", z, t, ne, nhp, nhep, nhepp, df - if (i .gt. 15) & - STOP 'iterate_ne(): No convergence in Newton-Raphson!' + if (i .gt. 10) then + !$OMP CRITICAL + print*, "ITERATION: ", i, " NUMBERS: ", z, t, ne, nhp, nhep, nhepp, df + if (i .gt. 12) & + STOP 'iterate_ne(): No convergence in Newton-Raphson!' + !$OMP END CRITICAL + endif enddo diff --git a/Source/Gravity/Gravity.H b/Source/Gravity/Gravity.H index ca3bd218..dfac5c3c 100644 --- a/Source/Gravity/Gravity.H +++ b/Source/Gravity/Gravity.H @@ -6,6 +6,8 @@ #include #include +#include + class Gravity { public: @@ -35,21 +37,6 @@ public: // void swap_time_levels(int level); - // - // Use the F90 solver - // - amrex::Real solve_with_fmg (int crse_level, int fine_level, - const amrex::Vector & phi, - const amrex::Vector & rhs, - const amrex::Vector >& grad_phi, - const amrex::Vector& res, - amrex::Real time); - - // - // Use the C++ solver in C_CellMG instead of the F90 solvers in F_MG. - // - void solve_with_Cpp(int level, amrex::MultiFab& phi, const amrex::Vector& grad_phi, - amrex::MultiFab& rhs, amrex::Real tol, amrex::Real abs_tol); // // Use the HPGMG solver // @@ -57,10 +44,20 @@ public: void solve_with_HPGMG(int level, amrex::MultiFab& phi, const amrex::Vector& grad_phi, amrex::MultiFab& rhs, amrex::Real tol, amrex::Real abs_tol); #endif + + void solve_for_phi_with_mlmg (int level, amrex::MultiFab& Rhs, amrex::MultiFab& phi, + const amrex::Vector& grad_phi, amrex::Real time); + amrex::Real solve_with_MLMG (int crse_level, int fine_level, + const amrex::Vector& phi, + const amrex::Vector& rhs, + const amrex::Vector >& grad_phi, + const amrex::MultiFab* const crse_bcdata, + amrex::Real rel_eps, amrex::Real abs_eps); + void set_boundary (amrex::BndryData& bd, amrex::MultiFab& rhs, const amrex::Real* dx); void solve_for_old_phi(int level, amrex::MultiFab& phi, const amrex::Vector& grad_phi, - int fill_interior); + int fill_interior, int grav_n_grow = 1); void solve_for_new_phi(int level, amrex::MultiFab& phi, const amrex::Vector& grad_phi, int fill_interior, int grav_n_grow = 1); void solve_for_phi(int level, amrex::MultiFab& Rhs, amrex::MultiFab& phi, @@ -69,19 +66,26 @@ public: void solve_for_delta_phi(int crse_level, int fine_level, amrex::MultiFab& CrseRhs, const amrex::Vector& delta_phi, const amrex::Vector >& grad_delta_phi); + void solve_for_delta_phi_with_mgt(int crse_level, int fine_level, amrex::MultiFab& CrseRhs, + const amrex::Vector& delta_phi, + const amrex::Vector >& grad_delta_phi); + void solve_for_delta_phi_with_mlmg(int crse_level, int fine_level, amrex::MultiFab& CrseRhs, + const amrex::Vector& delta_phi, + const amrex::Vector >& grad_delta_phi); void gravity_sync(int crse_level, int fine_level, int iteration, int ncycle, const amrex::MultiFab& drho_and_drhoU, const amrex::MultiFab& dphi, const amrex::Vector& grad_delta_phi_cc); void multilevel_solve_for_old_phi(int level, int finest_level, + int ngrow_for_solve, int use_previous_phi_as_guess=0); void multilevel_solve_for_new_phi(int level, int finest_level, + int ngrow_for_solve, int use_previous_phi_as_guess=0); - void multilevel_solve_for_phi(int level, int finest_level, - int use_previous_phi_as_guess=0); void actual_multilevel_solve(int level, int finest_level, const amrex::Vector >& grad_phi, int is_new, + int ngrow_for_solve, int use_previous_phi_as_guess=0); void get_crse_grad_phi(int level, amrex::Vector >& grad_phi_crse, @@ -104,16 +108,15 @@ public: void make_mg_bc(); + std::array mlmg_lobc; + std::array mlmg_hibc; + void set_dirichlet_bcs(int level, amrex::MultiFab* phi); #ifdef CGRAV void make_prescribed_grav(int level, amrex::Real time, amrex::MultiFab& grav, int addToExisting); #endif - // Routine to duplicate Gravity class data onto sidecars - virtual void AddProcsToComp(amrex::Amr *aptr, int level, amrex::AmrLevel *level_data_to_install, - int ioProcNumSCS, int ioProcNumAll, int scsMyId, MPI_Comm scsComm); - protected: // // Pointers to amr,amrlevel. @@ -142,8 +145,6 @@ protected: int finest_level; int finest_level_allocated; - int mg_bc[2*BL_SPACEDIM]; - amrex::BCRec* phys_bc; static int verbose; @@ -151,14 +152,16 @@ protected: static int no_composite; static int dirichlet_bcs; static int monopole_bcs; - static int solve_with_cpp; static int solve_with_hpgmg; + static int solve_with_mlmg; + static int mlmg_max_fmg_iter; + static int mlmg_agglomeration; + static int mlmg_consolidation; static amrex::Real mass_offset; static amrex::Real sl_tol; static amrex::Real ml_tol; static amrex::Real delta_tol; static std::string gravity_type; - static int stencil_type; void fill_ec_grow(int level, const amrex::Vector& ecF, const amrex::Vector& ecC) const; @@ -167,7 +170,7 @@ protected: void AddGhostParticlesToRhs(int level, amrex::MultiFab& Rhs); void AddVirtualParticlesToRhs(int level, amrex::MultiFab& Rhs, int ngrow); - void AddParticlesToRhs(int base_level, int finest_level, const amrex::Vector& Rhs_particles); + void AddParticlesToRhs(int base_level, int finest_level, int ngrow, const amrex::Vector& Rhs_particles); void AddGhostParticlesToRhs(int level, const amrex::Vector& Rhs_particles); void AddVirtualParticlesToRhs(int finest_level, const amrex::Vector& Rhs_particles); diff --git a/Source/Gravity/Gravity.cpp b/Source/Gravity/Gravity.cpp index d481f9a1..b76cb1c4 100644 --- a/Source/Gravity/Gravity.cpp +++ b/Source/Gravity/Gravity.cpp @@ -10,14 +10,14 @@ #include #include #include -#include -#include -#include #ifdef USEHPGMG #include #endif +#include +#include + using namespace amrex; // MAX_LEV defines the maximum number of AMR levels allowed by the parent "Amr" object @@ -30,13 +30,15 @@ int Gravity::no_sync = 0; int Gravity::no_composite = 0; int Gravity::dirichlet_bcs = 0; int Gravity::monopole_bcs = 0; -int Gravity::solve_with_cpp= 0; int Gravity::solve_with_hpgmg = 0; +int Gravity::solve_with_mlmg = 1; +int Gravity::mlmg_max_fmg_iter = 0; +int Gravity::mlmg_agglomeration = 0; +int Gravity::mlmg_consolidation = 0; Real Gravity::sl_tol = 1.e-12; Real Gravity::ml_tol = 1.e-12; Real Gravity::delta_tol = 1.e-12; Real Gravity::mass_offset = 0; -int Gravity::stencil_type = CC_CROSS_STENCIL; extern "C" {void fort_get_grav_const(Real* Gconst);} @@ -124,11 +126,17 @@ Gravity::read_params () pp.query("dirichlet_bcs", dirichlet_bcs); pp.query("monopole_bcs" , monopole_bcs); - pp.query("solve_with_cpp", solve_with_cpp); pp.query("solve_with_hpgmg", solve_with_hpgmg); - - if (solve_with_cpp && solve_with_hpgmg) + pp.query("solve_with_mlmg", solve_with_mlmg); + pp.query("mlmg_max_fmg_iter", mlmg_max_fmg_iter); + pp.query("mlmg_agglomeration", mlmg_agglomeration); + pp.query("mlmg_consolidation", mlmg_consolidation); + + const int nflags = static_cast(solve_with_hpgmg) + + static_cast(solve_with_mlmg); + if (nflags >= 2) { amrex::Error("Multiple gravity solvers selected."); + } #ifndef USEHPGMG if (solve_with_hpgmg) @@ -272,6 +280,7 @@ void Gravity::solve_for_old_phi (int level, MultiFab& phi, const Vector& grad_phi, + int ngrow_for_solve, int fill_interior) { BL_PROFILE("Gravity::solve_for_old_phi()"); @@ -294,7 +303,7 @@ Gravity::solve_for_old_phi (int level, } #endif - AddParticlesToRhs(level,Rhs,1); + AddParticlesToRhs(level,Rhs,ngrow_for_solve); // We shouldn't need to use virtual or ghost particles for old phi solves. @@ -307,7 +316,7 @@ Gravity::solve_for_new_phi (int level, MultiFab& phi, const Vector& grad_phi, int fill_interior, - int grav_n_grow) + int ngrow_for_solve) { BL_PROFILE("Gravity::solve_for_new_phi()"); #ifdef CGRAV @@ -330,8 +339,8 @@ Gravity::solve_for_new_phi (int level, } #endif - AddParticlesToRhs(level,Rhs,grav_n_grow); - AddVirtualParticlesToRhs(level,Rhs,grav_n_grow); + AddParticlesToRhs(level,Rhs,ngrow_for_solve); + AddVirtualParticlesToRhs(level,Rhs,ngrow_for_solve); AddGhostParticlesToRhs(level,Rhs); const Real time = LevelData[level]->get_state_data(PhiGrav_Type).curTime(); @@ -364,6 +373,23 @@ Gravity::solve_for_phi (int level, // Here we divide by a for the Poisson solve. Rhs.mult(1 / cs->get_comoving_a(time)); +#ifndef NDEBUG + if (Rhs.contains_nan(0,1,0)) + { + std::cout << "Rhs in solve_for_phi at level " << level << " has NaNs" << std::endl; + amrex::Abort(""); + } +#endif + + // Need to set the boundary values here so they can get copied into "bndry" + if (dirichlet_bcs) set_dirichlet_bcs(level,&phi); + + if (solve_with_mlmg) + { + solve_for_phi_with_mlmg(level, Rhs, phi, grad_phi, time); + return; + } + const Geometry& geom = parent->Geom(level); MacBndry bndry(grids[level], dmap[level], 1, geom); @@ -377,17 +403,6 @@ Gravity::solve_for_phi (int level, const int dest_comp = 0; const int num_comp = 1; -#ifndef NDEBUG - if (Rhs.contains_nan(0,1,0)) - { - std::cout << "Rhs in solve_for_phi at level " << level << " has NaNs" << std::endl; - amrex::Abort(""); - } -#endif - - // Need to set the boundary values here so they can get copied into "bndry" - if (dirichlet_bcs) set_dirichlet_bcs(level,&phi); - if (level == 0) { bndry.setBndryValues(phi, src_comp, dest_comp, num_comp, *phys_bc); @@ -440,7 +455,6 @@ Gravity::solve_for_phi (int level, if ( Geometry::isAllPeriodic() ) { -// if (grids[level].contains(parent->Geom(level).Domain())) if ( parent->Geom(level).Domain().numPts() == grids[level].numPts() ) { Nyx* nyx_level = dynamic_cast(&(parent->getLevel(level))); @@ -461,30 +475,12 @@ Gravity::solve_for_phi (int level, const Real tol = sl_tol; const Real abs_tol = 0.; - if (solve_with_cpp) - { - solve_with_Cpp(level, phi, grad_phi, Rhs, tol, abs_tol); - } - else if (solve_with_hpgmg) - { #ifdef USEHPGMG - solve_with_HPGMG(level, phi, grad_phi, Rhs, tol, abs_tol); -#endif - } - else + if (solve_with_hpgmg) { - MGT_Solver mgt_solver(fgeom, mg_bc, bav, dmv, false, stencil_type); - mgt_solver.set_const_gravity_coeffs(xa, xb); - const int mglev = 0; - const Real* dx = geom.CellSize(); - - int always_use_bnorm = 0; - int need_grad_phi = 1; - mgt_solver.solve(phi_p, Rhs_p, bndry, tol, abs_tol, always_use_bnorm, - level_solver_resnorm[level], need_grad_phi); - - mgt_solver.get_fluxes(mglev, grad_phi, dx); + solve_with_HPGMG(level, phi, grad_phi, Rhs, tol, abs_tol); } +#endif } void @@ -495,128 +491,7 @@ Gravity::solve_for_delta_phi (int crse_level, const Vector >& grad_delta_phi) { BL_PROFILE("Gravity::solve_for_delta_phi()"); - const int num_levels = fine_level - crse_level + 1; - const Box& crse_domain = (parent->Geom(crse_level)).Domain(); - - BL_ASSERT(grad_delta_phi.size() == num_levels); - BL_ASSERT(delta_phi.size() == num_levels); - - if (verbose) - { - amrex::Print() << "... solving for delta_phi at crse_level = " << crse_level << '\n'; - amrex::Print() << "... up to fine_level = " << fine_level << '\n'; - } - - const Geometry& geom = parent->Geom(crse_level); - MacBndry bndry(grids[crse_level], dmap[crse_level], 1, geom); - - IntVect crse_ratio = crse_level > 0 ? parent->refRatio(crse_level-1) - : IntVect::TheZeroVector(); - - // Set homogeneous Dirichlet values for the solve. - bndry.setHomogValues(*phys_bc, crse_ratio); - - Vector bav(num_levels); - Vector dmv(num_levels); - - for (int lev = crse_level; lev <= fine_level; lev++) - { - bav[lev-crse_level] = grids[lev]; - MultiFab& phi_new = LevelData[lev]->get_new_data(PhiGrav_Type); - dmv[lev-crse_level] = phi_new.DistributionMap(); - } - Vector fgeom(num_levels); - for (int lev = crse_level; lev <= fine_level; lev++) - fgeom[lev-crse_level] = parent->Geom(lev); - - MGT_Solver mgt_solver(fgeom, mg_bc, bav, dmv, false, stencil_type); - - Vector< Vector > xa(num_levels); - Vector< Vector > xb(num_levels); - - for (int lev = crse_level; lev <= fine_level; lev++) - { - xa[lev-crse_level].resize(BL_SPACEDIM); - xb[lev-crse_level].resize(BL_SPACEDIM); - if (lev == 0) - { - for (int i = 0; i < BL_SPACEDIM; ++i) - { - xa[lev-crse_level][i] = 0; - xb[lev-crse_level][i] = 0; - } - } - else - { - const Real* dx_crse = parent->Geom(lev-1).CellSize(); - for (int i = 0; i < BL_SPACEDIM; ++i) - { - xa[lev-crse_level][i] = 0.5 * dx_crse[i]; - xb[lev-crse_level][i] = 0.5 * dx_crse[i]; - } - } - } - - Vector > raii; - Vector Rhs_p(num_levels); - - for (int lev = crse_level; lev <= fine_level; lev++) - { - delta_phi[lev-crse_level]->setVal(0); - - if (lev == crse_level) - { - Rhs_p[0] = &crse_rhs; - } - else - { - raii.push_back(std::unique_ptr(new MultiFab(grids[lev], dmap[lev], 1, 0))); - Rhs_p[lev-crse_level] = raii.back().get(); - Rhs_p[lev-crse_level]->setVal(0); - } - - } - - // If at coarsest level, subtract off average of RHS from all levels to ensure solvability - if (Geometry::isAllPeriodic() && - (grids[crse_level].numPts() == crse_domain.numPts())) { - Real local_correction = 0.0; -#ifdef _OPENMP -#pragma omp parallel reduction(+:local_correction) -#endif - for (MFIter mfi(crse_rhs,true); mfi.isValid(); ++mfi) { - local_correction += crse_rhs[mfi].sum(mfi.tilebox(),0,1); - } - ParallelDescriptor::ReduceRealSum(local_correction); - - local_correction = local_correction / grids[crse_level].numPts(); - - if (verbose) - amrex::Print() << "WARNING: Adjusting RHS in solve_for_delta_phi by " << local_correction << std::endl; - - for (int lev = crse_level; lev <= fine_level; lev++) { - Rhs_p[lev-crse_level]->plus(-local_correction,0,1,0); - } - } - - mgt_solver.set_const_gravity_coeffs(xa, xb); - - const Real tol = delta_tol; - Real abs_tol = level_solver_resnorm[crse_level]; - for (int lev = crse_level + 1; lev < fine_level; lev++) - abs_tol = std::max(abs_tol,level_solver_resnorm[lev]); - - Real final_resnorm; - int always_use_bnorm = 0; - int need_grad_phi = 1; - mgt_solver.solve(delta_phi, Rhs_p, bndry, tol, abs_tol, always_use_bnorm, final_resnorm, need_grad_phi); - - for (int lev = crse_level; lev <= fine_level; lev++) - { - auto& gdphi = grad_delta_phi[lev-crse_level]; - const Real* dx = parent->Geom(lev).CellSize(); - mgt_solver.get_fluxes(lev-crse_level, gdphi, dx); - } + solve_for_delta_phi_with_mlmg(crse_level,fine_level,crse_rhs,delta_phi,grad_delta_phi); } void @@ -844,6 +719,7 @@ Gravity::get_crse_grad_phi (int level, void Gravity::multilevel_solve_for_new_phi (int level, int finest_level, + int ngrow_for_solve, int use_previous_phi_as_guess) { BL_PROFILE("Gravity::multilevel_solve_for_new_phi()"); @@ -864,12 +740,13 @@ Gravity::multilevel_solve_for_new_phi (int level, int is_new = 1; actual_multilevel_solve(level, finest_level, amrex::GetVecOfVecOfPtrs(grad_phi_curr), - is_new, use_previous_phi_as_guess); + is_new, ngrow_for_solve, use_previous_phi_as_guess); } void Gravity::multilevel_solve_for_old_phi (int level, int finest_level, + int ngrow, int use_previous_phi_as_guess) { BL_PROFILE("Gravity::multilevel_solve_for_old_phi()"); @@ -887,17 +764,10 @@ Gravity::multilevel_solve_for_old_phi (int level, } } - int is_new = 0; + int is_new = 0; actual_multilevel_solve(level, finest_level, amrex::GetVecOfVecOfPtrs(grad_phi_prev), - is_new, use_previous_phi_as_guess); -} - -void -Gravity::multilevel_solve_for_phi(int level, int finest_level, - int use_previous_phi_as_guess) -{ - multilevel_solve_for_new_phi(level, finest_level, use_previous_phi_as_guess); + is_new, ngrow, use_previous_phi_as_guess); } void @@ -905,58 +775,13 @@ Gravity::actual_multilevel_solve (int level, int finest_level, const Vector >& grad_phi, int is_new, + int ngrow_for_solve, int use_previous_phi_as_guess) { BL_PROFILE("Gravity::actual_multilevel_solve()"); const int num_levels = finest_level - level + 1; - Vector bav(num_levels); - Vector dmv(num_levels); - - // Ok to use phi_new here because phi_new and phi_old have the same DistributionMap - for (int lev = 0; lev < num_levels; lev++) - { - bav[lev] = grids[level+lev]; - if (is_new == 1) - { - MultiFab& phi_new = LevelData[level+lev]->get_new_data(PhiGrav_Type); - dmv[lev] = phi_new.DistributionMap(); - } else { - MultiFab& phi_old = LevelData[level+lev]->get_old_data(PhiGrav_Type); - dmv[lev] = phi_old.DistributionMap(); - } - } - Vector fgeom(num_levels); - for (int i = 0; i < num_levels; i++) - fgeom[i] = parent->Geom(level+i); - - Vector< Vector > xa(num_levels); - Vector< Vector > xb(num_levels); - - for (int lev = 0; lev < num_levels; lev++) - { - xa[lev].resize(BL_SPACEDIM); - xb[lev].resize(BL_SPACEDIM); - if (level + lev == 0) - { - for (int i = 0; i < BL_SPACEDIM; ++i) - { - xa[lev][i] = 0; - xb[lev][i] = 0; - } - } - else - { - const Real* dx_crse = parent->Geom(level + lev - 1).CellSize(); - for (int i = 0; i < BL_SPACEDIM; ++i) - { - xa[lev][i] = 0.5 * dx_crse[i]; - xb[lev][i] = 0.5 * dx_crse[i]; - } - } - } - Vector phi_p(num_levels); Vector > Rhs_p(num_levels); @@ -964,11 +789,11 @@ Gravity::actual_multilevel_solve (int level, for (int lev = 0; lev < num_levels; lev++) { Rhs_particles[lev].reset(new MultiFab(grids[level+lev], dmap[level+lev], 1, 0)); - Rhs_particles[lev]->setVal(0.); + Rhs_particles[lev]->setVal(0.); } const auto& rpp = amrex::GetVecOfPtrs(Rhs_particles); - AddParticlesToRhs(level,finest_level,rpp); + AddParticlesToRhs(level,finest_level,ngrow_for_solve,rpp); AddGhostParticlesToRhs(level,rpp); AddVirtualParticlesToRhs(finest_level,rpp); @@ -1087,100 +912,24 @@ Gravity::actual_multilevel_solve (int level, // ***************************************************************************** - IntVect crse_ratio = level > 0 ? parent->refRatio(level-1) - : IntVect::TheZeroVector(); - - // - // Store the Dirichlet boundary condition for phi in bndry. - // - const Geometry& geom = parent->Geom(level); - MacBndry bndry(grids[level], dmap[level], 1, geom); - const int src_comp = 0; - const int dest_comp = 0; - const int num_comp = 1; - // - // Build the homogeneous boundary conditions. One could setVal - // the bndry fabsets directly, but we instead do things as if - // we had a fill-patched mf with grows--in that case the bndry - // object knows how to grab grow data from the mf on physical - // boundaries. Here we create an mf, setVal, and pass that to - // the bndry object. - // - if (level == 0) - { - bndry.setBndryValues(*phi_p[0], src_comp, dest_comp, num_comp,*phys_bc); - } - else + if (solve_with_mlmg) { + const MultiFab* crse_bcdata = nullptr; MultiFab CPhi; - get_crse_phi(level, CPhi, time); - BoxArray crse_boxes = BoxArray(grids[level]).coarsen(crse_ratio); - const int in_rad = 0; - const int out_rad = 1; - const int extent_rad = 2; - BndryRegister crse_br(crse_boxes, dmap[level], - in_rad, out_rad, extent_rad, num_comp); - crse_br.copyFrom(CPhi, CPhi.nGrow(), src_comp, dest_comp, num_comp); - bndry.setBndryValues(crse_br, src_comp, LevelData[level]->get_new_data(PhiGrav_Type), - src_comp, dest_comp, num_comp, crse_ratio, *phys_bc); - } - - Real tol = ml_tol; - Real abs_tol = 0; - - // - // Can only use the C++ solvers if single-level - // - if (solve_with_cpp && (level == finest_level)) - { - // We can only use the C++ solvers for a single level solve, but it's ok if level > 0 - solve_with_Cpp(level, *(phi_p[0]), grad_phi[0], *(Rhs_p[0]), tol, abs_tol); - } - else if ( solve_with_hpgmg && (level == finest_level) && (level == 0) ) - { -#ifdef USEHPGMG - // Right now we can only use HPGMG for a single level = 0 solve - solve_with_HPGMG(level, *(phi_p[0]), grad_phi[0], *(Rhs_p[0]), tol, abs_tol); -#endif - } - else - { - MGT_Solver mgt_solver(fgeom, mg_bc, bav, dmv, false, stencil_type); - mgt_solver.set_const_gravity_coeffs(xa, xb); - - Real final_resnorm; - int always_use_bnorm = 0; - int need_grad_phi = 1; - - // - // Call the solver - // - mgt_solver.solve(phi_p, amrex::GetVecOfPtrs(Rhs_p), - bndry, tol, abs_tol, always_use_bnorm, final_resnorm, need_grad_phi); - - for (int lev = 0; lev < num_levels; lev++) - { - const Real* dx = parent->Geom(level+lev).CellSize(); - mgt_solver.get_fluxes(lev, grad_phi[level+lev], dx); - } - } - - // Average phi from fine to coarse level - for (int lev = finest_level; lev > level; lev--) - { - if (is_new == 1) - { - amrex::average_down(LevelData[lev ]->get_new_data(PhiGrav_Type), - LevelData[lev-1]->get_new_data(PhiGrav_Type), - 0, 1, parent->refRatio(lev-1)); - + if (level > 0) { + get_crse_phi(level, CPhi, time); + crse_bcdata = &CPhi; } - else if (is_new == 0) - { - amrex::average_down(LevelData[lev ]->get_old_data(PhiGrav_Type), - LevelData[lev-1]->get_old_data(PhiGrav_Type), - 0, 1, parent->refRatio(lev-1)); + Real rel_eps = ml_tol; + Real abs_eps = 0.; + Vector > grad_phi_aa; + for (int amrlev = level; amrlev <= finest_level; ++amrlev) { + grad_phi_aa.push_back({AMREX_D_DECL(grad_phi[amrlev][0], + grad_phi[amrlev][1], + grad_phi[amrlev][2])}); } + solve_with_MLMG(level, finest_level, phi_p, amrex::GetVecOfConstPtrs(Rhs_p), + grad_phi_aa, crse_bcdata, rel_eps, abs_eps); } // Average grad_phi from fine to coarse level @@ -1575,47 +1324,21 @@ Gravity::make_mg_bc () { BL_PROFILE("Gravity::make_mg_bc()"); const Geometry& geom = parent->Geom(0); - for (int dir = 0; dir < BL_SPACEDIM; ++dir) - { - if (geom.isPeriodic(dir)) - { - mg_bc[2*dir + 0] = 0; - mg_bc[2*dir + 1] = 0; - } - else - { - if (phys_bc->lo(dir) == Symmetry) - { - mg_bc[2*dir + 0] = MGT_BC_NEU; - } - else if (phys_bc->lo(dir) == Outflow) - { - mg_bc[2*dir + 0] = MGT_BC_DIR; - } - else if (phys_bc->lo(dir) == Inflow) - { - mg_bc[2*dir + 0] = MGT_BC_DIR; - } - else - { - amrex::Abort("Unknown lo bc in make_mg_bc"); - } - if (phys_bc->hi(dir) == Symmetry) - { - mg_bc[2*dir + 1] = MGT_BC_NEU; - } - else if (phys_bc->hi(dir) == Outflow) - { - mg_bc[2*dir + 1] = MGT_BC_DIR; - } - else if (phys_bc->hi(dir) == Inflow) - { - mg_bc[2*dir + 1] = MGT_BC_DIR; + for (int idim = 0; idim < AMREX_SPACEDIM; ++idim) { + if (geom.isPeriodic(idim)) { + mlmg_lobc[idim] = MLLinOp::BCType::Periodic; + mlmg_hibc[idim] = MLLinOp::BCType::Periodic; + } else { + if (phys_bc->lo(idim) == Symmetry) { + mlmg_lobc[idim] = MLLinOp::BCType::Neumann; + } else { + mlmg_lobc[idim] = MLLinOp::BCType::Dirichlet; } - else - { - amrex::Abort("Unknown hi bc in make_mg_bc"); + if (phys_bc->hi(idim) == Symmetry) { + mlmg_hibc[idim] = MLLinOp::BCType::Neumann; + } else { + mlmg_hibc[idim] = MLLinOp::BCType::Dirichlet; } } } @@ -1764,14 +1487,14 @@ Gravity::AddParticlesToRhs (int level, } void -Gravity::AddParticlesToRhs(int base_level, int finest_level, const Vector& Rhs_particles) +Gravity::AddParticlesToRhs(int base_level, int finest_level, int ngrow, const Vector& Rhs_particles) { BL_PROFILE("Gravity::AddParticlesToRhsML()"); const int num_levels = finest_level - base_level + 1; for (int i = 0; i < Nyx::theActiveParticles().size(); i++) { Vector > PartMF; - Nyx::theActiveParticles()[i]->AssignDensity(PartMF, base_level, 1, finest_level); + Nyx::theActiveParticles()[i]->AssignDensity(PartMF, base_level, 1, finest_level, ngrow); for (int lev = 0; lev < num_levels; lev++) { if (PartMF[lev]->contains_nan()) @@ -1909,33 +1632,6 @@ Gravity::CorrectRhsUsingOffset(int level, MultiFab& Rhs) } } -void -Gravity::solve_with_Cpp(int level, MultiFab& soln, const Vector& grad_phi, - MultiFab& rhs, Real tol, Real abs_tol) -{ - BL_PROFILE("Gravity::solve_with_Cpp()"); - const Geometry& geom = parent->Geom(level); - const Real* dx = parent->Geom(level).CellSize(); - - BndryData bd(grids[level], dmap[level], 1, geom); - set_boundary(bd, rhs, dx); - - // Note that this actually solves Lap(phi) = RHS, not -Lap(phi) as in the F90 solve - Laplacian lap_operator(bd, dx[0]); - - MultiGrid mg(lap_operator); - mg.setVerbose(1); - mg.solve(soln, rhs, tol, abs_tol); - - lap_operator.compFlux(*grad_phi[0],*grad_phi[1],*grad_phi[2],soln); - - // We have to multiply by -1 here because the compFlux routine returns - // grad(phi), not -grad(phi) as in the F90 solver. - grad_phi[0]->mult(-1.0); - grad_phi[1]->mult(-1.0); - grad_phi[2]->mult(-1.0); -} - #ifdef USEHPGMG void Gravity::solve_with_HPGMG(int level, @@ -1971,7 +1667,7 @@ Gravity::solve_with_HPGMG(int level, const Real a = 0.0; // coefficient in front of alpha in the Helmholtz operator // The canonical Helmholtz operator is a alpha u - b div (beta grad(u)) = f. // The self-gravity equation that we solve in Nyx is Lap(u) = f. So we need - // either the betas or b to be -1. The other GMG solvers in BoxLib set the + // either the betas or b to be -1. The other GMG solvers in amrex set the // b*beta to -1. const Real b = -1.0; // coefficient in front of beta in the Helmholtz operator @@ -2028,14 +1724,135 @@ Gravity::solve_with_HPGMG(int level, lap_operator.compFlux(*grad_phi[0],*grad_phi[1],*grad_phi[2],soln); - // We have to multiply by -1 here because the compFlux routine returns - // grad(phi), not -grad(phi) as in the F90 solver. + // We have to multiply by -1 here because the compFlux routine returns grad(phi) grad_phi[0]->mult(-1.0); grad_phi[1]->mult(-1.0); grad_phi[2]->mult(-1.0); } #endif +void +Gravity::solve_for_phi_with_mlmg (int level, MultiFab& Rhs, MultiFab& phi, + const Vector& grad_phi, Real time) +{ + BL_PROFILE("Gravity::solve_for_phi_with_mlmg"); + const MultiFab* crse_bcdata = nullptr; + MultiFab CPhi; + if (level > 0) { + get_crse_phi(level, CPhi, time); + crse_bcdata = &CPhi; + } + Real rel_eps = sl_tol; + Real abs_eps = 0.; + Vector > grad_phi_aa; + grad_phi_aa.push_back({AMREX_D_DECL(grad_phi[0], grad_phi[1], grad_phi[2])}); + level_solver_resnorm[level] = + solve_with_MLMG(level, level, {&phi}, {&Rhs}, grad_phi_aa, crse_bcdata, rel_eps, abs_eps); +} + +void +Gravity::solve_for_delta_phi_with_mlmg (int crse_level, int fine_level, MultiFab& CrseRhs, + const Vector& delta_phi, + const Vector >& grad_delta_phi) +{ + BL_PROFILE("Gravity::solve_for_delta_phi_with_mlmg"); + + if (verbose) + { + amrex::Print() << "... solving for delta_phi at crse_level = " << crse_level << '\n'; + amrex::Print() << "... up to fine_level = " << fine_level << '\n'; + } + + const int num_levels = fine_level - crse_level + 1; + + BL_ASSERT(grad_delta_phi.size() == num_levels); + BL_ASSERT(delta_phi.size() == num_levels); + + Vector rhs(num_levels); + Vector rhsp(num_levels); + + for (int lev = 0; lev < num_levels; ++lev) { + delta_phi[lev]->setVal(0.0); + if (lev == 0) { + rhsp[lev] = &CrseRhs; + } else { + rhs[lev].define(grids[lev+crse_level], dmap[lev+crse_level], 1, 0); + rhs[lev].setVal(0.0); + rhsp[lev] = &rhs[lev]; + } + } + + Real rel_eps = delta_tol; + // fine_level is not included. + Real abs_eps = *(std::max_element(level_solver_resnorm.begin() + crse_level, + level_solver_resnorm.begin() + fine_level)); + Vector > grad; + for (const auto& x : grad_delta_phi) { + grad.push_back({AMREX_D_DECL(x[0],x[1],x[2])}); + } + solve_with_MLMG(crse_level, fine_level, delta_phi, rhsp, grad, nullptr, rel_eps, abs_eps); +} + +Real +Gravity::solve_with_MLMG (int crse_level, int fine_level, + const Vector& phi, + const Vector& rhs, + const Vector >& grad_phi, + const MultiFab* const crse_bcdata, + Real rel_eps, Real abs_eps) +{ + BL_PROFILE("Gravity::solve_with_MLMG"); + + const int nlevs = fine_level - crse_level + 1; + + Vector gmv; + Vector bav; + Vector dmv; + for (int ilev = 0; ilev < nlevs; ++ilev) + { + gmv.push_back(parent->Geom(ilev+crse_level)); + bav.push_back(rhs[ilev]->boxArray()); + dmv.push_back(rhs[ilev]->DistributionMap()); + } + + LPInfo info; + info.setAgglomeration(mlmg_agglomeration); + info.setConsolidation(mlmg_consolidation); + + MLPoisson mlpoisson(gmv, bav, dmv, info); + + // BC + mlpoisson.setDomainBC(mlmg_lobc, mlmg_hibc); + + if (mlpoisson.needsCoarseDataForBC()) + { + mlpoisson.setCoarseFineBC(crse_bcdata, parent->refRatio(crse_level-1)[0]); + } + + for (int ilev = 0; ilev < nlevs; ++ilev) + { + mlpoisson.setLevelBC(ilev, phi[ilev]); + } + + MLMG mlmg(mlpoisson); + mlmg.setVerbose(verbose); + if (crse_level == 0) { + mlmg.setMaxFmgIter(mlmg_max_fmg_iter); + } else { + mlmg.setMaxFmgIter(0); // Vcycle + } + + Real final_resnorm = mlmg.solve(phi, rhs, rel_eps, abs_eps); + + Vector > grad_phi_tmp; + for (const auto& x: grad_phi) { + grad_phi_tmp.push_back({AMREX_D_DECL(x[0],x[1],x[2])}); + } + mlmg.getGradSolution(grad_phi_tmp); + + return final_resnorm; +} + void Gravity::set_boundary(BndryData& bd, MultiFab& rhs, const Real* dx) { @@ -2060,239 +1877,3 @@ Gravity::set_boundary(BndryData& bd, MultiFab& rhs, const Real* dx) } - -// Routine to duplicate Gravity class data onto sidecars -void -Gravity::AddProcsToComp(Amr *aptr, int level, AmrLevel *level_data_to_install, - int ioProcNumSCS, int ioProcNumAll, int scsMyId, MPI_Comm scsComm) -{ - parent = aptr; - - - // ---- pack up the ints - Vector allInts; - - if(scsMyId == ioProcNumSCS) { - allInts.push_back(density); - allInts.push_back(finest_level); - allInts.push_back(finest_level_allocated); - allInts.push_back(verbose); - allInts.push_back(no_sync); - allInts.push_back(no_composite); - allInts.push_back(dirichlet_bcs); - allInts.push_back(monopole_bcs); - allInts.push_back(solve_with_cpp); - allInts.push_back(solve_with_hpgmg); - allInts.push_back(stencil_type); - for(int i(0); i < 2*BL_SPACEDIM; ++i) { allInts.push_back(mg_bc[i]); } - } - - amrex::BroadcastArray(allInts, scsMyId, ioProcNumSCS, scsComm); - - // ---- unpack the ints - if(scsMyId != ioProcNumSCS) { - int count(0); - - density = allInts[count++]; - finest_level = allInts[count++]; - finest_level_allocated = allInts[count++]; - verbose = allInts[count++]; - no_sync = allInts[count++]; - no_composite = allInts[count++]; - dirichlet_bcs = allInts[count++]; - monopole_bcs = allInts[count++]; - solve_with_cpp = allInts[count++]; - solve_with_hpgmg = allInts[count++]; - stencil_type = allInts[count++]; - for(int i(0); i < 2*BL_SPACEDIM; ++i) { mg_bc[i] = allInts[count++]; } - - BL_ASSERT(count == allInts.size()); - } - - - // ---- pack up the Reals - Vector allReals; - if(scsMyId == ioProcNumSCS) { - allReals.push_back(mass_offset); - allReals.push_back(sl_tol); - allReals.push_back(ml_tol); - allReals.push_back(delta_tol); - allReals.push_back(Ggravity); - } - - amrex::BroadcastArray(allReals, scsMyId, ioProcNumSCS, scsComm); - amrex::BroadcastArray(level_solver_resnorm, scsMyId, ioProcNumSCS, scsComm); - - // ---- unpack the Reals - if(scsMyId != ioProcNumSCS) { - int count(0); - mass_offset = allReals[count++]; - sl_tol = allReals[count++]; - ml_tol = allReals[count++]; - delta_tol = allReals[count++]; - Ggravity = allReals[count++]; - - BL_ASSERT(count == allReals.size()); - } - - - // ---- pack up the strings - Vector allStrings; - Vector serialStrings; - if(scsMyId == ioProcNumSCS) { - allStrings.push_back(gravity_type); - serialStrings = amrex::SerializeStringArray(allStrings); - } - - amrex::BroadcastArray(serialStrings, scsMyId, ioProcNumSCS, scsComm); - - // ---- unpack the strings - if(scsMyId != ioProcNumSCS) { - int count(0); - allStrings = amrex::UnSerializeStringArray(serialStrings); - gravity_type = allStrings[count++]; - } - - - // ---- BCRec - Vector bcrLo(BL_SPACEDIM), bcrHi(BL_SPACEDIM); - if(scsMyId == ioProcNumSCS) { - for(int i(0); i < bcrLo.size(); ++i) { bcrLo[i] = phys_bc->lo(i); } - for(int i(0); i < bcrHi.size(); ++i) { bcrHi[i] = phys_bc->hi(i); } - } - ParallelDescriptor::Bcast(bcrLo.dataPtr(), bcrLo.size(), ioProcNumSCS, scsComm); - ParallelDescriptor::Bcast(bcrHi.dataPtr(), bcrHi.size(), ioProcNumSCS, scsComm); - if(scsMyId != ioProcNumSCS) { - for(int i(0); i < bcrLo.size(); ++i) { phys_bc->setLo(i, bcrLo[i]); } - for(int i(0); i < bcrHi.size(); ++i) { phys_bc->setHi(i, bcrHi[i]); } - } - - - // ---- MultiFabs - - // ---- ---- grad_phi_curr :: Vector< Vector > > grad_phi_curr; - if(scsMyId != ioProcNumSCS) { - for(int j(0); j < grad_phi_curr.size(); ++j) { - grad_phi_curr[j].clear(); - } - } - int gpcSize(grad_phi_curr.size()); - ParallelDescriptor::Bcast(&gpcSize, 1, ioProcNumSCS, scsComm); - if(scsMyId != ioProcNumSCS) { - grad_phi_curr.resize(gpcSize); - } - - for(int j(0); j < grad_phi_curr.size(); ++j) { - Vector isDefined; - - if(scsMyId == ioProcNumSCS) { - isDefined.resize(grad_phi_curr[j].size()); - for(int i(0); i < grad_phi_curr[j].size(); ++i) { - isDefined[i] = (grad_phi_curr[j][i] != nullptr); - } - } - amrex::BroadcastArray(isDefined, scsMyId, ioProcNumAll, scsComm); - if(isDefined.size() > 0) { - BL_ASSERT(isDefined.size() == BL_SPACEDIM); - if(scsMyId != ioProcNumSCS) { - grad_phi_curr[j].resize(isDefined.size()); - for(int i(0); i < grad_phi_curr[j].size(); ++i) { - if(isDefined[i]) { - grad_phi_curr[j][i].reset(new MultiFab); - } - } - } - - for(int i(0); i < grad_phi_curr[j].size(); ++i) { - if(grad_phi_curr[j][i]) { - grad_phi_curr[j][i]->AddProcsToComp(ioProcNumSCS, ioProcNumAll, scsMyId, scsComm); - } - } - } - } - - - // ---- ---- grad_phi_prev :: Vector< Vector > > grad_phi_prev; - if(scsMyId != ioProcNumSCS) { - for(int j(0); j < grad_phi_prev.size(); ++j) { - grad_phi_prev[j].clear(); - } - } - int gppSize(grad_phi_prev.size()); - ParallelDescriptor::Bcast(&gppSize, 1, ioProcNumSCS, scsComm); - if(scsMyId != ioProcNumSCS) { - grad_phi_prev.resize(gppSize); - } - - for(int j(0); j < grad_phi_prev.size(); ++j) { - Vector isDefined; - - if(scsMyId == ioProcNumSCS) { - isDefined.resize(grad_phi_prev[j].size()); - for(int i(0); i < grad_phi_prev[j].size(); ++i) { - isDefined[i] = (grad_phi_prev[j][i] != nullptr); - } - } - amrex::BroadcastArray(isDefined, scsMyId, ioProcNumAll, scsComm); - if(isDefined.size() > 0) { - BL_ASSERT(isDefined.size() == BL_SPACEDIM); - if(scsMyId != ioProcNumSCS) { - grad_phi_prev[j].resize(isDefined.size()); - for(int i(0); i < grad_phi_prev[j].size(); ++i) { - if(isDefined[i]) { - grad_phi_prev[j][i].reset(new MultiFab); - } - } - } - for(int i(0); i < grad_phi_prev[j].size(); ++i) { - if(grad_phi_prev[j][i]) { - grad_phi_prev[j][i]->AddProcsToComp(ioProcNumSCS, ioProcNumAll, scsMyId, scsComm); - } - } - } - } - - - // ---- FluxRegisters :: Vector > phi_flux_reg; - if(scsMyId != ioProcNumSCS) { - phi_flux_reg.clear(); - } - int pfrSize(phi_flux_reg.size()); - ParallelDescriptor::Bcast(&pfrSize, 1, ioProcNumSCS, scsComm); - if(scsMyId != ioProcNumSCS) { - phi_flux_reg.resize(pfrSize); - } - - Vector isDefined; - - if(scsMyId == ioProcNumSCS) { - isDefined.resize(phi_flux_reg.size()); - for(int i(0); i < phi_flux_reg.size(); ++i) { - isDefined[i] = (phi_flux_reg[i] != nullptr); - } - } - amrex::BroadcastArray(isDefined, scsMyId, ioProcNumAll, scsComm); - if(isDefined.size() > 0) { - if(scsMyId != ioProcNumSCS) { - phi_flux_reg.resize(isDefined.size()); - for(int i(0); i < phi_flux_reg.size(); ++i) { - if(isDefined[i]) { - phi_flux_reg[i].reset(new FluxRegister); - } - } - } - - for(int i(0); i < phi_flux_reg.size(); ++i) { - if(phi_flux_reg[i]) { - phi_flux_reg[i]->AddProcsToComp(ioProcNumSCS, ioProcNumAll, scsMyId, scsComm); - } - } - } - - - - // ---- LevelData - LevelData[level] = level_data_to_install; -} - - diff --git a/Source/HeatCool/integrate_state_fcvode_3d.f90 b/Source/HeatCool/integrate_state_fcvode_3d.f90 index 37f4f945..ae9578c9 100644 --- a/Source/HeatCool/integrate_state_fcvode_3d.f90 +++ b/Source/HeatCool/integrate_state_fcvode_3d.f90 @@ -153,8 +153,10 @@ subroutine integrate_state_fcvode(lo, hi, & endif if (e_orig .lt. 0.d0) then + !$OMP CRITICAL print *,'negative e entering strang integration ',z, i,j,k, rho/mean_rhob, e_orig call bl_abort('bad e in strang') + !$OMP END CRITICAL end if i_vode = i @@ -165,12 +167,14 @@ subroutine integrate_state_fcvode(lo, hi, & T_out ,ne_out ,e_out) if (e_out .lt. 0.d0) then + !$OMP CRITICAL print *,'negative e exiting strang integration ',z, i,j,k, rho/mean_rhob, e_out + call flush(6) + !$OMP END CRITICAL T_out = 10.0 ne_out = 0.0 mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne_out) e_out = T_out / (gamma_minus_1 * mp_over_kB * mu) - call flush(6) ! call bl_abort('bad e out of strang') end if @@ -180,12 +184,12 @@ subroutine integrate_state_fcvode(lo, hi, & ! Instanteneous heating from reionization: T_H = 0.0d0 if (inhomogeneous_on .or. flash_h) then - if ((H_reion_z .lt. z) .and. (H_reion_z .ge. z_end)) T_H = (1.0d0 - species(2))*T_zhi + if ((H_reion_z .lt. z) .and. (H_reion_z .ge. z_end)) T_H = (1.0d0 - species(2))*max((T_zhi-T_out), 0.0d0) endif T_He = 0.0d0 if (flash_he) then - if ((He_reion_z .lt. z) .and. (He_reion_z .ge. z_end)) T_He = (1.0d0 - species(5))*T_zheii + if ((He_reion_z .lt. z) .and. (He_reion_z .ge. z_end)) T_He = (1.0d0 - species(5))*max((T_zheii-T_out), 0.0d0) endif if ((T_H .gt. 0.0d0) .or. (T_He .gt. 0.0d0)) then diff --git a/Source/HeatCool/integrate_state_fcvode_vec_3d.f90 b/Source/HeatCool/integrate_state_fcvode_vec_3d.f90 index a263c452..34debbb3 100644 --- a/Source/HeatCool/integrate_state_fcvode_vec_3d.f90 +++ b/Source/HeatCool/integrate_state_fcvode_vec_3d.f90 @@ -150,8 +150,10 @@ subroutine integrate_state_fcvode_vec(lo, hi, & do ii = 1, simd_width if (e_orig(ii) .lt. 0.d0) then + !$OMP CRITICAL print *,'negative e entering strang integration ',z, i+ii-1,j,k, rho(ii)/mean_rhob, e_orig(ii) call bl_abort('bad e in strang') + !$OMP END CRITICAL end if end do @@ -164,12 +166,14 @@ subroutine integrate_state_fcvode_vec(lo, hi, & do ii = 1, simd_width if (e_out(ii) .lt. 0.d0) then + !$OMP CRITICAL print *,'negative e exiting strang integration ',z, i,j,k, rho(ii)/mean_rhob, e_out(ii) + call flush(6) + !$OMP END CRITICAL T_out(ii) = 10.0 ne_out(ii) = 0.0 mu(ii) = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne_out(ii)) e_out(ii) = T_out(ii) / (gamma_minus_1 * mp_over_kB * mu(ii)) - call flush(6) ! call bl_abort('bad e out of strang') end if end do diff --git a/Source/HeatCool/integrate_state_vode_3d.f90 b/Source/HeatCool/integrate_state_vode_3d.f90 index 127e4189..7e6850e4 100644 --- a/Source/HeatCool/integrate_state_vode_3d.f90 +++ b/Source/HeatCool/integrate_state_vode_3d.f90 @@ -105,10 +105,10 @@ subroutine integrate_state_vode(lo, hi, & endif if (e_orig .lt. 0.d0) then - print *,'negative e entering strang integration ', z, i,j,k, e_orig - print *, 'state(i,j,k,UEINT) = ', state(i,j,k,UEINT) - print *, 'rho / mean_rhob = ', rho / mean_rhob + !$OMP CRITICAL + print *,'negative e entering strang integration ', z, i,j,k, rho/mean_rhob, e_orig call bl_abort('bad e in strang') + !$OMP END CRITICAL end if i_vode = i @@ -119,12 +119,14 @@ subroutine integrate_state_vode(lo, hi, & T_out ,ne_out ,e_out) if (e_out .lt. 0.d0) then - print *,'negative e exiting strang integration ', z, i,j,k, e_out + !$OMP CRITICAL + print *,'negative e exiting strang integration ', z, i,j,k, rho/mean_rhob, e_out + call flush(6) + !$OMP END CRITICAL T_out = 10.0 ne_out = 0.0 mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne_out) e_out = T_out / (gamma_minus_1 * mp_over_kB * mu) - call flush(6) !call bl_abort('bad e out of strang') end if @@ -134,12 +136,12 @@ subroutine integrate_state_vode(lo, hi, & ! Instanteneous heating from reionization: T_H = 0.0d0 if (inhomogeneous_on .or. flash_h) then - if ((H_reion_z .lt. z) .and. (H_reion_z .ge. z_end)) T_H = (1.0d0 - species(2))*T_zhi + if ((H_reion_z .lt. z) .and. (H_reion_z .ge. z_end)) T_H = (1.0d0 - species(2))*max((T_zhi-T_out), 0.0d0) endif T_He = 0.0d0 if (flash_he) then - if ((He_reion_z .lt. z) .and. (He_reion_z .ge. z_end)) T_He = (1.0d0 - species(5))*T_zheii + if ((He_reion_z .lt. z) .and. (He_reion_z .ge. z_end)) T_He = (1.0d0 - species(5))*max((T_zheii-T_out), 0.0d0) endif if ((T_H .gt. 0.0d0) .or. (T_He .gt. 0.0d0)) then diff --git a/Source/Initialization/Nyx_initcosmo.cpp b/Source/Initialization/Nyx_initcosmo.cpp index f767b8ae..79fa0aac 100644 --- a/Source/Initialization/Nyx_initcosmo.cpp +++ b/Source/Initialization/Nyx_initcosmo.cpp @@ -410,12 +410,8 @@ void Nyx::initcosmo() // for (int i = 0; i < NumSpec; i++) // MultiFab::Divide(S_new, S_new, Density, FirstSpec+i, 1, 0); - //compute temp at z_init from radiation temp at decoupling from radiation and matter - // Real tempInit = 600*(redshift+1)*(redshift+1)/200/200; - Real tempInit = 1e3; -#if 0 - Real tempInit = 2.7*(redshift+1); -#endif + Real tempInit = 0.021*(1.0+redshift)*(1.0+redshift); + int ns = S_new.nComp(); int nd = D_new.nComp(); diff --git a/Source/Initialization/Nyx_initdata.cpp b/Source/Initialization/Nyx_initdata.cpp index f3622c90..76ceec0f 100644 --- a/Source/Initialization/Nyx_initdata.cpp +++ b/Source/Initialization/Nyx_initdata.cpp @@ -57,7 +57,7 @@ Nyx::read_init_params () if (do_dm_particles && !ascii_particle_file.empty() && particle_init_type != "AsciiFile") { if (ParallelDescriptor::IOProcessor()) - std::cerr << "ERROR::particle_init_type is not AsciiFile but you specified ascii_particle_file" << std::endl;; + std::cerr << "ERROR::particle_init_type is not AsciiFile but you specified ascii_particle_file" << std::endl; amrex::Error(); } @@ -67,7 +67,7 @@ Nyx::read_init_params () if (init_with_sph_particles != 1 && !sph_particle_file.empty()) { if (ParallelDescriptor::IOProcessor()) - std::cerr << "ERROR::init_with_sph_particles is not 1 but you specified sph_particle_file" << std::endl;; + std::cerr << "ERROR::init_with_sph_particles is not 1 but you specified sph_particle_file" << std::endl; amrex::Error(); } @@ -75,7 +75,7 @@ Nyx::read_init_params () if (init_with_sph_particles == 1 && sph_particle_file.empty()) { if (ParallelDescriptor::IOProcessor()) - std::cerr << "ERROR::init_with_sph_particles is 1 but you did not specify sph_particle_file" << std::endl;; + std::cerr << "ERROR::init_with_sph_particles is 1 but you did not specify sph_particle_file" << std::endl; amrex::Error(); } @@ -96,7 +96,7 @@ Nyx::read_init_params () if (!agn_particle_file.empty() && particle_init_type != "AsciiFile") { if (ParallelDescriptor::IOProcessor()) - std::cerr << "ERROR::particle_init_type is not AsciiFile but you specified agn_particle_file" << std::endl;; + std::cerr << "ERROR::particle_init_type is not AsciiFile but you specified agn_particle_file" << std::endl; amrex::Error(); } #endif @@ -106,7 +106,7 @@ Nyx::read_init_params () if (!neutrino_particle_file.empty() && particle_init_type != "AsciiFile") { if (ParallelDescriptor::IOProcessor()) - std::cerr << "ERROR::particle_init_type is not AsciiFile but you specified neutrino_particle_file" << std::endl;; + std::cerr << "ERROR::particle_init_type is not AsciiFile but you specified neutrino_particle_file" << std::endl; amrex::Error(); } #endif @@ -130,6 +130,9 @@ Nyx::read_init_params () void Nyx::init_zhi () { + BL_PROFILE("Nyx::init_zhi()"); + + if (ParallelDescriptor::IOProcessor()) std::cout << "Reading z_HI from file..."; const int file_res = inhomo_grid; const int prob_res = geom.Domain().longside(); @@ -161,6 +164,8 @@ Nyx::init_zhi () nd, BL_TO_FORTRAN(D_new[mfi]), ratio, BL_TO_FORTRAN(zhi[mfi])); } + + if (ParallelDescriptor::IOProcessor()) std::cout << "done.\n"; } void diff --git a/Source/Initialization/Nyx_setup.cpp b/Source/Initialization/Nyx_setup.cpp index 6b7efeff..898a08b7 100644 --- a/Source/Initialization/Nyx_setup.cpp +++ b/Source/Initialization/Nyx_setup.cpp @@ -134,46 +134,6 @@ Nyx::variable_setup() error_setup(); } -void -Nyx::variable_setup_for_new_comp_procs() -{ -std::cout << "***** fix Nyx::variable_setup_for_new_comp_procs()" << std::endl; -/* - BL_ASSERT(desc_lst.size() == 0); -// desc_lst.clear(); -// derive_lst.clear(); - - // Initialize the network - network_init(); - - - - - // Get options, set phys_bc - read_params(); - -#ifdef NO_HYDRO - no_hydro_setup(); - -#else - if (do_hydro == 1) - { - hydro_setup(); - } -#ifdef GRAVITY - else - { - no_hydro_setup(); - } -#endif -#endif - - // - // DEFINE ERROR ESTIMATION QUANTITIES - // - error_setup(); -*/ -} #ifndef NO_HYDRO void diff --git a/Source/Initialization/read_plotfile.cpp b/Source/Initialization/read_plotfile.cpp index df906286..7559c60d 100644 --- a/Source/Initialization/read_plotfile.cpp +++ b/Source/Initialization/read_plotfile.cpp @@ -26,13 +26,13 @@ void Nyx::ReadPlotFile (bool first, const std::string& file, bool& rhoe_infile) { - std::cout << "Reading data from plotfile: " << file << std::endl; + amrex::Print() << "Reading data from plotfile: " << file << std::endl; DataServices::SetBatchMode(); Amrvis::FileType fileType(Amrvis::NEWPLT); DataServices dataServices(file, fileType); - if (!dataServices.AmrDataOk()) + if ( ! dataServices.AmrDataOk()) // // This calls ParallelDescriptor::EndParallel() and exit() // @@ -72,8 +72,9 @@ Nyx::ReadPlotFile (bool first, amrex::Error("boxArray from plotfile doesn't match grids "); } - if (amrData.FinestLevel() != parent->finestLevel()) + if (amrData.FinestLevel() != parent->finestLevel()) { amrex::Error("finest_level from plotfile doesn't match finest_level from inputs file"); + } const int Nlev = parent->finestLevel() + 1; @@ -139,13 +140,12 @@ Nyx::ReadPlotFile (bool first, } } - if (ParallelDescriptor::IOProcessor()) - std::cout << "Successfully read state data" << std::endl; + amrex::Print() << "Successfully read state data" << std::endl; // // Read temperature and Ne if there is no rho_e in the file // - if (!rhoe_infile) + if ( ! rhoe_infile) { for (int lev = 0; lev < Nlev; ++lev) { @@ -158,11 +158,10 @@ Nyx::ReadPlotFile (bool first, D_new.copy(amrData.GetGrids(lev,iNE,bx),0,Ne_comp,1); amrData.FlushGrids(iNE); - std::cout << "D_new.max " << D_new.norm0() << std::endl;; + amrex::Print() << "D_new.max " << D_new.norm0() << std::endl;; } - if (ParallelDescriptor::IOProcessor()) - std::cout << "Successfully read temperature and Ne" << std::endl; + amrex::Print() << "Successfully read temperature and Ne" << std::endl; } #endif } diff --git a/Source/MG/cc_smoothers.f90 b/Source/MG/cc_smoothers.f90 deleted file mode 100644 index c75f08ce..00000000 --- a/Source/MG/cc_smoothers.f90 +++ /dev/null @@ -1,60 +0,0 @@ -module cc_smoothers_module - - use amrex_fort_module, only : rt => amrex_real - use bl_constants_module - use cc_stencil_module - - implicit none - -contains - - subroutine gs_rb_smoother_3d(omega, ss, uu, ff, mm, lo, ng, n, skwd) - use bl_prof_module - integer, intent(in) :: ng - integer, intent(in) :: lo(:) - integer, intent(in) :: n - real (rt), intent(in) :: omega - real (rt), intent(in) :: ff(lo(1):,lo(2):,lo(3):) - real (rt), intent(inout) :: uu(lo(1)-ng:,lo(2)-ng:,lo(3)-ng:) - real (rt), intent(in) :: ss(0:,lo(1):, lo(2):, lo(3):) - integer ,intent(in) :: mm(lo(1):,lo(2):,lo(3):) - logical, intent(in), optional :: skwd - integer :: i, j, k, ioff - integer :: hi(size(lo)) - integer, parameter :: XBC = 7, YBC = 8, ZBC = 9 - logical :: lskwd - real(rt) :: dd, dhsq_inv, ss0, ss0_inv - - type(bl_prof_timer), save :: bpt - - call build(bpt, "gs_rb_smoother_3d") - - hi = ubound(ff) - - ss0_inv = 1.d0/ss(0,lo(1),lo(2),lo(3)) - dhsq_inv = -ss(0,lo(1),lo(2),lo(3))/6.d0 - - !$OMP PARALLEL DO PRIVATE(k,j,i,ioff,dd) IF((hi(3)-lo(3)).ge.3) - do k = lo(3), hi(3) - do j = lo(2), hi(2) - ioff = 0; if ( mod (lo(1) + j + k, 2) /= n ) ioff = 1 - do i = lo(1)+ioff, hi(1), 2 - - dd = (-6.d0*uu(i,j,k) + & - uu(i+1,j,k) + uu(i-1,j,k) + & - uu(i,j+1,k) + uu(i,j-1,k) + & - uu(i,j,k+1) + uu(i,j,k-1) ) * dhsq_inv - - uu(i,j,k) = uu(i,j,k) + (ff(i,j,k) - dd)*ss0_inv -! uu(i,j,k) = uu(i,j,k) + (ff(i,j,k) - dd)* 1.d0/ss(0,i,j,k) - - end do - end do - end do - !$OMP END PARALLEL DO - - call destroy(bpt) - - end subroutine gs_rb_smoother_3d - -end module cc_smoothers_module diff --git a/Source/MG/cc_stencil_apply.f90 b/Source/MG/cc_stencil_apply.f90 deleted file mode 100644 index c3780b17..00000000 --- a/Source/MG/cc_stencil_apply.f90 +++ /dev/null @@ -1,1719 +0,0 @@ -module cc_stencil_apply_module - - use amrex_fort_module, only : rt => amrex_real - use bl_types - use bc_module - use bc_functions_module - use stencil_types_module - use multifab_module - - implicit none - - real(rt), parameter, private :: ZERO = 0.0_rt - real(rt), parameter, private :: ONE = 1.0_rt - - public :: stencil_apply_1d, stencil_apply_2d, stencil_apply_3d - private :: stencil_dense_apply_1d, stencil_dense_apply_2d, stencil_dense_apply_3d - private :: stencil_all_flux_1d, stencil_all_flux_2d, stencil_all_flux_3d - -contains - - subroutine stencil_apply_1d(ss, dd, ng_d, uu, ng_u, mm, lo, hi, stencil_type, skwd) - - integer, intent(in) :: ng_d, ng_u, lo(:), hi(:) - real (rt), intent(in) :: ss(0:,lo(1) :) - real (rt), intent(out) :: dd(lo(1)-ng_d:) - real (rt), intent(in) :: uu(lo(1)-ng_u:) - integer , intent(in) :: mm(lo(1):) - integer , intent(in) :: stencil_type - logical, intent(in), optional :: skwd - - integer, parameter :: XBC = 3 - logical :: lskwd - integer :: i - - lskwd = .true.; if ( present(skwd) ) lskwd = skwd - - do i = lo(1),hi(1) - dd(i) = ss(0,i)*uu(i) + ss(1,i)*uu(i+1) + ss(2,i)*uu(i-1) - end do - - if ( lskwd ) then - if (hi(1) > lo(1)) then - i = lo(1) - if (bc_skewed(mm(i),1,+1)) then - dd(i) = dd(i) + ss(XBC,i)*uu(i+2) - end if - - i = hi(1) - if (bc_skewed(mm(i),1,-1)) then - dd(i) = dd(i) + ss(XBC,i)*uu(i-2) - end if - end if - end if - - end subroutine stencil_apply_1d - - subroutine stencil_flux_1d(ss, flux, uu, mm, ng, ratio, face, dim, skwd) - - integer, intent(in) :: ng - real (rt), intent(in) :: ss(0:,:) - real (rt), intent(out) :: flux(:) - real (rt), intent(in) :: uu(1-ng:) - integer , intent(in) :: mm(:) - logical, intent(in), optional :: skwd - integer, intent(in) :: ratio, face, dim - integer nx - integer i - integer, parameter :: XBC = 3 - - real (rt) :: fac - - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - - ! This factor is dx^fine / dx^crse - fac = ONE / real(ratio,rt) - - if ( dim == 1 ) then - if ( face == -1 ) then - i = 1 - if (bc_dirichlet(mm(1),1,-1)) then - flux(1) = ss(1,i)*(uu(i+1)-uu(i)) + ss(2,i)*(uu(i-1)-uu(i)) & - - ss(2,i+1)*(uu(i+1)-uu(i)) - if (bc_skewed(mm(i),1,+1)) then - flux(1) = flux(1) + ss(XBC,i)*uu(i+2) - end if - else - flux(1) = Huge(flux) - end if - flux(1) = fac*flux(1) - else if ( face == 1 ) then - i = nx - if (bc_dirichlet(mm(i),1,+1)) then - flux(1) = ss(1,i)*(uu(i+1)-uu(i)) + ss(2,i)*(uu(i-1)-uu(i)) & - - ss(1,i-1)*(uu(i-1)-uu(i)) - if (bc_skewed(mm(i),1,-1)) then - flux(1) = flux(1) + ss(XBC,i)*uu(i-2) - end if - else - flux(1) = Huge(flux) - end if - flux(1) = fac*flux(1) - end if - end if - - end subroutine stencil_flux_1d - - subroutine stencil_apply_2d(ss, dd, ng_d, uu, ng_u, mm, lo, hi, stencil_type, skwd) - - integer , intent(in ) :: ng_d, ng_u, lo(:), hi(:) - real (rt), intent(in ) :: ss(0:,lo(1):,lo(2):) - real (rt), intent( out) :: dd(lo(1)-ng_d:,lo(2)-ng_d:) - real (rt), intent(inout) :: uu(lo(1)-ng_u:,lo(2)-ng_u:) - integer , intent(in ) :: mm(lo(1):,lo(2):) - integer , intent(in ) :: stencil_type - logical , intent(in ), optional :: skwd - - integer i,j - - integer, parameter :: XBC = 5, YBC = 6 - - logical :: lskwd - - lskwd = .true.; if ( present(skwd) ) lskwd = skwd - - ! This is the Minion 4th order cross stencil. - if (size(ss,dim=1) .eq. 9) then - - do j = lo(2),hi(2) - do i = lo(1),hi(1) - dd(i,j) = & - ss(0,i,j) * uu(i,j) & - + ss(1,i,j) * uu(i-2,j) + ss(2,i,j) * uu(i-1,j) & - + ss(3,i,j) * uu(i+1,j) + ss(4,i,j) * uu(i+2,j) & - + ss(5,i,j) * uu(i,j-2) + ss(6,i,j) * uu(i,j-1) & - + ss(7,i,j) * uu(i,j+1) + ss(8,i,j) * uu(i,j+2) - end do - end do - - ! This is the Minion 4th order full stencil. - else if (size(ss,dim=1) .eq. 25) then - - do j = lo(2),hi(2) - do i = lo(1),hi(1) - dd(i,j) = ss( 0,i,j) * uu(i,j) & - + ss( 1,i,j) * uu(i-2,j-2) + ss( 2,i,j) * uu(i-1,j-2) & ! AT J-2 - + ss( 3,i,j) * uu(i ,j-2) + ss( 4,i,j) * uu(i+1,j-2) & ! AT J-2 - + ss( 5,i,j) * uu(i+2,j-2) & ! AT J-2 - + ss( 6,i,j) * uu(i-2,j-1) + ss( 7,i,j) * uu(i-1,j-1) & ! AT J-1 - + ss( 8,i,j) * uu(i ,j-1) + ss( 9,i,j) * uu(i+1,j-1) & ! AT J-1 - + ss(10,i,j) * uu(i+2,j-1) & ! AT J-1 - + ss(11,i,j) * uu(i-2,j ) + ss(12,i,j) * uu(i-1,j ) & ! AT J - + ss(13,i,j) * uu(i+1,j ) + ss(14,i,j) * uu(i+2,j ) & ! AT J - + ss(15,i,j) * uu(i-2,j+1) + ss(16,i,j) * uu(i-1,j+1) & ! AT J+1 - + ss(17,i,j) * uu(i ,j+1) + ss(18,i,j) * uu(i+1,j+1) & ! AT J+1 - + ss(19,i,j) * uu(i+2,j+1) & ! AT J+1 - + ss(20,i,j) * uu(i-2,j+2) + ss(21,i,j) * uu(i-1,j+2) & ! AT J+2 - + ss(22,i,j) * uu(i ,j+2) + ss(23,i,j) * uu(i+1,j+2) & ! AT J+2 - + ss(24,i,j) * uu(i+2,j+2) ! AT J+2 - end do - end do - - ! This is our standard 5-point Laplacian with a possible correction at boundaries - else - - do j = lo(2),hi(2) - do i = lo(1),hi(1) - dd(i,j) = ss(0,i,j)*uu(i,j) & - + ss(1,i,j)*uu(i+1,j ) + ss(2,i,j)*uu(i-1,j ) & - + ss(3,i,j)*uu(i ,j+1) + ss(4,i,j)*uu(i ,j-1) - end do - end do - - if ( lskwd ) then - ! Corrections for skewed stencils - if (hi(1) > lo(1)) then - do j = lo(2),hi(2) - - i = lo(1) - if (bc_skewed(mm(i,j),1,+1)) then - dd(i,j) = dd(i,j) + ss(XBC,i,j)*uu(i+2,j) - end if - - i = hi(1) - if (bc_skewed(mm(i,j),1,-1)) then - dd(i,j) = dd(i,j) + ss(XBC,i,j)*uu(i-2,j) - end if - end do - end if - - if (hi(2) > lo(2)) then - do i = lo(1),hi(1) - - j = lo(2) - if (bc_skewed(mm(i,j),2,+1)) then - dd(i,j) = dd(i,j) + ss(YBC,i,j)*uu(i,j+2) - end if - - j = hi(2) - if (bc_skewed(mm(i,j),2,-1)) then - dd(i,j) = dd(i,j) + ss(YBC,i,j)*uu(i,j-2) - end if - - end do - end if - end if - end if - - end subroutine stencil_apply_2d - - subroutine stencil_apply_n_2d(ss, dd, ng_d, uu, ng_u, mm, lo, hi, stencil_type, skwd) - - integer , intent(in ) :: ng_d, ng_u, lo(:), hi(:) - real (rt), intent(in ) :: ss(0:,lo(1):,lo(2):) - real (rt), intent( out) :: dd(lo(1)-ng_d:,lo(2)-ng_d:) - real (rt), intent(inout) :: uu(lo(1)-ng_u:,lo(2)-ng_u:) - integer , intent(in ) :: mm(lo(1):,lo(2):) - integer , intent(in ) :: stencil_type - logical , intent(in ), optional :: skwd - - integer i,j,n,nc,dm,nm1,nedge,nset - - integer, parameter :: XBC = 6, YBC = 7 - - logical :: lskwd - - lskwd = .true.; if ( present(skwd) ) lskwd = skwd - - dm = 2 - nset = 1+3*dm - nc = (size(ss,dim=1)-1)/(nset+1) - nedge = nc*nset - - do j = lo(2),hi(2) - do i = lo(1),hi(1) - dd(i,j) = ss(0,i,j)*uu(i,j) - end do - end do - - do n = 1,nc - nm1 = (n-1)*nset - do j = lo(2),hi(2) - do i = lo(1),hi(1) - dd(i,j) = dd(i,j) + & - (ss(1+nm1,i,j)*uu(i,j) & - + ss(2+nm1,i,j)*uu(i+1,j ) + ss(3+nm1,i,j)*uu(i-1,j ) & - + ss(4+nm1,i,j)*uu(i ,j+1) + ss(5+nm1,i,j)*uu(i ,j-1) & - )/ss(nedge+n,i,j) - end do - end do - - if ( lskwd ) then - ! Corrections for skewed stencils - if (hi(1) > lo(1)) then - do j = lo(2),hi(2) - - i = lo(1) - if (bc_skewed(mm(i,j),1,+1)) then - dd(i,j) = dd(i,j) + ss(XBC+nm1,i,j)*uu(i+2,j) - end if - - i = hi(1) - if (bc_skewed(mm(i,j),1,-1)) then - dd(i,j) = dd(i,j) + ss(XBC+nm1,i,j)*uu(i-2,j) - end if - end do - end if - - if (hi(2) > lo(2)) then - do i = lo(1),hi(1) - - j = lo(2) - if (bc_skewed(mm(i,j),2,+1)) then - dd(i,j) = dd(i,j) + ss(YBC+nm1,i,j)*uu(i,j+2) - end if - - j = hi(2) - if (bc_skewed(mm(i,j),2,-1)) then - dd(i,j) = dd(i,j) + ss(YBC+nm1,i,j)*uu(i,j-2) - end if - end do - end if - end if - end do - - end subroutine stencil_apply_n_2d - - subroutine stencil_flux_2d(ss, flux, uu, mm, ng, ratio, face, dim, skwd) - integer, intent(in) :: ng - real (rt), intent(in ) :: uu(1-ng:,1-ng:) - real (rt), intent(out) :: flux(:,:) - real (rt), intent(in ) :: ss(0:,:,:) - integer , intent(in) :: mm(:,:) - logical, intent(in), optional :: skwd - integer, intent(in) :: ratio, face, dim - integer nx,ny - integer i,j,ic,jc - real (rt) :: fac - integer, parameter :: XBC = 5, YBC = 6 - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - - ! Note that one factor of ratio is the tangential averaging, while the - ! other is the normal factor - fac = ONE/real(ratio*ratio,rt) - -! Lo i face - if ( dim == 1 ) then - if (face == -1) then - - i = 1 - flux(1,:) = ZERO - do j = 1,ny - jc = (j-1)/ratio+1 - if (bc_dirichlet(mm(i,j),1,-1)) then - flux(1,jc) = flux(1,jc) & - + ss(1,i,j)*(uu(i+1,j)-uu(i,j)) & - + ss(2,i,j)*(uu(i-1,j)-uu(i,j)) - ss(2,i+1,j)*(uu(i+1,j)-uu(i,j)) - if (bc_skewed(mm(i,j),1,+1)) & - flux(1,jc) = flux(1,jc) + ss(XBC,i,j)*(uu(i+2,j)-uu(i,j)) - else - flux(1,jc) = Huge(flux) - end if - end do - flux(1,:) = fac * flux(1,:) - -! Hi i face - else if (face == 1) then - - i = nx - flux(1,:) = ZERO - do j = 1,ny - jc = (j-1)/ratio+1 - if (bc_dirichlet(mm(i,j),1,+1)) then - - flux(1,jc) = flux(1,jc) & - + ss(1,i,j)*(uu(i+1,j)-uu(i,j)) & - + ss(2,i,j)*(uu(i-1,j)-uu(i,j)) - ss(1,i-1,j)*(uu(i-1,j)-uu(i,j)) - if (bc_skewed(mm(i,j),1,-1)) & - flux(1,jc) = flux(1,jc) + ss(XBC,i,j)*(uu(i-2,j)-uu(i,j)) - else - flux(1,jc) = Huge(flux) - end if - end do - flux(1,:) = fac * flux(1,:) - - end if - -! Lo j face - else if ( dim == 2 ) then - if (face == -1) then - - j = 1 - flux(:,1) = ZERO - do i = 1,nx - ic = (i-1)/ratio+1 - if (bc_dirichlet(mm(i,j),2,-1)) then - flux(ic,1) = flux(ic,1) & - + ss(3,i,j)*(uu(i,j+1)-uu(i,j)) & - + ss(4,i,j)*(uu(i,j-1)-uu(i,j)) - ss(4,i,j+1)*(uu(i,j+1)-uu(i,j)) - if (bc_skewed(mm(i,j),2,+1)) & - flux(ic,1) = flux(ic,1) + ss(YBC,i,j)*(uu(i,j+2)-uu(i,j)) - else - flux(ic,1) = Huge(flux) - end if - end do - flux(:,1) = fac * flux(:,1) - - -! Hi j face - else if (face == 1) then - - j = ny - flux(:,1) = ZERO - do i = 1,nx - ic = (i-1)/ratio+1 - if (bc_dirichlet(mm(i,j),2,+1)) then - flux(ic,1) = flux(ic,1) & - + ss(3,i,j)*(uu(i,j+1)-uu(i,j)) & - + ss(4,i,j)*(uu(i,j-1)-uu(i,j)) - ss(3,i,j-1)*(uu(i,j-1)-uu(i,j)) - if (bc_skewed(mm(i,j),2,-1)) & - flux(ic,1) = flux(ic,1) + ss(YBC,i,j)*(uu(i,j-2)-uu(i,j)) - else - flux(ic,1) = Huge(flux) - end if - end do - flux(:,1) = fac * flux(:,1) - - end if - end if - - end subroutine stencil_flux_2d - - subroutine stencil_flux_n_2d(ss, flux, uu, mm, ng, ratio, face, dim, skwd) - integer, intent(in) :: ng - real (rt), intent(in ) :: uu(1-ng:,1-ng:) - real (rt), intent(out) :: flux(:,:,1:) - real (rt), intent(in ) :: ss(0:,:,:) - integer , intent(in) :: mm(:,:) - logical, intent(in), optional :: skwd - integer, intent(in) :: ratio, face, dim - integer nx,ny,dm,nc,nedge,nm1,nset - integer i,j,ic,jc,n - real (rt) :: fac - integer, parameter :: XBC = 6, YBC = 7 - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - - dm = 2 - nset = 1+3*dm - nc = (size(ss,dim=1)-1)/(nset+1) - nedge = nc*nset - - ! Note that one factor of ratio is the tangential averaging, while the - ! other is the normal factor - fac = ONE/real(ratio*ratio,rt) - -! Lo i face - if ( dim == 1 ) then - if (face == -1) then - - i = 1 - flux(1,:,:) = ZERO - do n = 1,nc - nm1 = (n-1)*nset - do j = 1,ny - jc = (j-1)/ratio+1 - if (bc_dirichlet(mm(i,j),1,-1)) then - flux(1,jc,n) = flux(1,jc,n) & - + ss(2+nm1,i,j)*(uu(i+1,j)-uu(i,j)) & - + ss(3+nm1,i,j)*(uu(i-1,j)-uu(i,j)) - ss(3+nm1,i+1,j)*(uu(i+1,j)-uu(i,j)) - if (bc_skewed(mm(i,j),1,+1)) & - flux(1,jc,n) = flux(1,jc,n) + ss(XBC+nm1,i,j)*(uu(i+2,j)-uu(i,j)) - else - flux(1,jc,n) = Huge(flux(:,:,n)) - end if - end do - flux(1,:,n) = fac * flux(1,:,n) - end do - -! Hi i face - else if (face == 1) then - - i = nx - flux(1,:,:) = ZERO - do n = 1,nc - nm1 = (n-1)*nset - do j = 1,ny - jc = (j-1)/ratio+1 - if (bc_dirichlet(mm(i,j),1,+1)) then - flux(1,jc,n) = flux(1,jc,n) & - + ss(2+nm1,i,j)*(uu(i+1,j)-uu(i,j)) & - + ss(3+nm1,i,j)*(uu(i-1,j)-uu(i,j)) - ss(2+nm1,i-1,j)*(uu(i-1,j)-uu(i,j)) - if (bc_skewed(mm(i,j),1,-1)) & - flux(1,jc,n) = flux(1,jc,n) + ss(XBC+nm1,i,j)*(uu(i-2,j)-uu(i,j)) - else - flux(1,jc,n) = Huge(flux(:,:,n)) - end if - end do - flux(1,:,n) = fac * flux(1,:,n) - end do - - end if - -! Lo j face - else if ( dim == 2 ) then - if (face == -1) then - - j = 1 - flux(:,1,:) = ZERO - do n = 1,nc - nm1 = (n-1)*nset - do i = 1,nx - ic = (i-1)/ratio+1 - if (bc_dirichlet(mm(i,j),2,-1)) then - flux(ic,1,n) = flux(ic,1,n) & - + ss(4+nm1,i,j)*(uu(i,j+1)-uu(i,j)) & - + ss(5+nm1,i,j)*(uu(i,j-1)-uu(i,j)) - ss(5+nm1,i,j+1)*(uu(i,j+1)-uu(i,j)) - if (bc_skewed(mm(i,j),2,+1)) & - flux(ic,1,n) = flux(ic,1,n) + ss(YBC+nm1,i,j)*(uu(i,j+2)-uu(i,j)) - else - flux(ic,1,n) = Huge(flux(:,:,n)) - end if - end do - flux(:,1,n) = fac * flux(:,1,n) - end do - - -! Hi j face - else if (face == 1) then - - j = ny - flux(:,1,:) = ZERO - do n = 1,nc - nm1 = (n-1)*nset - do i = 1,nx - ic = (i-1)/ratio+1 - if (bc_dirichlet(mm(i,j),2,+1)) then - flux(ic,1,n) = flux(ic,1,n) & - + ss(4+nm1,i,j)*(uu(i,j+1)-uu(i,j)) & - + ss(5+nm1,i,j)*(uu(i,j-1)-uu(i,j)) - ss(4+nm1,i,j-1)*(uu(i,j-1)-uu(i,j)) - if (bc_skewed(mm(i,j),2,-1)) & - flux(ic,1,n) = flux(ic,1,n) + ss(YBC+nm1,i,j)*(uu(i,j-2)-uu(i,j)) - else - flux(ic,1,n) = Huge(flux(:,:,n)) - end if - end do - flux(:,1,n) = fac * flux(:,1,n) - end do - - end if - end if - - end subroutine stencil_flux_n_2d - - subroutine stencil_apply_3d(ss, dd, ng_d, uu, ng_u, mm, stencil_type, skwd) - - integer , intent(in ) :: ng_d,ng_u - real (rt), intent(in ) :: ss(0:,:,:,:) - real (rt), intent(out) :: dd(1-ng_d:,1-ng_d:,1-ng_d:) - real (rt), intent(in ) :: uu(1-ng_u:,1-ng_u:,1-ng_u:) - integer , intent(in ) :: mm(:,:,:) - integer , intent(in ) :: stencil_type - logical , intent(in ), optional :: skwd - - integer nx,ny,nz,i,j,k - integer, parameter :: XBC = 7, YBC = 8, ZBC = 9 - logical :: lskwd - real (rt) :: coeff - - lskwd = .true.; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - nz = size(ss,dim=4) - - ! This is the Minion 4th order cross stencil. - if (size(ss,dim=1) .eq. 13) then - - !$OMP PARALLEL DO PRIVATE(i,j,k) IF(nz.ge.4) - do k = 1,nz - do j = 1,ny - do i = 1,nx - dd(i,j,k) = ss(0,i,j,k) * uu(i,j,k) & - + ss( 1,i,j,k) * uu(i-2,j,k) + ss( 2,i,j,k) * uu(i-1,j,k) & - + ss( 3,i,j,k) * uu(i+1,j,k) + ss( 4,i,j,k) * uu(i+2,j,k) & - + ss( 5,i,j,k) * uu(i,j-2,k) + ss( 6,i,j,k) * uu(i,j-1,k) & - + ss( 7,i,j,k) * uu(i,j+1,k) + ss( 8,i,j,k) * uu(i,j+2,k) & - + ss( 9,i,j,k) * uu(i,j,k-2) + ss(10,i,j,k) * uu(i,j,k-1) & - + ss(11,i,j,k) * uu(i,j,k+1) + ss(12,i,j,k) * uu(i,j,k+2) - end do - end do - end do - !$OMP END PARALLEL DO - - ! This is the 4th order cross stencil for variable coefficients. - else if (size(ss,dim=1) .eq. 61) then - - !$OMP PARALLEL DO PRIVATE(i,j,k) IF(nz.ge.4) - do k = 1,nz - do j = 1,ny - do i = 1,nx - dd(i,j,k) = & - ss( 0,i,j,k) * uu(i ,j ,k ) & - ! Contributions from k-2 - + ss( 1,i,j,k) * uu(i ,j-2,k-2) + ss( 2,i,j,k) * uu(i ,j-1,k-2) & - + ss( 3,i,j,k) * uu(i-2,j ,k-2) + ss( 4,i,j,k) * uu(i-1,j ,k-2) & - + ss( 5,i,j,k) * uu(i ,j ,k-2) + ss( 6,i,j,k) * uu(i+1,j ,k-2) & - + ss( 7,i,j,k) * uu(i+2,j ,k-2) + ss( 8,i,j,k) * uu(i ,j+1,k-2) & - + ss( 9,i,j,k) * uu(i ,j+2,k-2) & - ! Contributions from k-1 - + ss(10,i,j,k) * uu(i ,j-2,k-1) + ss(11,i,j,k) * uu(i ,j-1,k-1) & - + ss(12,i,j,k) * uu(i-2,j ,k-1) + ss(13,i,j,k) * uu(i-1,j ,k-1) & - + ss(14,i,j,k) * uu(i ,j ,k-1) + ss(15,i,j,k) * uu(i+1,j ,k-1) & - + ss(16,i,j,k) * uu(i+2,j ,k-1) + ss(17,i,j,k) * uu(i ,j+1,k-1) & - + ss(18,i,j,k) * uu(i ,j+2,k-1) & - ! Contributions from j-2,k - + ss(19,i,j,k) * uu(i-2,j-2,k ) + ss(20,i,j,k) * uu(i-1,j-2,k ) & - + ss(21,i,j,k) * uu(i ,j-2,k ) + ss(22,i,j,k) * uu(i+1,j-2,k ) & - + ss(23,i,j,k) * uu(i+2,j-2,k ) & - ! Contributions from j-1,k - + ss(24,i,j,k) * uu(i-2,j-1,k ) + ss(25,i,j,k) * uu(i-1,j-1,k ) & - + ss(26,i,j,k) * uu(i ,j-1,k ) + ss(27,i,j,k) * uu(i+1,j-1,k ) & - + ss(28,i,j,k) * uu(i+2,j-1,k ) & - ! Contributions from j ,k - + ss(29,i,j,k) * uu(i-2,j ,k ) + ss(30,i,j,k) * uu(i-1,j ,k ) & - + ss(31,i,j,k) * uu(i+1,j ,k ) & - + ss(32,i,j,k) * uu(i+2,j ,k ) & - ! Contributions from j+1,k - + ss(33,i,j,k) * uu(i-2,j+1,k ) + ss(34,i,j,k) * uu(i-1,j+1,k ) & - + ss(35,i,j,k) * uu(i ,j+1,k ) + ss(36,i,j,k) * uu(i+1,j+1,k ) & - + ss(37,i,j,k) * uu(i+2,j+1,k ) & - ! Contributions from j+2,k - + ss(38,i,j,k) * uu(i-2,j+2,k ) + ss(39,i,j,k) * uu(i-1,j+2,k ) & - + ss(40,i,j,k) * uu(i ,j+2,k ) + ss(41,i,j,k) * uu(i+1,j+2,k ) & - + ss(42,i,j,k) * uu(i+2,j+2,k ) & - ! Contributions from k+1 - + ss(43,i,j,k) * uu(i ,j-2,k+1) + ss(44,i,j,k) * uu(i ,j-1,k+1) & - + ss(45,i,j,k) * uu(i-2,j ,k+1) + ss(46,i,j,k) * uu(i-1,j ,k+1) & - + ss(47,i,j,k) * uu(i ,j ,k+1) + ss(48,i,j,k) * uu(i+1,j ,k+1) & - + ss(49,i,j,k) * uu(i+2,j ,k+1) + ss(50,i,j,k) * uu(i ,j+1,k+1) & - + ss(51,i,j,k) * uu(i ,j+2,k+1) & - ! Contributions from k+2 - + ss(52,i,j,k) * uu(i ,j-2,k+2) + ss(53,i,j,k) * uu(i ,j-1,k+2) & - + ss(54,i,j,k) * uu(i-2,j ,k+2) + ss(55,i,j,k) * uu(i-1,j ,k+2) & - + ss(56,i,j,k) * uu(i ,j ,k+2) + ss(57,i,j,k) * uu(i+1,j ,k+2) & - + ss(58,i,j,k) * uu(i+2,j ,k+2) + ss(59,i,j,k) * uu(i ,j+1,k+2) & - + ss(60,i,j,k) * uu(i ,j+2,k+2) - end do - end do - end do - !$OMP END PARALLEL DO - - ! This is the 2nd order cross stencil. - else - - !$OMP PARALLEL DO PRIVATE(i,j,k) IF(nz.ge.4) - coeff = ss(1,1,1,1) - do k = 1,nz - do j = 1,ny - do i = 1,nx - dd(i,j,k) = coeff * ( & - -6.d0*uu(i,j,k) + & - uu(i+1,j ,k ) + & - uu(i-1,j ,k ) + & - uu(i ,j+1,k ) + & - uu(i ,j-1,k ) + & - uu(i ,j ,k+1) + & - uu(i ,j ,k-1) ) -! dd(i,j,k) = & -! ss(0,i,j,k)*uu(i,j,k) + & -! ss(1,i,j,k)*uu(i+1,j ,k ) + & -! ss(2,i,j,k)*uu(i-1,j ,k ) + & -! ss(3,i,j,k)*uu(i ,j+1,k ) + & -! ss(4,i,j,k)*uu(i ,j-1,k ) + & -! ss(5,i,j,k)*uu(i ,j ,k+1) + & -! ss(6,i,j,k)*uu(i ,j ,k-1) - end do - end do - end do - !$OMP END PARALLEL DO - - end if - - if ( lskwd ) then - ! - ! Corrections for skewed stencils - ! - if (nx > 1) then - do k = 1, nz - do j = 1, ny - i = 1 - if (bc_skewed(mm(i,j,k),1,+1)) then - dd(i,j,k) = dd(i,j,k) + ss(XBC,i,j,k)*uu(i+2,j,k) - end if - - i = nx - if (bc_skewed(mm(i,j,k),1,-1)) then - dd(i,j,k) = dd(i,j,k) + ss(XBC,i,j,k)*uu(i-2,j,k) - end if - end do - end do - end if - - if (ny > 1) then - do k = 1,nz - do i = 1,nx - j = 1 - if (bc_skewed(mm(i,j,k),2,+1)) then - dd(i,j,k) = dd(i,j,k) + ss(YBC,i,j,k)*uu(i,j+2,k) - end if - - j = ny - if (bc_skewed(mm(i,j,k),2,-1)) then - dd(i,j,k) = dd(i,j,k) + ss(YBC,i,j,k)*uu(i,j-2,k) - end if - end do - end do - end if - - if (nz > 1) then - do j = 1,ny - do i = 1,nx - k = 1 - if (bc_skewed(mm(i,j,k),3,+1)) then - dd(i,j,k) = dd(i,j,k) + ss(ZBC,i,j,k)*uu(i,j,k+2) - end if - - k = nz - if (bc_skewed(mm(i,j,k),3,-1)) then - dd(i,j,k) = dd(i,j,k) + ss(ZBC,i,j,k)*uu(i,j,k-2) - end if - end do - end do - end if - end if - end subroutine stencil_apply_3d - - subroutine stencil_flux_3d(ss, flux, uu, mm, ng, ratio, face, dim, skwd) - integer, intent(in) :: ng - real (rt), intent(in ) :: uu(1-ng:,1-ng:,1-ng:) - real (rt), intent(out) :: flux(:,:,:) - real (rt), intent(in ) :: ss(0:,:,:,:) - integer , intent(in) :: mm(:,:,:) - logical, intent(in), optional :: skwd - integer, intent(in) :: ratio, face, dim - integer nx, ny, nz - integer i,j,k,ic,jc,kc - integer, parameter :: XBC = 7, YBC = 8, ZBC = 9 - real (rt) :: fac - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - nz = size(ss,dim=4) - - ! Note that two factors of ratio is from the tangential averaging, while the - ! other is the normal factor - fac = ONE/real(ratio*ratio*ratio,rt) - - ! Note: Do not try to add OMP calls to this subroutine. For example, - ! in the first k loop below, kc may end up having the same value - ! on multiple threads, and then you try to update the same flux(1,jc,kc) - ! memory simultaneously on different threads. - - ! Lo i face - if ( dim == 1 ) then - if (face == -1) then - - i = 1 - flux(1,:,:) = ZERO - do k = 1,nz - do j = 1,ny - jc = (j-1)/ratio + 1 - kc = (k-1)/ratio + 1 - if (bc_dirichlet(mm(i,j,k),1,-1)) then - flux(1,jc,kc) = flux(1,jc,kc) & - + ss(1,i,j,k)*(uu(i+1,j,k)-uu(i,j,k)) & - + ss(2,i,j,k)*(uu(i-1,j,k)-uu(i,j,k)) & - - ss(2,i+1,j,k)*(uu(i+1,j,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),1,+1)) & - flux(1,jc,kc) = flux(1,jc,kc) + ss(XBC,i,j,k)*(uu(i+2,j,k)-uu(i,j,k)) - else - flux(1,jc,kc) = Huge(flux) - end if - end do - end do - flux(1,:,:) = flux(1,:,:) * fac - - ! Hi i face - else if (face == 1) then - - i = nx - flux(1,:,:) = ZERO - do k = 1,nz - do j = 1,ny - jc = (j-1)/ratio + 1 - kc = (k-1)/ratio + 1 - if (bc_dirichlet(mm(i,j,k),1,+1)) then - flux(1,jc,kc) = flux(1,jc,kc) & - + ss(1,i,j,k)*(uu(i+1,j,k)-uu(i,j,k)) & - + ss(2,i,j,k)*(uu(i-1,j,k)-uu(i,j,k)) & - - ss(1,i-1,j,k)*(uu(i-1,j,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),1,-1)) & - flux(1,jc,kc) = flux(1,jc,kc) + ss(XBC,i,j,k)*(uu(i-2,j,k)-uu(i,j,k)) - else - flux(1,jc,kc) = Huge(flux) - end if - end do - end do - flux(1,:,:) = flux(1,:,:) * fac - - end if - - ! Lo j face - else if ( dim == 2 ) then - if (face == -1) then - j = 1 - flux(:,1,:) = ZERO - do k = 1,nz - do i = 1,nx - ic = (i-1)/ratio + 1 - kc = (k-1)/ratio + 1 - if (bc_dirichlet(mm(i,j,k),2,-1)) then - flux(ic,1,kc) = flux(ic,1,kc) & - + ss(3,i,j,k)*(uu(i,j+1,k)-uu(i,j,k)) & - + ss(4,i,j,k)*(uu(i,j-1,k)-uu(i,j,k)) & - - ss(4,i,j+1,k)*(uu(i,j+1,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),2,+1)) & - flux(ic,1,kc) = flux(ic,1,kc) + ss(YBC,i,j,k)*(uu(i,j+2,k)-uu(i,j,k)) - else - flux(ic,1,kc) = Huge(flux) - end if - end do - end do - flux(:,1,:) = flux(:,1,:) * fac - - ! Hi j face - else if (face == 1) then - j = ny - flux(:,1,:) = ZERO - do k = 1,nz - do i = 1,nx - ic = (i-1)/ratio + 1 - kc = (k-1)/ratio + 1 - - if (bc_dirichlet(mm(i,j,k),2,+1)) then - flux(ic,1,kc) = flux(ic,1,kc) & - + ss(3,i,j,k)*(uu(i,j+1,k)-uu(i,j,k)) & - + ss(4,i,j,k)*(uu(i,j-1,k)-uu(i,j,k)) & - - ss(3,i,j-1,k)*(uu(i,j-1,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),2,-1)) & - flux(ic,1,kc) = flux(ic,1,kc) + ss(YBC,i,j,k)*(uu(i,j-2,k)-uu(i,j,k)) - else - flux(ic,1,kc) = Huge(flux) - end if - end do - end do - flux(:,1,:) = flux(:,1,:) * fac - - end if - - ! Lo k face - else if ( dim == 3 ) then - if (face == -1) then - - k = 1 - flux(:,:,1) = ZERO - do j = 1,ny - do i = 1,nx - ic = (i-1)/ratio + 1 - jc = (j-1)/ratio + 1 - if (bc_dirichlet(mm(i,j,k),3,-1)) then - flux(ic,jc,1) = flux(ic,jc,1) & - + ss(5,i,j,k)*(uu(i,j,k+1)-uu(i,j,k)) & - + ss(6,i,j,k)*(uu(i,j,k-1)-uu(i,j,k)) & - - ss(6,i,j,k+1)*(uu(i,j,k+1)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),3,+1)) & - flux(ic,jc,1) = flux(ic,jc,1) + ss(ZBC,i,j,k)*(uu(i,j,k+2)-uu(i,j,k)) - else - flux(ic,jc,1) = Huge(flux) - end if - end do - end do - flux(:,:,1) = flux(:,:,1) * fac - - ! Hi k face - else if (face == 1) then - - k = nz - flux(:,:,1) = ZERO - do j = 1,ny - do i = 1,nx - ic = (i-1)/ratio + 1 - jc = (j-1)/ratio + 1 - if (bc_dirichlet(mm(i,j,k),3,+1)) then - flux(ic,jc,1) = flux(ic,jc,1) & - + ss(5,i,j,k)*(uu(i,j,k+1)-uu(i,j,k)) & - + ss(6,i,j,k)*(uu(i,j,k-1)-uu(i,j,k)) & - - ss(5,i,j,k-1)*(uu(i,j,k-1)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),3,-1)) & - flux(ic,jc,1) = flux(ic,jc,1) + ss(ZBC,i,j,k)*(uu(i,j,k-2)-uu(i,j,k)) - else - flux(ic,jc,1) = Huge(flux) - end if - end do - end do - flux(:,:,1) = flux(:,:,1) * fac - - end if - end if - - end subroutine stencil_flux_3d - - subroutine stencil_dense_apply_1d(ss, dd, ng_d, uu, ng_u) - integer, intent(in) :: ng_d, ng_u - real (rt), intent(in ) :: ss(0:,:) - real (rt), intent( out) :: dd(1-ng_d:) - real (rt), intent(in ) :: uu(1-ng_u:) - integer i, nx - - nx = size(ss,dim=2) - do i = 1, nx - dd(i) = ss(1,i)*uu(i-1) + ss(0,i)*uu(i) + ss(2,i)*uu(i+1) - end do - - end subroutine stencil_dense_apply_1d - - subroutine stencil_dense_apply_2d(ss, dd, ng_d, uu, ng_u) - integer, intent(in) :: ng_d, ng_u - real (rt), intent(in ) :: ss(0:,:,:) - real (rt), intent( out) :: dd(1-ng_d:,1-ng_d:) - real (rt), intent(in ) :: uu(1-ng_u:,1-ng_u:) - integer i, j, nx, ny - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - - do j = 1, ny - do i = 1, nx - dd(i,j) = & - + ss(1,i,j)*uu(i-1,j-1) + ss(2,i,j)*uu(i ,j-1) + ss(3,i,j)*uu(i+1,j-1) & - + ss(4,i,j)*uu(i-1,j ) + ss(0,i,j)*uu(i ,j ) + ss(5,i,j)*uu(i+1,j ) & - + ss(6,i,j)*uu(i-1,j+1) + ss(7,i,j)*uu(i ,j+1) + ss(8,i,j)*uu(i+1,j+1) - end do - end do - - end subroutine stencil_dense_apply_2d - - subroutine stencil_dense_apply_3d(ss, dd, ng_d, uu, ng_u) - integer, intent(in) :: ng_d, ng_u - real (rt), intent(in ) :: ss(0:,:,:,:) - real (rt), intent(in ) :: uu(1-ng_u:,1-ng_u:,1-ng_u:) - real (rt), intent( out) :: dd(1-ng_d:,1-ng_d:,1-ng_d:) - integer i, j, k, nx, ny, nz - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - nz = size(ss,dim=4) - - !$OMP PARALLEL DO PRIVATE(i,j,k) IF(nz.ge.4) - do k = 1, nz - do j = 1, ny - do i = 1, nx - dd(i,j,k) = & - + ss( 1,i,j,k)*uu(i-1,j-1,k-1) & - + ss( 2,i,j,k)*uu(i ,j-1,k-1) & - + ss( 3,i,j,k)*uu(i+1,j-1,k-1) & - + ss( 4,i,j,k)*uu(i-1,j ,k-1) & - + ss( 5,i,j,k)*uu(i ,j ,k-1) & - + ss( 6,i,j,k)*uu(i+1,j ,k-1) & - + ss( 7,i,j,k)*uu(i-1,j+1,k-1) & - + ss( 8,i,j,k)*uu(i ,j+1,k-1) & - + ss( 9,i,j,k)*uu(i+1,j+1,k-1) & - - + ss(10,i,j,k)*uu(i-1,j-1,k ) & - + ss(11,i,j,k)*uu(i ,j-1,k ) & - + ss(12,i,j,k)*uu(i+1,j-1,k ) & - + ss(13,i,j,k)*uu(i-1,j ,k ) & - + ss( 0,i,j,k)*uu(i ,j ,k ) & - + ss(14,i,j,k)*uu(i+1,j ,k ) & - + ss(15,i,j,k)*uu(i-1,j+1,k ) & - + ss(16,i,j,k)*uu(i ,j+1,k ) & - + ss(17,i,j,k)*uu(i+1,j+1,k ) & - - + ss(18,i,j,k)*uu(i-1,j-1,k+1) & - + ss(19,i,j,k)*uu(i ,j-1,k+1) & - + ss(20,i,j,k)*uu(i+1,j-1,k+1) & - + ss(21,i,j,k)*uu(i-1,j ,k+1) & - + ss(22,i,j,k)*uu(i ,j ,k+1) & - + ss(23,i,j,k)*uu(i+1,j ,k+1) & - + ss(24,i,j,k)*uu(i-1,j+1,k+1) & - + ss(25,i,j,k)*uu(i ,j+1,k+1) & - + ss(26,i,j,k)*uu(i+1,j+1,k+1) - end do - end do - end do - !$OMP END PARALLEL DO - - end subroutine stencil_dense_apply_3d - - subroutine stencil_fine_flux_1d(ss, flux, uu, mm, ng, face, dim, skwd) - integer, intent(in) :: ng - real (rt), intent(in) :: ss(0:,:) - real (rt), intent(out) :: flux(:) - real (rt), intent(in) :: uu(1-ng:) - integer , intent(in) :: mm(:) - logical, intent(in), optional :: skwd - integer, intent(in) :: face, dim - integer nx - integer i - integer, parameter :: XBC = 3 - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - - if ( dim == 1 ) then - if ( face == -1 ) then -! Lo i face - i = 1 - if (bc_dirichlet(mm(1),1,-1)) then - flux(1) = ss(1,i)*(uu(i+1)-uu(i)) + ss(2,i)*(uu(i-1)-uu(i)) & - - ss(2,i+1)*(uu(i+1)-uu(i)) - if (bc_skewed(mm(i),1,+1)) then - flux(1) = flux(1) + ss(XBC,i)*uu(i+2) - end if - else - flux(1) = ss(2,i)*(uu(i-1)-uu(i)) - end if - else if ( face == 1 ) then - -! Hi i face - i = nx - if (bc_dirichlet(mm(i),1,+1)) then - flux(1) = ss(1,i)*(uu(i+1)-uu(i)) + ss(2,i)*(uu(i-1)-uu(i)) & - - ss(1,i-1)*(uu(i-1)-uu(i)) - if (bc_skewed(mm(i),1,-1)) then - flux(1) = flux(1) + ss(XBC,i)*uu(i-2) - end if - else - flux(1) = ss(1,i)*(uu(i+1)-uu(i)) - end if - end if - end if - - end subroutine stencil_fine_flux_1d - - subroutine ml_fill_all_fluxes(ss, flux, uu, mm) - - use bl_prof_module - use multifab_module - - type( multifab), intent(in ) :: ss - type( multifab), intent(inout) :: flux(:) - type( multifab), intent(inout) :: uu - type(imultifab), intent(in ) :: mm - - integer :: dim, i, ngu, ngf - - real(rt), pointer :: fp(:,:,:,:) - real(rt), pointer :: up(:,:,:,:) - real(rt), pointer :: sp(:,:,:,:) - integer , pointer :: mp(:,:,:,:) - - type(bl_prof_timer), save :: bpt - call build(bpt, "ml_fill_all_fluxes") - - ngu = nghost(uu) - - if ( ncomp(uu) /= ncomp(flux(1)) ) then - call bl_error("ML_FILL_ALL_FLUXES: uu%nc /= flux%nc") - end if - - call multifab_fill_boundary(uu) - - do dim = 1, get_dim(uu) - do i = 1, nfabs(flux(dim)) - ngf = nghost(flux(dim)) - fp => dataptr(flux(dim), i) - up => dataptr(uu, i) - sp => dataptr(ss, i) - mp => dataptr(mm, i) - select case(get_dim(ss)) - case (1) - call stencil_all_flux_1d(sp(:,:,1,1), fp(:,1,1,1), up(:,1,1,1), & - mp(:,1,1,1), ngu, ngf) - case (2) - call stencil_all_flux_2d(sp(:,:,:,1), fp(:,:,1,1), up(:,:,1,1), & - mp(:,:,1,1), ngu, ngf, dim) - case (3) - call stencil_all_flux_3d(sp(:,:,:,:), fp(:,:,:,1), up(:,:,:,1), & - mp(:,:,:,1), ngu, ngf, dim) - end select - end do - end do - - call destroy(bpt) - - end subroutine ml_fill_all_fluxes - - subroutine stencil_all_flux_1d(ss, flux, uu, mm, ngu, ngf, skwd) - integer, intent(in) :: ngu, ngf - real (rt), intent(in ) :: uu(-ngu:) - real (rt), intent(out) :: flux(-ngf:) - real (rt), intent(in ) :: ss(0:,0:) - integer , intent(in) :: mm(0:) - logical, intent(in), optional :: skwd - integer nx - integer i - integer, parameter :: XBC = 3, YBC = 4 - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - - do i = 1,nx-2 - flux(i) = ss(2,i) * (uu(i)-uu(i-1)) - end do - - ! Must make sure we use stencil from interior fine cell, not fine cell next to c/f boundary - ! Because we use ss(2,i,j) which looks "down", we only modify at the high side - flux(nx-1) = ss(1,nx-2) * (uu(nx-1)-uu(nx-2)) - - ! Lo i face - i = 0 - if (bc_dirichlet(mm(i),1,-1)) then - flux(0) = & - ss(1,i)*(uu(i+1)-uu(i)) + ss(2,i )*(uu(i-1)-uu(i)) & - - ss(2,i+1)*(uu(i+1)-uu(i)) - if (bc_skewed(mm(i),1,+1)) & - flux(0) = flux(0) + ss(XBC,i)*(uu(i+2)-uu(i)) - flux(0) = -flux(0) - else if (bc_neumann(mm(i),1,-1)) then - flux(0) = -ss(2,i)*uu(i-1) - else - flux(0) = ss(2,i)*(uu(i)-uu(i-1)) - end if - - ! Hi i face - i = nx-1 - if (bc_dirichlet(mm(i),1,+1)) then - flux(nx) = & - ss(1,i )*(uu(i+1)-uu(i)) + ss(2,i)*(uu(i-1)-uu(i)) & - - ss(1,i-1)*(uu(i-1)-uu(i)) - if (bc_skewed(mm(i),1,-1)) & - flux(nx) = flux(nx) + ss(XBC,i)*(uu(i-2)-uu(i)) - else if (bc_neumann(mm(i),1,+1)) then - flux(nx) = ss(1,i)*uu(i+1) - else - flux(nx) = ss(1,i)*(uu(i+1)-uu(i)) - end if - - end subroutine stencil_all_flux_1d - - subroutine stencil_fine_flux_2d(ss, flux, uu, mm, ng, face, dim, skwd) - integer, intent(in) :: ng - real (rt), intent(in ) :: uu(1-ng:,1-ng:) - real (rt), intent(out) :: flux(:,:) - real (rt), intent(in ) :: ss(0:,:,:) - integer , intent(in) :: mm(:,:) - logical, intent(in), optional :: skwd - integer, intent(in) :: face, dim - integer nx,ny - integer i,j - integer, parameter :: XBC = 5, YBC = 6 - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - -! Lo i face - if ( dim == 1 ) then - if (face == -1) then - - i = 1 - flux(1,:) = ZERO - do j = 1,ny - if (bc_dirichlet(mm(i,j),1,-1)) then - flux(1,j) = & - ss(1,i,j)*(uu(i+1,j)-uu(i,j)) & - + ss(2,i,j)*(uu(i-1,j)-uu(i,j)) - ss(2,i+1,j)*(uu(i+1,j)-uu(i,j)) - if (bc_skewed(mm(i,j),1,+1)) & - flux(1,j) = flux(1,j) + ss(XBC,i,j)*(uu(i+2,j)-uu(i,j)) - else if (bc_neumann(mm(i,j),1,-1)) then - flux(1,j) = ss(2,i,j)*uu(i-1,j) - else - flux(1,j) = ss(2,i,j)*(uu(i-1,j)-uu(i,j)) - end if - end do - -! Hi i face - else if (face == 1) then - - i = nx - flux(1,:) = ZERO - do j = 1,ny - if (bc_dirichlet(mm(i,j),1,+1)) then - flux(1,j) = & - ss(1,i,j)*(uu(i+1,j)-uu(i,j)) & - + ss(2,i,j)*(uu(i-1,j)-uu(i,j)) - ss(1,i-1,j)*(uu(i-1,j)-uu(i,j)) - if (bc_skewed(mm(i,j),1,-1)) & - flux(1,j) = flux(1,j) + ss(XBC,i,j)*(uu(i-2,j)-uu(i,j)) - else if (bc_neumann(mm(i,j),1,+1)) then - flux(1,j) = ss(1,i,j)*uu(i+1,j) - else - flux(1,j) = ss(1,i,j)*(uu(i+1,j)-uu(i,j)) - end if - end do - - end if - -! Lo j face - else if ( dim == 2 ) then - if (face == -1) then - - j = 1 - flux(:,1) = ZERO - do i = 1,nx - if (bc_dirichlet(mm(i,j),2,-1)) then - flux(i,1) = & - ss(3,i,j)*(uu(i,j+1)-uu(i,j)) & - + ss(4,i,j)*(uu(i,j-1)-uu(i,j)) - ss(4,i,j+1)*(uu(i,j+1)-uu(i,j)) - if (bc_skewed(mm(i,j),2,+1)) & - flux(i,1) = flux(i,1) + ss(YBC,i,j)*(uu(i,j+2)-uu(i,j)) - else if (bc_neumann(mm(i,j),2,-1)) then - flux(i,1) = ss(4,i,j)*uu(i,j-1) - else - flux(i,1) = ss(4,i,j)*(uu(i,j-1)-uu(i,j)) - end if - end do - - -! Hi j face - else if (face == 1) then - - j = ny - flux(:,1) = ZERO - do i = 1,nx - if (bc_dirichlet(mm(i,j),2,+1)) then - flux(i,1) = & - ss(3,i,j)*(uu(i,j+1)-uu(i,j)) & - + ss(4,i,j)*(uu(i,j-1)-uu(i,j)) - ss(3,i,j-1)*(uu(i,j-1)-uu(i,j)) - if (bc_skewed(mm(i,j),2,-1)) & - flux(i,1) = flux(i,1) + ss(YBC,i,j)*(uu(i,j-2)-uu(i,j)) - else if (bc_neumann(mm(i,j),2,+1)) then - flux(i,1) = ss(3,i,j)*uu(i,j+1) - else - flux(i,1) = ss(3,i,j)*(uu(i,j+1)-uu(i,j)) - end if - end do - - end if - end if - - end subroutine stencil_fine_flux_2d - - subroutine stencil_all_flux_2d(ss, flux, uu, mm, ngu, ngf, dim, skwd) - integer, intent(in) :: ngu, ngf - real (rt), intent(in ) :: uu(-ngu:,-ngu:) - real (rt), intent(out) :: flux(-ngf:,-ngf:) - real (rt), intent(in ) :: ss(0:,0:,0:) - integer , intent(in) :: mm(0:,0:) - logical, intent(in), optional :: skwd - integer, intent(in) :: dim - integer nx,ny - integer i,j - integer, parameter :: XBC = 5, YBC = 6 - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - - if ( dim == 1 ) then - do j = 0,ny-1 - do i = 1,nx-2 - flux(i,j) = ss(2,i,j) * (uu(i,j)-uu(i-1,j)) - end do - end do - - ! Must make sure we use stencil from interior fine cell, not fine cell next to c/f boundary - ! Because we use ss(2,i,j) which looks "down", we only modify at the high side - do j = 0, ny-1 - flux(nx-1,j) = ss(1,nx-2,j) * (uu(nx-1,j)-uu(nx-2,j)) - end do - - ! Lo i face - i = 0 - do j = 0,ny-1 - if (bc_dirichlet(mm(i,j),1,-1)) then - flux(0,j) = ss(2,i,j) *(uu(i-1,j)-uu(i,j)) & - + (ss(1,i,j)-ss(2,i+1,j))*(uu(i+1,j)-uu(i,j)) - if (bc_skewed(mm(i,j),1,+1)) & - flux(0,j) = flux(0,j) + ss(XBC,i,j)*(uu(i+2,j)-uu(i,j)) - flux(0,j) = -flux(0,j) - else if (bc_neumann(mm(i,j),1,-1)) then - flux(0,j) = -ss(2,i,j)*uu(i-1,j) - else - flux(0,j) = ss(2,i,j)*(uu(i,j)-uu(i-1,j)) - end if - end do - - ! Hi i face - i = nx-1 - do j = 0,ny-1 - if (bc_dirichlet(mm(i,j),1,+1)) then - flux(nx,j) = ss(1,i,j) *(uu(i+1,j)-uu(i,j)) & - + (ss(2,i,j)-ss(1,i-1,j))*(uu(i-1,j)-uu(i,j)) - if (bc_skewed(mm(i,j),1,-1)) & - flux(nx,j) = flux(nx,j) + ss(XBC,i,j)*(uu(i-2,j)-uu(i,j)) - else if (bc_neumann(mm(i,j),1,+1)) then - flux(nx,j) = ss(1,i,j)*uu(i+1,j) - else - flux(nx,j) = ss(1,i,j)*(uu(i+1,j)-uu(i,j)) - end if - end do - - else if ( dim == 2 ) then - - do j = 1,ny-2 - do i = 0,nx-1 - flux(i,j) = ss(4,i,j) * (uu(i,j)-uu(i,j-1)) - end do - end do - - ! Must make sure we use stencil from interior cell, not cell next to c/f boundary - ! Because we use ss(4,i,j) which looks "down", we only modify at the high side - do i = 0,nx-1 - flux(i,ny-1) = ss(3,i,ny-2) * (uu(i,ny-1)-uu(i,ny-2)) - end do - - ! Lo j face - j = 0 - do i = 0,nx-1 - if (bc_dirichlet(mm(i,j),2,-1)) then - flux(i,0) = & - ss(3,i,j)*(uu(i,j+1)-uu(i,j)) + ss(4,i,j )*(uu(i,j-1)-uu(i,j)) & - - ss(4,i,j+1)*(uu(i,j+1)-uu(i,j)) - if (bc_skewed(mm(i,j),2,+1)) & - flux(i,0) = flux(i,0) + ss(YBC,i,j)*(uu(i,j+2)-uu(i,j)) - flux(i,0) = -flux(i,0) - else if (bc_neumann(mm(i,j),2,-1)) then - flux(i,0) = -ss(4,i,j)*uu(i,j-1) - else - flux(i,0) = ss(4,i,j)*(uu(i,j)-uu(i,j-1)) - end if - end do - - ! Hi j face - j = ny-1 - do i = 0,nx-1 - if (bc_dirichlet(mm(i,j),2,+1)) then - flux(i,ny) = & - ss(3,i,j )*(uu(i,j+1)-uu(i,j)) + ss(4,i,j)*(uu(i,j-1)-uu(i,j)) & - - ss(3,i,j-1)*(uu(i,j-1)-uu(i,j)) - if (bc_skewed(mm(i,j),2,-1)) & - flux(i,ny) = flux(i,ny) + ss(YBC,i,j)*(uu(i,j-2)-uu(i,j)) - else if (bc_neumann(mm(i,j),2,+1)) then - flux(i,ny) = ss(3,i,j)*uu(i,j+1) - else - flux(i,ny) = ss(3,i,j)*(uu(i,j+1)-uu(i,j)) - end if - flux(i,ny-1) = ss(4,i,ny-2) * (uu(i,j)-uu(i,j-1)) - end do - - end if - - end subroutine stencil_all_flux_2d - - subroutine stencil_fine_flux_3d(ss, flux, uu, mm, ng, face, dim, skwd) - integer, intent(in) :: ng - real (rt), intent(in ) :: ss(0:,:,:,:) - real (rt), intent(out) :: flux(:,:,:) - real (rt), intent(in ) :: uu(1-ng:,1-ng:,1-ng:) - integer , intent(in) :: mm(:,:,:) - logical, intent(in), optional :: skwd - integer, intent(in) :: face, dim - integer nx, ny, nz - integer i,j,k - integer, parameter :: XBC = 7, YBC = 8, ZBC = 9 - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - nz = size(ss,dim=4) - - if ( dim == 1 ) then - ! Lo i face - if (face == -1) then - - i = 1 - flux(1,:,:) = ZERO - - do k = 1,nz - do j = 1,ny - if (bc_dirichlet(mm(i,j,k),1,-1)) then - flux(1,j,k) = & - ss(1,i,j,k)*(uu(i+1,j,k)-uu(i,j,k)) & - + ss(2,i,j,k)*(uu(i-1,j,k)-uu(i,j,k)) & - - ss(2,i+1,j,k)*(uu(i+1,j,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),1,+1)) & - flux(1,j,k) = flux(1,j,k) + ss(XBC,i,j,k)*(uu(i+2,j,k)-uu(i,j,k)) - else if (bc_neumann(mm(i,j,k),1,-1)) then - flux(1,j,k) = ss(2,i,j,k)*uu(i-1,j,k) - else - flux(1,j,k) = ss(2,i,j,k)*(uu(i-1,j,k)-uu(i,j,k)) - end if - end do - end do - - ! Hi i face - else if (face == 1) then - - i = nx - flux(1,:,:) = ZERO - do k = 1,nz - do j = 1,ny - if (bc_dirichlet(mm(i,j,k),1,+1)) then - flux(1,j,k) = & - ss(1,i,j,k)*(uu(i+1,j,k)-uu(i,j,k)) & - + ss(2,i,j,k)*(uu(i-1,j,k)-uu(i,j,k)) & - - ss(1,i-1,j,k)*(uu(i-1,j,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),1,-1)) & - flux(1,j,k) = flux(1,j,k) + ss(XBC,i,j,k)*(uu(i-2,j,k)-uu(i,j,k)) - else if (bc_neumann(mm(i,j,k),1,+1)) then - flux(1,j,k) = ss(1,i,j,k)*uu(i+1,j,k) - else - flux(1,j,k) = ss(1,i,j,k)*(uu(i+1,j,k)-uu(i,j,k)) - end if - end do - end do - end if - - else if ( dim == 2 ) then - - ! Lo j face - if (face == -1) then - j = 1 - flux(:,1,:) = ZERO - do k = 1,nz - do i = 1,nx - if (bc_dirichlet(mm(i,j,k),2,-1)) then - flux(i,1,k) = & - ss(3,i,j,k)*(uu(i,j+1,k)-uu(i,j,k)) & - + ss(4,i,j,k)*(uu(i,j-1,k)-uu(i,j,k)) & - - ss(4,i,j+1,k)*(uu(i,j+1,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),2,+1)) & - flux(i,1,k) = flux(i,1,k) + ss(YBC,i,j,k)*(uu(i,j+2,k)-uu(i,j,k)) - else if (bc_neumann(mm(i,j,k),2,-1)) then - flux(i,1,k) = ss(4,i,j,k)*uu(i,j-1,k) - else - flux(i,1,k) = ss(4,i,j,k)*(uu(i,j-1,k)-uu(i,j,k)) - end if - end do - end do - - ! Hi j face - else if (face == 1) then - - j = ny - flux(:,1,:) = ZERO - do k = 1,nz - do i = 1,nx - if (bc_dirichlet(mm(i,j,k),2,+1)) then - flux(i,1,k) = & - ss(3,i,j,k)*(uu(i,j+1,k)-uu(i,j,k)) & - + ss(4,i,j,k)*(uu(i,j-1,k)-uu(i,j,k)) & - - ss(3,i,j-1,k)*(uu(i,j-1,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),2,-1)) & - flux(i,1,k) = flux(i,1,k) + ss(YBC,i,j,k)*(uu(i,j-2,k)-uu(i,j,k)) - else if (bc_neumann(mm(i,j,k),2,+1)) then - flux(i,1,k) = ss(3,i,j,k)*uu(i,j+1,k) - else - flux(i,1,k) = ss(3,i,j,k)*(uu(i,j+1,k)-uu(i,j,k)) - end if - end do - end do - end if - - else if ( dim == 3 ) then - - ! Lo k face - if (face == -1) then - - k = 1 - flux(:,:,1) = ZERO - do j = 1,ny - do i = 1,nx - if (bc_dirichlet(mm(i,j,k),3,-1)) then - flux(i,j,1) = & - ss(5,i,j,k)*(uu(i,j,k+1)-uu(i,j,k)) & - + ss(6,i,j,k)*(uu(i,j,k-1)-uu(i,j,k)) & - - ss(6,i,j,k+1)*(uu(i,j,k+1)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),3,+1)) & - flux(i,j,1) = flux(i,j,1) + ss(ZBC,i,j,k)*(uu(i,j,k+2)-uu(i,j,k)) - else if (bc_neumann(mm(i,j,k),3,-1)) then - flux(i,j,1) = ss(6,i,j,k)*uu(i,j,k-1) - else - flux(i,j,1) = ss(6,i,j,k)*(uu(i,j,k-1)-uu(i,j,k)) - end if - end do - end do - - ! Hi k face - else if (face == 1) then - - k = nz - flux(:,:,1) = ZERO - do j = 1,ny - do i = 1,nx - if (bc_dirichlet(mm(i,j,k),3,+1)) then - flux(i,j,1) = & - ss(5,i,j,k)*(uu(i,j,k+1)-uu(i,j,k)) & - + ss(6,i,j,k)*(uu(i,j,k-1)-uu(i,j,k)) & - - ss(5,i,j,k-1)*(uu(i,j,k-1)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),3,-1)) & - flux(i,j,1) = flux(i,j,1) + ss(ZBC,i,j,k)*(uu(i,j,k-2)-uu(i,j,k)) - else if (bc_neumann(mm(i,j,k),3,+1)) then - flux(i,j,1) = ss(5,i,j,k)*uu(i,j,k+1) - else - flux(i,j,1) = ss(5,i,j,k)*(uu(i,j,k+1)-uu(i,j,k)) - end if - end do - end do - - end if - end if - - end subroutine stencil_fine_flux_3d - - subroutine stencil_all_flux_3d(ss, flux, uu, mm, ngu, ngf, dim, skwd) - integer, intent(in) :: ngu,ngf - real(rt), intent(in ) :: uu(-ngu:,-ngu:,-ngu:) - real(rt), intent(out) :: flux(-ngf:,-ngf:,-ngf:) - real(rt), intent(in ) :: ss(0:,0:,0:,0:) - integer , intent(in) :: mm(0:,0:,0:) - logical, intent(in), optional :: skwd - integer, intent(in) :: dim - integer nx, ny, nz - integer i,j,k - integer, parameter :: XBC = 7, YBC = 8, ZBC = 9 - logical :: lskwd - - lskwd = .true. ; if ( present(skwd) ) lskwd = skwd - - nx = size(ss,dim=2) - ny = size(ss,dim=3) - nz = size(ss,dim=4) - - if ( dim == 1 ) then - - !$OMP PARALLEL DO PRIVATE(i,j,k) - do k = 0,nz-1 - do j = 0,ny-1 - do i = 1,nx-2 - flux(i,j,k) = ss(2,i,j,k) * (uu(i,j,k)-uu(i-1,j,k)) - end do - end do - end do - !$OMP END PARALLEL DO - - ! Must make sure we use stencil from interior fine cell, not fine cell next to c/f boundary - ! Because we use ss(2,i,j) which looks "down", we only modify at the high side - !$OMP PARALLEL DO PRIVATE(j,k) - do k = 0,nz-1 - do j = 0,ny-1 - flux(nx-1,j,k) = ss(1,nx-2,j,k) * (uu(nx-1,j,k)-uu(nx-2,j,k)) - end do - end do - !$OMP END PARALLEL DO - - ! Lo i face - i = 0 - do k = 0,nz-1 - do j = 0,ny-1 - if (bc_dirichlet(mm(i,j,k),1,-1)) then - flux(0,j,k) = & - ss(1,i,j,k)*(uu(i+1,j,k)-uu(i,j,k)) & - + ss(2,i,j,k)*(uu(i-1,j,k)-uu(i,j,k)) & - - ss(2,i+1,j,k)*(uu(i+1,j,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),1,+1)) & - flux(0,j,k) = flux(0,j,k) + ss(XBC,i,j,k)*(uu(i+2,j,k)-uu(i,j,k)) - flux(0,j,k) = -flux(0,j,k) - else if (bc_neumann(mm(i,j,k),1,-1)) then - flux(0,j,k) = -ss(2,i,j,k)*uu(i-1,j,k) - else - flux(0,j,k) = ss(2,i,j,k)*(uu(i,j,k)-uu(i-1,j,k)) - end if - end do - end do - - ! Hi i face - i = nx-1 - do k = 0,nz-1 - do j = 0,ny-1 - if (bc_dirichlet(mm(i,j,k),1,+1)) then - flux(nx,j,k) = & - ss(1,i,j,k)*(uu(i+1,j,k)-uu(i,j,k)) & - + ss(2,i,j,k)*(uu(i-1,j,k)-uu(i,j,k)) & - - ss(1,i-1,j,k)*(uu(i-1,j,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),1,-1)) & - flux(nx,j,k) = flux(nx,j,k) + ss(XBC,i,j,k)*(uu(i-2,j,k)-uu(i,j,k)) - else if (bc_neumann(mm(i,j,k),1,+1)) then - flux(nx,j,k) = ss(1,i,j,k)*uu(i+1,j,k) - else - flux(nx,j,k) = ss(1,i,j,k)*(uu(i+1,j,k)-uu(i,j,k)) - end if - end do - end do - - else if ( dim == 2 ) then - - !$OMP PARALLEL DO PRIVATE(i,j,k) - do k = 0,nz-1 - do j = 1,ny-2 - do i = 0,nx-1 - flux(i,j,k) = ss(4,i,j,k) * (uu(i,j,k)-uu(i,j-1,k)) - end do - end do - end do - !$OMP END PARALLEL DO - - ! Must make sure we use stencil from interior fine cell, not fine cell next to c/f boundary - ! Because we use ss(2,i,j) which looks "down", we only modify at the high side - !$OMP PARALLEL DO PRIVATE(i,k) - do k = 0,nz-1 - do i = 0,nx-1 - flux(i,ny-1,k) = ss(3,i,ny-2,k) * (uu(i,ny-1,k)-uu(i,ny-2,k)) - end do - end do - !$OMP END PARALLEL DO - - ! Lo j face - j = 0 - do k = 0,nz-1 - do i = 0,nx-1 - if (bc_dirichlet(mm(i,j,k),2,-1)) then - flux(i,0,k) = & - ss(3,i,j,k)*(uu(i,j+1,k)-uu(i,j,k)) & - + ss(4,i,j,k)*(uu(i,j-1,k)-uu(i,j,k)) & - - ss(4,i,j+1,k)*(uu(i,j+1,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),2,+1)) & - flux(i,0,k) = flux(i,0,k) + ss(YBC,i,j,k)*(uu(i,j+2,k)-uu(i,j,k)) - flux(i,0,k) = -flux(i,0,k) - else if (bc_neumann(mm(i,j,k),2,-1)) then - flux(i,0,k) = -ss(4,i,j,k)*uu(i,j-1,k) - else - flux(i,0,k) = ss(4,i,j,k)*(uu(i,j,k)-uu(i,j-1,k)) - end if - end do - end do - - ! Hi j face - j = ny-1 - do k = 0,nz-1 - do i = 0,nx-1 - if (bc_dirichlet(mm(i,j,k),2,+1)) then - flux(i,ny,k) = & - ss(3,i,j,k)*(uu(i,j+1,k)-uu(i,j,k)) & - + ss(4,i,j,k)*(uu(i,j-1,k)-uu(i,j,k)) & - - ss(3,i,j-1,k)*(uu(i,j-1,k)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),2,-1)) & - flux(i,ny,k) = flux(i,1,ny) + ss(YBC,i,j,k)*(uu(i,j-2,k)-uu(i,j,k)) - else if (bc_neumann(mm(i,j,k),2,+1)) then - flux(i,ny,k) = ss(3,i,j,k)*uu(i,j+1,k) - else - flux(i,ny,k) = ss(3,i,j,k)*(uu(i,j+1,k)-uu(i,j,k)) - end if - end do - end do - - else if ( dim == 3 ) then - - !$OMP PARALLEL DO PRIVATE(i,j,k) - do k = 1,nz-2 - do j = 0,ny-1 - do i = 0,nx-1 - flux(i,j,k) = ss(6,i,j,k) * (uu(i,j,k)-uu(i,j,k-1)) - end do - end do - end do - !$OMP END PARALLEL DO - - ! Must make sure we use stencil from interior fine cell, not fine cell next to c/f boundary - ! Because we use ss(2,i,j) which looks "down", we only modify at the high side - !$OMP PARALLEL DO PRIVATE(i,j) - do j = 0,ny-1 - do i = 0,nx-1 - flux(i,j,nz-1) = ss(5,i,j,nz-2) * (uu(i,j,nz-1)-uu(i,j,nz-2)) - end do - end do - !$OMP END PARALLEL DO - - - ! Lo k face - k = 0 - do j = 0,ny-1 - do i = 0,nx-1 - if (bc_dirichlet(mm(i,j,k),3,-1)) then - flux(i,j,0) = & - ss(5,i,j,k)*(uu(i,j,k+1)-uu(i,j,k)) & - + ss(6,i,j,k)*(uu(i,j,k-1)-uu(i,j,k)) & - - ss(6,i,j,k+1)*(uu(i,j,k+1)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),3,+1)) & - flux(i,j,0) = flux(i,j,0) + ss(ZBC,i,j,k)*(uu(i,j,k+2)-uu(i,j,k)) - flux(i,j,0) = -flux(i,j,0) - else if (bc_neumann(mm(i,j,k),3,-1)) then - flux(i,j,0) = -ss(6,i,j,k)*uu(i,j,k-1) - else - flux(i,j,0) = ss(6,i,j,k)*(uu(i,j,k)-uu(i,j,k-1)) - end if - end do - end do - - ! Hi k face - k = nz-1 - do j = 0,ny-1 - do i = 0,nx-1 - if (bc_dirichlet(mm(i,j,k),3,+1)) then - flux(i,j,nz) = & - ss(5,i,j,k)*(uu(i,j,k+1)-uu(i,j,k)) & - + ss(6,i,j,k)*(uu(i,j,k-1)-uu(i,j,k)) & - - ss(5,i,j,k-1)*(uu(i,j,k-1)-uu(i,j,k)) - if (bc_skewed(mm(i,j,k),3,-1)) & - flux(i,j,nz) = flux(i,j,nz) + ss(ZBC,i,j,k)*(uu(i,j,k-2)-uu(i,j,k)) - else if (bc_neumann(mm(i,j,k),3,+1)) then - flux(i,j,nz) = ss(5,i,j,k)*uu(i,j,k+1) - else - flux(i,j,nz) = ss(5,i,j,k)*(uu(i,j,k+1)-uu(i,j,k)) - end if - end do - end do - - end if - - end subroutine stencil_all_flux_3d - -end module cc_stencil_apply_module diff --git a/Source/MG/mg_tower_smoother.f90 b/Source/MG/mg_tower_smoother.f90 deleted file mode 100644 index 8337b8ec..00000000 --- a/Source/MG/mg_tower_smoother.f90 +++ /dev/null @@ -1,74 +0,0 @@ -module mg_smoother_module - - use amrex_fort_module, only : rt => amrex_real - use multifab_module - use cc_stencil_module - use mg_tower_module - use bl_timer_module - - implicit none - -contains - - subroutine mg_tower_smoother(mgt, lev, ss, uu, ff, mm) - - use bl_prof_module - use cc_smoothers_module, only: gs_rb_smoother_3d - - integer , intent(in ) :: lev - type( mg_tower), intent(inout) :: mgt - type( multifab), intent(inout) :: uu - type( multifab), intent(in ) :: ff - type( multifab), intent(in ) :: ss - type(imultifab), intent(in ) :: mm - - real(rt), pointer :: fp(:,:,:,:) - real(rt), pointer :: up(:,:,:,:) - real(rt), pointer :: sp(:,:,:,:) - integer , pointer :: mp(:,:,:,:) - integer :: i, k, n, ng, nn, stat, npts - integer :: lo(mgt%dim) - type(bl_prof_timer), save :: bpt - logical :: pmask(mgt%dim), singular_test - real(rt) :: local_eps - - if (.not.nodal_q(ff)) then - singular_test = mgt%bottom_singular .and. mgt%coeffs_sum_to_zero - end if - - pmask = get_pmask(get_layout(uu)) - - ! Make sure to define this here so we don't assume a certain number of ghost cells for uu - ng = nghost(uu) - - call build(bpt, "mgt_smoother") - - if (mgt%skewed_not_set(lev)) then - do i = 1, nfabs(mm) - mp => dataptr(mm, i) - mgt%skewed(lev,i) = skewed_q(mp) - end do - mgt%skewed_not_set(lev) = .false. - end if - - do nn = 0, 1 - call multifab_fill_boundary(uu, cross = mgt%lcross) - - do i = 1, nfabs(ff) - up => dataptr(uu, i) - fp => dataptr(ff, i) - sp => dataptr(ss, i) - mp => dataptr(mm, i) - lo = lwb(get_box(ss, i)) - call gs_rb_smoother_3d(mgt%omega, sp(:,:,:,:), up(:,:,:,1), & - fp(:,:,:,1), mp(:,:,:,1), lo, ng, nn, & - mgt%skewed(lev,i)) - end do - - end do - - call destroy(bpt) - - end subroutine mg_tower_smoother - -end module mg_smoother_module diff --git a/Source/Make.package b/Source/Make.package index d001e60b..6ec5c214 100644 --- a/Source/Make.package +++ b/Source/Make.package @@ -1,12 +1,15 @@ -CEXE_sources += advance_particles.cpp +ifneq ($(USE_HENSON), TRUE) +CEXE_sources += main.cpp +endif +CEXE_sources += nyx_main.cpp + +CEXE_sources += advance_particles.cpp CEXE_sources += Nyx.cpp CEXE_sources += Nyx_advance.cpp CEXE_sources += Nyx_halos.cpp CEXE_sources += Nyx_output.cpp -CEXE_sources += Nyx_slice.cpp CEXE_sources += NyxBld.cpp -CEXE_sources += main.cpp CEXE_sources += NyxParticles.cpp CEXE_sources += ParticleDerive.cpp CEXE_sources += NeutrinoParticleContainer.cpp @@ -24,7 +27,6 @@ CEXE_sources += strang_splitting.cpp endif CEXE_headers += Nyx.H -CEXE_headers += Nyx_slice.H CEXE_headers += Nyx_output.H CEXE_headers += NyxParticleContainer.H CEXE_headers += DarkMatterParticleContainer.H diff --git a/Source/Nyx.H b/Source/Nyx.H index 0b270569..4c015a95 100644 --- a/Source/Nyx.H +++ b/Source/Nyx.H @@ -80,6 +80,8 @@ public: // virtual void checkPoint(const std::string& dir, std::ostream& os, amrex::VisMF::How how, bool dump_old); + virtual void checkPointPre(const std::string& dir, std::ostream& os); + virtual void checkPointPost(const std::string& dir, std::ostream& os); // A string written as the first item in `write_plot_file()` at level zero. // It is so we can distinguish between different types of plot files. For @@ -92,6 +94,8 @@ public: //Write a plotfile to specified directory. // virtual void writePlotFile(const std::string& dir, ostream& os, amrex::VisMF::How how); + virtual void writePlotFilePre(const std::string& dir, ostream& os); + virtual void writePlotFilePost(const std::string& dir, ostream& os); // //Write amrex::MultiFab as plot file @@ -112,7 +116,6 @@ public: //Define data descriptors. // static void variable_setup(); - static void variable_setup_for_new_comp_procs(); static void hydro_setup(); static void no_hydro_setup(); @@ -482,6 +485,10 @@ public: void compute_new_temp(); void compute_rho_temp(amrex::Real& rho_T_avg, amrex::Real& T_avg, amrex::Real& Tinv_avg, amrex::Real& T_meanrho); + void compute_gas_fractions(amrex::Real T_cut, amrex::Real rho_cut, + amrex::Real& whim_mass_frac, amrex::Real& whim_vol_frac, + amrex::Real& hh_mass_frac, amrex::Real& hh_vol_frac, + amrex::Real& igm_mass_frac, amrex::Real& igm_vol_frac); void get_old_source(amrex::Real old_time, amrex::Real dt, amrex::MultiFab& Rhs); void get_new_source(amrex::Real old_time, amrex::Real new_time, amrex::Real dt, amrex::MultiFab& Rhs); @@ -546,15 +553,6 @@ public: amrex::MultiFab* fine_mask; amrex::MultiFab* build_fine_mask(); - static int forceParticleRedist; // ---- for dynamic sidecars - static int nSidecarProcs; - - virtual void AddProcsToComp(amrex::Amr *aptr, int nSidecarProcs, int prevSidecarProcs, - int ioProcNumSCS, int ioProcNumAll, int scsMyId, - MPI_Comm scsComm); - virtual void NyxParticlesAddProcsToComp(amrex::Amr *aptr, int nSidecarProcs, int prevSidecarProcs, - int ioProcNumSCS, int ioProcNumAll, int scsMyId, - MPI_Comm scsComm); static void InitErrorList(); static void InitDeriveList(); @@ -562,6 +560,15 @@ public: static void alloc_simd_vec(); static void dealloc_simd_vec(); + //! Get the level directory names + void LevelDirectoryNames (const std::string &dir, + const std::string &secondDir, // ---- probably DM or AGN + std::string &LevelDir, + std::string &FullPath); + //! Create the Level_ and other directories in checkpoint and plot files + virtual void CreateLevelDirectory (const std::string &dir); + + protected: // @@ -573,6 +580,11 @@ protected: Nyx& get_level(int lev); + std::string retrieveDM(); +#ifdef AGN + std::string retrieveAGN(); +#endif + #ifndef NO_HYDRO amrex::FluxRegister& get_flux_reg(); amrex::FluxRegister& get_flux_reg(int lev); diff --git a/Source/Nyx.cpp b/Source/Nyx.cpp index 36205002..ce0d60ba 100644 --- a/Source/Nyx.cpp +++ b/Source/Nyx.cpp @@ -15,7 +15,6 @@ using std::string; #include #include -#include #include #include #include @@ -206,9 +205,6 @@ Real Nyx::startCPUTime = 0.0; int reeber_int(0); int gimlet_int(0); -int Nyx::forceParticleRedist = false; -int Nyx::nSidecarProcs(0); - // Note: Nyx::variableSetUp is in Nyx_setup.cpp void Nyx::variable_cleanup () @@ -1501,8 +1497,9 @@ Nyx::post_restart () { // Do multilevel solve here. We now store phi in the checkpoint file so we can use it // at restart. + int ngrow_for_solve = 1; int use_previous_phi_as_guess = 1; - gravity->multilevel_solve_for_phi(0,parent->finestLevel(),use_previous_phi_as_guess); + gravity->multilevel_solve_for_new_phi(0,parent->finestLevel(),ngrow_for_solve,use_previous_phi_as_guess); #ifndef AGN if (do_dm_particles) @@ -1581,7 +1578,6 @@ Nyx::postCoarseTimeStep (Real cumtime) AmrLevel::postCoarseTimeStep(cumtime); const Real cur_time = state[State_Type].curTime(); - const int whichSidecar(0); #ifdef AGN halo_find(parent->dtLevel(level)); @@ -1602,6 +1598,8 @@ Nyx::postCoarseTimeStep (Real cumtime) if (slice_int > -1 && nstep%slice_int == 0) { BL_PROFILE("Nyx::postCoarseTimeStep: get_all_slice_data"); + + if(slice_int != 2) { const Real* dx = geom.CellSize(); MultiFab& S_new = get_new_data(State_Type); @@ -1611,8 +1609,9 @@ Nyx::postCoarseTimeStep (Real cumtime) Real y_coord = (geom.ProbLo()[1] + geom.ProbHi()[1]) / 2 + dx[1]/2; Real z_coord = (geom.ProbLo()[2] + geom.ProbHi()[2]) / 2 + dx[2]/2; - if (ParallelDescriptor::IOProcessor()) + if (ParallelDescriptor::IOProcessor()) { std::cout << "Outputting slices at x = " << x_coord << "; y = " << y_coord << "; z = " << z_coord << std::endl; + } const std::string& slicefilename = amrex::Concatenate(slice_file, nstep); UtilCreateCleanDirectory(slicefilename, true); @@ -1621,9 +1620,9 @@ Nyx::postCoarseTimeStep (Real cumtime) amrex::VisMF::SetNOutFiles(slice_nfiles); // Slice state data - std::unique_ptr x_slice = slice_util::getSliceData(0, S_new,0,S_new.nComp()-2, geom, x_coord); - std::unique_ptr y_slice = slice_util::getSliceData(1, S_new,0,S_new.nComp()-2, geom, y_coord); - std::unique_ptr z_slice = slice_util::getSliceData(2, S_new,0,S_new.nComp()-2, geom, z_coord); + std::unique_ptr x_slice = amrex::get_slice_data(0, x_coord, S_new, geom, 0, S_new.nComp()-2); + std::unique_ptr y_slice = amrex::get_slice_data(1, y_coord, S_new, geom, 0, S_new.nComp()-2); + std::unique_ptr z_slice = amrex::get_slice_data(2, z_coord, S_new, geom, 0, S_new.nComp()-2); std::string xs = slicefilename + "/State_x"; std::string ys = slicefilename + "/State_y"; @@ -1641,31 +1640,11 @@ Nyx::postCoarseTimeStep (Real cumtime) BL_PROFILE("Nyx::postCoarseTimeStep: writeZSlice"); amrex::VisMF::Write(*z_slice, zs); } - { - BL_PROFILE("Nyx::postCoarseTimeStep: writeZSliceFAB"); - int ZDIR(2); - int middle(geom.Domain().smallEnd(ZDIR) + (geom.Domain().length(ZDIR) / 2)); - Box bZFAB(geom.Domain()); - bZFAB.setSmall(ZDIR, middle); - bZFAB.setBig(ZDIR, middle); - BoxArray baZFAB(bZFAB); - amrex::Vector pmapZFAB(1, ParallelDescriptor::IOProcessorNumber()); // ---- one fab on the ioproc - DistributionMapping dmZFAB(pmapZFAB); - MultiFab mfZFAB(baZFAB, dmZFAB, z_slice->nComp(), z_slice->nGrow()); - mfZFAB.copy(*z_slice); - if(ParallelDescriptor::IOProcessor()) { - std::string zsFAB = zs + "_FAB.fab"; - std::ofstream osZFAB(zsFAB); - const FArrayBox &fZFAB = mfZFAB[0]; - fZFAB.writeOn(osZFAB); - osZFAB.close(); - } - } // Slice diag_eos - x_slice = slice_util::getSliceData(0, D_new,0,D_new.nComp(), geom, x_coord); - y_slice = slice_util::getSliceData(1, D_new,0,D_new.nComp(), geom, y_coord); - z_slice = slice_util::getSliceData(2, D_new,0,D_new.nComp(), geom, z_coord); + x_slice = amrex::get_slice_data(0, x_coord, D_new, geom, 0, D_new.nComp()); + y_slice = amrex::get_slice_data(1, y_coord, D_new, geom, 0, D_new.nComp()); + z_slice = amrex::get_slice_data(2, z_coord, D_new, geom, 0, D_new.nComp()); xs = slicefilename + "/Diag_x"; ys = slicefilename + "/Diag_y"; @@ -1683,6 +1662,56 @@ Nyx::postCoarseTimeStep (Real cumtime) if (ParallelDescriptor::IOProcessor()) { std::cout << "Done with slices." << std::endl; } + + + } else { + + MultiFab& S_new = get_new_data(State_Type); + MultiFab& D_new = get_new_data(DiagEOS_Type); + + const std::string& slicefilename = amrex::Concatenate(slice_file, nstep); + UtilCreateCleanDirectory(slicefilename, true); + + int nfiles_current = amrex::VisMF::GetNOutFiles(); + amrex::VisMF::SetNOutFiles(slice_nfiles); + + int maxBoxSize(64); + amrex::Vector SMFNames(3); + SMFNames[0] = slicefilename + "/State_x"; + SMFNames[1] = slicefilename + "/State_y"; + SMFNames[2] = slicefilename + "/State_z"; + amrex::Vector DMFNames(3); + DMFNames[0] = slicefilename + "/Diag_x"; + DMFNames[1] = slicefilename + "/Diag_y"; + DMFNames[2] = slicefilename + "/Diag_z"; + + for(int dir(0); dir < 3; ++dir) { + Box sliceBox(geom.Domain()); + int dir_coord = geom.ProbLo()[dir] + (geom.Domain().length(dir) / 2); + amrex::Print() << "Outputting slices at dir_coord[" << dir << "] = " << dir_coord << '\n'; + sliceBox.setSmall(dir, dir_coord); + sliceBox.setBig(dir, dir_coord); + BoxArray sliceBA(sliceBox); + sliceBA.maxSize(maxBoxSize); + DistributionMapping sliceDM(sliceBA); + + MultiFab SSliceMF(sliceBA, sliceDM, S_new.nComp()-2, 0); + SSliceMF.copy(S_new, 0, 0, SSliceMF.nComp()); + amrex::VisMF::Write(SSliceMF, SMFNames[dir]); + + MultiFab DSliceMF(sliceBA, sliceDM, D_new.nComp(), 0); + DSliceMF.copy(D_new, 0, 0, DSliceMF.nComp()); + amrex::VisMF::Write(DSliceMF, DMFNames[dir]); + } + + amrex::VisMF::SetNOutFiles(nfiles_current); + + if (ParallelDescriptor::IOProcessor()) { + std::cout << "Done with slices." << std::endl; + } + + } + } } @@ -1698,7 +1727,7 @@ Nyx::post_regrid (int lbase, #endif if (level == lbase) { - particle_redistribute(lbase, forceParticleRedist); + particle_redistribute(lbase, false); } int which_level_being_advanced = parent->level_being_advanced(); @@ -1723,8 +1752,9 @@ Nyx::post_regrid (int lbase, if (gravity->get_gravity_type() == "PoissonGrav") #endif { + int ngrow_for_solve = 1; int use_previous_phi_as_guess = 1; - gravity->multilevel_solve_for_phi(level, new_finest, use_previous_phi_as_guess); + gravity->multilevel_solve_for_new_phi(level, new_finest, ngrow_for_solve, use_previous_phi_as_guess); } } #endif @@ -1774,7 +1804,8 @@ Nyx::post_init (Real stop_time) // // Solve on full multilevel hierarchy // - gravity->multilevel_solve_for_phi(0, finest_level); + int ngrow_for_solve = 1; + gravity->multilevel_solve_for_new_phi(0, finest_level, ngrow_for_solve); } // Make this call just to fill the initial state data. @@ -2321,6 +2352,44 @@ Nyx::compute_rho_temp (Real& rho_T_avg, Real& T_avg, Real& Tinv_avg, Real& T_mea } #endif +#ifndef NO_HYDRO +void +Nyx::compute_gas_fractions (Real T_cut, Real rho_cut, + Real& whim_mass_frac, Real& whim_vol_frac, + Real& hh_mass_frac, Real& hh_vol_frac, + Real& igm_mass_frac, Real& igm_vol_frac) +{ + BL_PROFILE("Nyx::compute_gas_fractions()"); + MultiFab& S_new = get_new_data(State_Type); + MultiFab& D_new = get_new_data(DiagEOS_Type); + + Real whim_mass=0.0, whim_vol=0.0, hh_mass=0.0, hh_vol=0.0, igm_mass=0.0, igm_vol=0.0; + Real mass_sum=0.0, vol_sum=0.0; + +#ifdef _OPENMP +#pragma omp parallel reduction(+:whim_mass, whim_vol, hh_mass, hh_vol, igm_mass, igm_vol, mass_sum, vol_sum) +#endif + for (MFIter mfi(S_new,true); mfi.isValid(); ++mfi) + { + const Box& bx = mfi.tilebox(); + + fort_compute_gas_frac + (bx.loVect(), bx.hiVect(), geom.CellSize(), + BL_TO_FORTRAN(S_new[mfi]), + BL_TO_FORTRAN(D_new[mfi]), &average_gas_density, &T_cut, &rho_cut, + &whim_mass, &whim_vol, &hh_mass, &hh_vol, &igm_mass, &igm_vol, &mass_sum, &vol_sum); + } + Real sums[8] = {whim_mass, whim_vol, hh_mass, hh_vol, igm_mass, igm_vol, mass_sum, vol_sum}; + ParallelDescriptor::ReduceRealSum(sums,8); + + whim_mass_frac = sums[0] / sums[6]; + whim_vol_frac = sums[1] / sums[7]; + hh_mass_frac = sums[2] / sums[6]; + hh_vol_frac = sums[3] / sums[7]; + igm_mass_frac = sums[4] / sums[6]; + igm_vol_frac = sums[5] / sums[7]; +} +#endif Real Nyx::getCPUTime() @@ -2338,384 +2407,90 @@ Nyx::getCPUTime() } void -Nyx::AddProcsToComp(Amr *aptr, int nSidecarProcs, int prevSidecarProcs, - int ioProcNumSCS, int ioProcNumAll, int scsMyId, - MPI_Comm scsComm) -{ - BL_PROFILE("Nyx::AddProcsToComp()"); +Nyx::InitErrorList() { + //err_list.clear(true); + //err_list.add("FULLSTATE",1,ErrorRec::Special,FORT_DENERROR); +} - forceParticleRedist = true; - AmrLevel::AddProcsToComp(aptr, nSidecarProcs, prevSidecarProcs, - ioProcNumSCS, ioProcNumAll, scsMyId, - scsComm); +//static Box the_same_box (const Box& b) { return b; } +void +Nyx::InitDeriveList() { +} - // ---- pack up the bools - Vector allBools; // ---- just use ints here - if(scsMyId == ioProcNumSCS) { - allBools.push_back(dump_old); - allBools.push_back(do_dm_particles); - allBools.push_back(particle_initrandom_serialize); - allBools.push_back(FillPatchedOldState_ok); - } - amrex::BroadcastArray(allBools, scsMyId, ioProcNumAll, scsComm); +void +Nyx::LevelDirectoryNames(const std::string &dir, + const std::string &secondDir, + std::string &LevelDir, + std::string &FullPath) +{ + LevelDir = amrex::Concatenate("Level_", level, 1); + // + // Now for the full pathname of that directory. + // + FullPath = dir; + if( ! FullPath.empty() && FullPath.back() != '/') { + FullPath += '/'; + } + FullPath += secondDir; + FullPath += "/"; + FullPath += LevelDir; +} - // ---- unpack the bools - if(scsMyId != ioProcNumSCS) { - int count(0); - dump_old = allBools[count++]; - do_dm_particles = allBools[count++]; - particle_initrandom_serialize = allBools[count++]; - FillPatchedOldState_ok = allBools[count++]; - BL_ASSERT(count == allBools.size()); - } +void +Nyx::CreateLevelDirectory (const std::string &dir) +{ + AmrLevel::CreateLevelDirectory(dir); // ---- this sets levelDirectoryCreated = true - // ---- pack up the ints - Vector allInts; - - if(scsMyId == ioProcNumSCS) { - allInts.push_back(write_parameters_in_plotfile); - allInts.push_back(print_fortran_warnings); - allInts.push_back(particle_verbose); - allInts.push_back(write_particle_density_at_init); - allInts.push_back(write_coarsened_particles); - allInts.push_back(NUM_STATE); - allInts.push_back(Density); - allInts.push_back(Xmom); - allInts.push_back(Ymom); - allInts.push_back(Zmom); - allInts.push_back(Eden); - allInts.push_back(Eint); - allInts.push_back(Temp_comp); - allInts.push_back(Ne_comp); - allInts.push_back(Zhi_comp); - allInts.push_back(FirstSpec); - allInts.push_back(FirstAux); - allInts.push_back(FirstAdv); - allInts.push_back(NumSpec); - allInts.push_back(NumAux); - allInts.push_back(NumAdv); - allInts.push_back(strict_subcycling); - allInts.push_back(init_with_sph_particles); - allInts.push_back(verbose); - allInts.push_back(do_reflux); - allInts.push_back(NUM_GROW); - allInts.push_back(nsteps_from_plotfile); - allInts.push_back(allow_untagging); - allInts.push_back(use_const_species); - allInts.push_back(normalize_species); - allInts.push_back(do_special_tagging); - allInts.push_back(ppm_type); - allInts.push_back(ppm_reference); - allInts.push_back(ppm_flatten_before_integrals); - allInts.push_back(use_colglaz); - allInts.push_back(use_flattening); - allInts.push_back(corner_coupling); - allInts.push_back(version_2); - allInts.push_back(use_exact_gravity); - allInts.push_back(particle_initrandom_iseed); - allInts.push_back(do_hydro); - allInts.push_back(do_grav); - allInts.push_back(add_ext_src); - allInts.push_back(heat_cool_type); - allInts.push_back(inhomo_reion); - allInts.push_back(strang_split); - allInts.push_back(reeber_int); - allInts.push_back(gimlet_int); - allInts.push_back(forceParticleRedist); + std::string dm(dir + "/" + Nyx::retrieveDM()); + if(ParallelDescriptor::IOProcessor()) { + amrex::Print() << "IOIOIOIO:CD Nyx::CreateLevelDirectory:0: DM_dir = " << dm << "\n"; + if( ! amrex::UtilCreateDirectory(dm, 0755)) { + amrex::CreateDirectoryFailed(dm); } + } - amrex::BroadcastArray(allInts, scsMyId, ioProcNumAll, scsComm); - - // ---- unpack the ints - if(scsMyId != ioProcNumSCS) { - int count(0); - - write_parameters_in_plotfile = allInts[count++]; - print_fortran_warnings = allInts[count++]; - particle_verbose = allInts[count++]; - write_particle_density_at_init = allInts[count++]; - write_coarsened_particles = allInts[count++]; - NUM_STATE = allInts[count++]; - Density = allInts[count++]; - Xmom = allInts[count++]; - Ymom = allInts[count++]; - Zmom = allInts[count++]; - Eden = allInts[count++]; - Eint = allInts[count++]; - Temp_comp = allInts[count++]; - Ne_comp = allInts[count++]; - Zhi_comp = allInts[count++]; - FirstSpec = allInts[count++]; - FirstAux = allInts[count++]; - FirstAdv = allInts[count++]; - NumSpec = allInts[count++]; - NumAux = allInts[count++]; - NumAdv = allInts[count++]; - strict_subcycling = allInts[count++]; - init_with_sph_particles = allInts[count++]; - verbose = allInts[count++]; - do_reflux = allInts[count++]; - NUM_GROW = allInts[count++]; - nsteps_from_plotfile = allInts[count++]; - allow_untagging = allInts[count++]; - use_const_species = allInts[count++]; - normalize_species = allInts[count++]; - do_special_tagging = allInts[count++]; - ppm_type = allInts[count++]; - ppm_reference = allInts[count++]; - ppm_flatten_before_integrals = allInts[count++]; - use_colglaz = allInts[count++]; - use_flattening = allInts[count++]; - corner_coupling = allInts[count++]; - version_2 = allInts[count++]; - use_exact_gravity = allInts[count++]; - particle_initrandom_iseed = allInts[count++]; - do_hydro = allInts[count++]; - do_grav = allInts[count++]; - add_ext_src = allInts[count++]; - heat_cool_type = allInts[count++]; - inhomo_reion = allInts[count++]; - strang_split = allInts[count++]; - reeber_int = allInts[count++]; - gimlet_int = allInts[count++]; - forceParticleRedist = allInts[count++]; - - BL_ASSERT(count == allInts.size()); - } - - - // ---- longs - ParallelDescriptor::Bcast(&particle_initrandom_count, 1, ioProcNumAll, scsComm); - - - // ---- pack up the Reals - Vector allReals; - if(scsMyId == ioProcNumSCS) { - allReals.push_back(initial_z); - allReals.push_back(final_a); - allReals.push_back(final_z); - allReals.push_back(relative_max_change_a); - allReals.push_back(old_a_time); - allReals.push_back(new_a_time); - allReals.push_back(old_a); - allReals.push_back(new_a); - allReals.push_back(particle_cfl); - allReals.push_back(cfl); - allReals.push_back(init_shrink); - allReals.push_back(change_max); - allReals.push_back(small_dens); - allReals.push_back(small_temp); - allReals.push_back(gamma); - allReals.push_back( h_species); - allReals.push_back(he_species); - allReals.push_back(particle_initrandom_mass); - allReals.push_back(average_gas_density); - allReals.push_back(average_dm_density); - allReals.push_back(average_neutr_density); - allReals.push_back(average_total_density); - allReals.push_back(comoving_OmB); - allReals.push_back(comoving_OmM); - allReals.push_back(comoving_h); -#ifdef NEUTRINO_PARTICLES - allReals.push_back(neutrino_cfl); -#endif -#ifdef AGN - allReals.push_back(mass_halo_min); - allReals.push_back(mass_seed); -#endif + std::string LevelDir, FullPath; + LevelDirectoryNames(dir, Nyx::retrieveDM(), LevelDir, FullPath); + if(ParallelDescriptor::IOProcessor()) { + amrex::Print() << "IOIOIOIO:CD Nyx::CreateLevelDirectory:1: DM_dir = " << FullPath << "\n"; + if( ! amrex::UtilCreateDirectory(FullPath, 0755)) { + amrex::CreateDirectoryFailed(FullPath); } + } - amrex::BroadcastArray(allReals, scsMyId, ioProcNumAll, scsComm); - amrex::BroadcastArray(plot_z_values, scsMyId, ioProcNumAll, scsComm); - amrex::BroadcastArray(analysis_z_values, scsMyId, ioProcNumAll, scsComm); - - // ---- unpack the Reals - if(scsMyId != ioProcNumSCS) { - int count(0); - initial_z = allReals[count++]; - final_a = allReals[count++]; - final_z = allReals[count++]; - relative_max_change_a = allReals[count++]; - old_a_time = allReals[count++]; - new_a_time = allReals[count++]; - old_a = allReals[count++]; - new_a = allReals[count++]; - particle_cfl = allReals[count++]; - cfl = allReals[count++]; - init_shrink = allReals[count++]; - change_max = allReals[count++]; - small_dens = allReals[count++]; - small_temp = allReals[count++]; - gamma = allReals[count++]; - h_species = allReals[count++]; - he_species = allReals[count++]; - particle_initrandom_mass = allReals[count++]; - average_gas_density = allReals[count++]; - average_dm_density = allReals[count++]; - average_neutr_density = allReals[count++]; - average_total_density = allReals[count++]; - comoving_OmB = allReals[count++]; - comoving_OmM = allReals[count++]; - comoving_h = allReals[count++]; -#ifdef NEUTRINO_PARTICLES - neutrino_cfl = allReals[count++]; -#endif #ifdef AGN - mass_halo_min = allReals[count++]; - mass_seed = allReals[count++]; -#endif - BL_ASSERT(count == allReals.size()); - } - - - // ---- pack up the strings - Vector allStrings; - Vector serialStrings; - if(scsMyId == ioProcNumSCS) { - allStrings.push_back(particle_plotfile_format); - allStrings.push_back(particle_init_type); - allStrings.push_back(particle_move_type); - - serialStrings = amrex::SerializeStringArray(allStrings); - } - - amrex::BroadcastArray(serialStrings, scsMyId, ioProcNumAll, scsComm); - - // ---- unpack the strings - if(scsMyId != ioProcNumSCS) { - int count(0); - allStrings = amrex::UnSerializeStringArray(serialStrings); - - particle_plotfile_format = allStrings[count++]; - particle_init_type = allStrings[count++]; - particle_move_type = allStrings[count++]; - } - - - // ---- maps - std::cout << "_in AddProcsToComp: fix maps." << std::endl; - //std::map auxDiag; - //static std::map > auxDiag_names; - - - // ---- pack up the IntVects - Vector allIntVects; - if(scsMyId == ioProcNumSCS) { - for(int i(0); i < BL_SPACEDIM; ++i) { allIntVects.push_back(Nrep[i]); } - - BL_ASSERT(allIntVects.size() == BL_SPACEDIM); - } - - amrex::BroadcastArray(allIntVects, scsMyId, ioProcNumAll, scsComm); - - // ---- unpack the IntVects - if(scsMyId != ioProcNumSCS) { - int count(0); - - BL_ASSERT(allIntVects.size() == BL_SPACEDIM); - for(int i(0); i < BL_SPACEDIM; ++i) { Nrep[i] = allIntVects[count++]; } - - BL_ASSERT(allIntVects.size() == BL_SPACEDIM); - } - - - - // ---- BCRec - Vector bcrLo(BL_SPACEDIM), bcrHi(BL_SPACEDIM); - if(scsMyId == ioProcNumSCS) { - for(int i(0); i < bcrLo.size(); ++i) { bcrLo[i] = phys_bc.lo(i); } - for(int i(0); i < bcrHi.size(); ++i) { bcrHi[i] = phys_bc.hi(i); } - } - ParallelDescriptor::Bcast(bcrLo.dataPtr(), bcrLo.size(), ioProcNumSCS, scsComm); - ParallelDescriptor::Bcast(bcrHi.dataPtr(), bcrHi.size(), ioProcNumSCS, scsComm); - if(scsMyId != ioProcNumSCS) { - for(int i(0); i < bcrLo.size(); ++i) { phys_bc.setLo(i, bcrLo[i]); } - for(int i(0); i < bcrHi.size(); ++i) { phys_bc.setHi(i, bcrHi[i]); } - } - - - - - // ---- ErrorList - if(scsMyId != ioProcNumSCS) { - InitErrorList(); + std::string agn(dir + "/" + Nyx::retrieveAGN()); + if(ParallelDescriptor::IOProcessor()) { + amrex::Print() << "IOIOIOIO:CD Nyx::CreateLevelDirectory:0: AGN_dir = " << agn << "\n"; + if( ! amrex::UtilCreateDirectory(agn, 0755)) { + amrex::CreateDirectoryFailed(agn); } + } - // ---- DeriveList - if(scsMyId != ioProcNumSCS) { - InitDeriveList(); - } - - int isAllocated(0); -#ifndef NO_HYDRO - // ---- FluxRegister - if(scsMyId == ioProcNumSCS) { - if(flux_reg == 0) { - isAllocated = 0; - } else { - isAllocated = 1; - } - } - ParallelDescriptor::Bcast(&isAllocated, 1, ioProcNumSCS, scsComm); - if(isAllocated == 1) { - if(scsMyId != ioProcNumSCS) { - BL_ASSERT(flux_reg == 0); - flux_reg = new FluxRegister; - } - flux_reg->AddProcsToComp(ioProcNumSCS, ioProcNumAll, scsMyId, scsComm); + LevelDirectoryNames(dir, Nyx::retrieveAGN(), LevelDir, FullPath); + if(ParallelDescriptor::IOProcessor()) { + amrex::Print() << "IOIOIOIO:CD Nyx::CreateLevelDirectory:1: AGN_dir = " << FullPath << "\n"; + if( ! amrex::UtilCreateDirectory(FullPath, 0755)) { + amrex::CreateDirectoryFailed(FullPath); } + } #endif - - // ---- fine_mask - isAllocated = 0; - if(scsMyId == ioProcNumSCS) { - if(fine_mask == 0) { - isAllocated = 0; - } else { - isAllocated = 1; - } + if(parent->UsingPrecreateDirectories()) { + if(Nyx::theDMPC()) { + Nyx::theDMPC()->SetLevelDirectoriesCreated(true); } - ParallelDescriptor::Bcast(&isAllocated, 1, ioProcNumSCS, scsComm); - if(isAllocated == 1) { - if(scsMyId != ioProcNumSCS) { - BL_ASSERT(fine_mask == 0); - std::cout << "**** check fine_mask." << std::endl; - fine_mask = build_fine_mask(); - } - fine_mask->AddProcsToComp(ioProcNumSCS, ioProcNumAll, scsMyId, scsComm); +#ifdef AGN + if(Nyx::theAPC()) { + Nyx::theAPC()->SetLevelDirectoriesCreated(true); } - - -#ifdef GRAVITY - // ---- gravity - if(do_grav) { - if(gravity != 0) { - gravity->AddProcsToComp(parent, level, this, ioProcNumSCS, ioProcNumAll, scsMyId, scsComm); - } - } #endif - - - NyxParticlesAddProcsToComp(parent, nSidecarProcs, prevSidecarProcs, ioProcNumSCS, - ioProcNumAll, scsMyId, scsComm); + } } -void -Nyx::InitErrorList() { - //err_list.clear(true); - //err_list.add("FULLSTATE",1,ErrorRec::Special,FORT_DENERROR); -} - - -//static Box the_same_box (const Box& b) { return b; } - -void -Nyx::InitDeriveList() { -} diff --git a/Source/NyxBld.cpp b/Source/NyxBld.cpp index a36efbe5..acae9c44 100644 --- a/Source/NyxBld.cpp +++ b/Source/NyxBld.cpp @@ -9,12 +9,10 @@ class NyxBld public LevelBld { virtual void variable_setup(); - virtual void variable_setup_for_new_comp_procs(); virtual void variable_cleanup(); - // hack copies for BoxLib overriding + // hack copies for amrex overriding virtual void variableSetUp(); - virtual void variableSetUpForNewCompProcs(); virtual void variableCleanUp(); virtual AmrLevel *operator() (); @@ -39,12 +37,6 @@ NyxBld::variable_setup() Nyx::variable_setup(); } -void -NyxBld::variable_setup_for_new_comp_procs() -{ - Nyx::variable_setup_for_new_comp_procs(); -} - void NyxBld::variable_cleanup() { @@ -75,10 +67,6 @@ void NyxBld::variableSetUp() { Nyx::variable_setup(); } -void NyxBld::variableSetUpForNewCompProcs() -{ - Nyx::variable_setup_for_new_comp_procs(); -} void NyxBld::variableCleanUp() { Nyx::variable_cleanup(); diff --git a/Source/NyxParticleContainer.H b/Source/NyxParticleContainer.H index 02480edc..c5977e4e 100644 --- a/Source/NyxParticleContainer.H +++ b/Source/NyxParticleContainer.H @@ -4,7 +4,7 @@ #include "AMReX_Amr.H" #include "AMReX_AmrLevel.H" -#include "AMReX_AmrParticles.H" +#include "AMReX_NeighborParticles.H" class NyxParticleContainerBase { @@ -28,44 +28,45 @@ public: virtual void AssignDensitySingleLevel (amrex::MultiFab& mf, int level, int ncomp=1, int particle_lvl_offset = 0) const = 0; virtual void AssignDensity (amrex::Vector >& mf, int lev_min = 0, int ncomp = 1, - int finest_level = -1) const = 0; + int finest_level = -1, int ngrow = 1) const = 0; }; template class NyxParticleContainer - : public amrex::AmrParticleContainer, + : public amrex::NeighborParticleContainer, public NyxParticleContainerBase { public: using ParticleTileType = amrex::ParticleTile; - NyxParticleContainer (amrex::Amr* amr) - : amrex::AmrParticleContainer(amr), + NyxParticleContainer (amrex::Amr* amr, int nghost=0) + : amrex::NeighborParticleContainer((amrex::ParGDBBase*) amr->GetParGDB(), nghost), sub_cycle(amr->subCycle()) {} - + virtual ~NyxParticleContainer () {} - + void GetParticleVelocities (amrex::Vector& part_vels); void SetParticleVelocities (amrex::Vector& part_data); - + virtual amrex::Real sumParticleMass (int level) const override { - return amrex::AmrParticleContainer::sumParticleMass(0,level); + return amrex::NeighborParticleContainer::sumParticleMass(0,level); } - + void sumParticleMomentum (int lev, amrex::Real* mom) const; virtual void AssignDensitySingleLevel (amrex::MultiFab& mf, int level, int ncomp=1, int particle_lvl_offset = 0) const override { - amrex::AmrParticleContainer::AssignCellDensitySingleLevelFort(0, mf, level, ncomp, particle_lvl_offset); + amrex::NeighborParticleContainer::AssignCellDensitySingleLevelFort(0, mf, level, ncomp, particle_lvl_offset); } - virtual void AssignDensity (amrex::Vector >& mf, int lev_min = 0, int ncomp = 1, int finest_level = -1) const override + virtual void AssignDensity (amrex::Vector >& mf, int lev_min = 0, int ncomp = 1, int finest_level = -1, + int ngrow = 1) const override { if (finestLevel() == 0) { - amrex::AmrParticleContainer::AssignDensityFort(0, mf, lev_min, ncomp, finest_level); + amrex::NeighborParticleContainer::AssignDensityFort(0, mf, lev_min, ncomp, finest_level); } else { - amrex::AmrParticleContainer::AssignDensity(0, sub_cycle, mf, lev_min, ncomp, finest_level); + amrex::NeighborParticleContainer::AssignDensity(0, sub_cycle, mf, lev_min, ncomp, finest_level, ngrow); } } @@ -76,26 +77,26 @@ public: virtual int finestLevel() const override { - return amrex::AmrParticleContainer::finestLevel(); + return amrex::NeighborParticleContainer::finestLevel(); } virtual void Redistribute (int lev_min = 0, int lev_max =-1, int nGrow = 0) override { - amrex::AmrParticleContainer::Redistribute(lev_min, lev_max, nGrow); + amrex::NeighborParticleContainer::Redistribute(lev_min, lev_max, nGrow); } virtual void RemoveParticlesAtLevel (int level) override { - amrex::AmrParticleContainer::RemoveParticlesAtLevel(level); + amrex::NeighborParticleContainer::RemoveParticlesAtLevel(level); } - virtual void WriteNyxPlotFile (const std::string& dir, - const std::string& name) const; - - virtual void NyxCheckpoint (const std::string& dir, - const std::string& name) const; + virtual void WriteNyxPlotFile (const std::string& dir, + const std::string& name) const; + + virtual void NyxCheckpoint (const std::string& dir, + const std::string& name) const; typedef amrex::Particle ParticleType; using AoS = typename amrex::ParticleContainer::AoS; @@ -184,7 +185,6 @@ NyxParticleContainer::SetParticleVelocities (amrex::Vector::sumParticleMomentum (int lev, amrex::ParallelDescriptor::ReduceRealSum(mom,BL_SPACEDIM); } - template amrex::Real NyxParticleContainer::estTimestep (amrex::MultiFab& acceleration, @@ -364,7 +363,6 @@ NyxParticleContainer::estTimestep (amrex::MultiFab& accel return dt; } - template void NyxParticleContainer::MultiplyParticleMass (int lev, amrex::Real mult) @@ -403,10 +401,9 @@ NyxParticleContainer::WriteNyxPlotFile (const std::string& dir, { BL_PROFILE("NyxParticleContainer::WriteNyxPlotFile()"); - amrex::AmrParticleContainer::WritePlotFile(dir, name, real_comp_names); + amrex::NeighborParticleContainer::WritePlotFile(dir, name, real_comp_names); } - template void NyxParticleContainer::NyxCheckpoint (const std::string& dir, @@ -415,7 +412,7 @@ NyxParticleContainer::NyxCheckpoint (const std::string& dir, BL_PROFILE("NyxParticleContainer::NyxCheckpoint()"); bool is_checkpoint = true; - amrex::AmrParticleContainer::Checkpoint(dir, name, is_checkpoint, real_comp_names); + amrex::NeighborParticleContainer::Checkpoint(dir, name, is_checkpoint, real_comp_names); } #endif /*_NyxParticleContainer_H_*/ diff --git a/Source/NyxParticles.cpp b/Source/NyxParticles.cpp index cdec6c8c..f658391d 100644 --- a/Source/NyxParticles.cpp +++ b/Source/NyxParticles.cpp @@ -1094,13 +1094,4 @@ Nyx::remove_ghost_particles() } } - - -void -Nyx::NyxParticlesAddProcsToComp(Amr *aptr, int nSidecarProcs, int prevSidecarProcs, - int ioProcNumSCS, int ioProcNumAll, int scsMyId, - MPI_Comm scsCommn) -{ -} - //NyxParticleContainerBase::~NyxParticleContainerBase() {} diff --git a/Source/Nyx_F.H b/Source/Nyx_F.H index 90285cc9..730eb794 100644 --- a/Source/Nyx_F.H +++ b/Source/Nyx_F.H @@ -33,10 +33,6 @@ extern "C" const int lo[], const int hi[], const amrex::Real dx[], amrex::Real* dt, amrex::Real* comoving_a); - void fill_slice(const amrex::Real* fdata, const int* flo, const int* fhi, int* fstart, int* nfull, - amrex::Real* sdata, const int* slo, const int* shi, - const int* tlo, const int* thi, int* ncomp); - void fort_estdt_comoving_a (amrex::Real* old_a, amrex::Real* new_dummy_a, amrex::Real* dt, amrex::Real* change_allowed, amrex::Real* final_a, int* dt_modified); @@ -293,6 +289,16 @@ extern "C" amrex::Real* Tinv_sum, amrex::Real* T_meanrho_sum, amrex::Real* rho_sum, amrex::Real* vol_sum, amrex::Real* vol_mn_sum); + void fort_compute_gas_frac + (const int lo[], const int hi[], const amrex::Real dx[], + const BL_FORT_FAB_ARG(state), + const BL_FORT_FAB_ARG(diag_eos), + amrex::Real* rho_ave, amrex::Real* T_cut, amrex::Real* rho_cut, + amrex::Real* whim_mass, amrex::Real* whim_vol, + amrex::Real* hh_mass, amrex::Real* hh_vol, + amrex::Real* igm_mass, amrex::Real* igm_vol, + amrex::Real* mass_sum, amrex::Real* vol_sum); + #ifdef AUX_UPDATE void auxupdate (BL_FORT_FAB_ARG(state_old), diff --git a/Source/Nyx_advance.cpp b/Source/Nyx_advance.cpp index 4a3dd373..3a83c768 100644 --- a/Source/Nyx_advance.cpp +++ b/Source/Nyx_advance.cpp @@ -232,7 +232,9 @@ Nyx::advance_hydro_plus_particles (Real time, // Solve for phi using the previous phi as a guess. // int use_previous_phi_as_guess = 1; + int ngrow_for_solve = iteration + stencil_deposition_width; gravity->multilevel_solve_for_old_phi(level, finest_level, + ngrow_for_solve, use_previous_phi_as_guess); } BL_PROFILE_VAR_STOP(solve_for_old_phi); @@ -321,7 +323,10 @@ Nyx::advance_hydro_plus_particles (Real time, int use_previous_phi_as_guess = 1; if (finest_level_to_advance > level) { + // The particle may be as many as "iteration" ghost cells out + int ngrow_for_solve = iteration + stencil_deposition_width; gravity->multilevel_solve_for_new_phi(level, finest_level_to_advance, + ngrow_for_solve, use_previous_phi_as_guess); } else diff --git a/Source/Nyx_halos.cpp b/Source/Nyx_halos.cpp index 3da9e862..8cc37438 100644 --- a/Source/Nyx_halos.cpp +++ b/Source/Nyx_halos.cpp @@ -74,8 +74,6 @@ Nyx::halo_find (Real dt) { BL_PROFILE("Nyx::halo_find()"); - const int whichSidecar(0); - const Real * dx = geom.CellSize(); amrex::MultiFab& new_state = get_new_data(State_Type); @@ -108,7 +106,6 @@ Nyx::halo_find (Real dt) // Before creating new AGN particles, accrete mass onto existing particles halo_accrete(dt); - if (ParallelDescriptor::NProcsSidecar(0) <= 0) { // we have no sidecars, so do everything in situ BoxArray reeberBA; @@ -317,57 +314,7 @@ Nyx::halo_find (Real dt) #ifdef REEBER } -#if 0 - else { // we have sidecars, so do everything in-transit - - int sidecarSignal(NyxHaloFinderSignal); - const int MPI_IntraGroup_Broadcast_Rank = ParallelDescriptor::IOProcessor() ? MPI_ROOT : MPI_PROC_NULL; - ParallelDescriptor::Bcast(&sidecarSignal, 1, MPI_IntraGroup_Broadcast_Rank, - ParallelDescriptor::CommunicatorInter(whichSidecar)); - - Geometry geom(Geom()); - Geometry::SendGeometryToSidecar(&geom, whichSidecar); - - // FIXME: What is distribution mapping? - amrex::MultiFab reeberMF(grids, reeber_density_var_list.size(), 0); - int cnt = 0; - // Derive quantities and store in components 1... of MultiFAB - for (auto it = reeber_density_var_list.begin(); it != reeber_density_var_list.end(); ++it) - { - std::unique_ptr derive_dat = particle_derive(*it, cur_time, 0); - reeberMF.copy(*derive_dat, comp0, cnt, ncomp1, nghost0, nghost0); - cnt++; - } - - int time_step(nStep()), nComp(reeberMF.nComp()); - - ParallelDescriptor::Bcast(&nComp, 1, MPI_IntraGroup_Broadcast_Rank, - ParallelDescriptor::CommunicatorInter(whichSidecar)); - - amrex::MultiFab *mfSource = &reeberMF; - amrex::MultiFab *mfDest = 0; - int srcComp(0), destComp(1); - int srcNGhost(0), destNGhost(0); - MPI_Comm commSrc(ParallelDescriptor::CommunicatorComp()); - MPI_Comm commDest(ParallelDescriptor::CommunicatorSidecar()); - MPI_Comm commInter(ParallelDescriptor::CommunicatorInter(whichSidecar)); - MPI_Comm commBoth(ParallelDescriptor::CommunicatorBoth(whichSidecar)); - bool isSrc(true); - - amrex::MultiFab::copyInter(mfSource, mfDest, srcComp, destComp, nComp, - srcNGhost, destNGhost, - commSrc, commDest, commInter, commBoth, - isSrc); - - - ParallelDescriptor::Bcast(&time_step, 1, MPI_IntraGroup_Broadcast_Rank, - ParallelDescriptor::CommunicatorInter(whichSidecar)); - - int do_analysis_bcast(do_analysis); - ParallelDescriptor::Bcast(&do_analysis_bcast, 1, MPI_IntraGroup_Broadcast_Rank, - ParallelDescriptor::CommunicatorInter(whichSidecar)); -#endif // if 0 } #endif // ifdef REEBER } diff --git a/Source/Nyx_output.cpp b/Source/Nyx_output.cpp index ff672b67..b5875771 100644 --- a/Source/Nyx_output.cpp +++ b/Source/Nyx_output.cpp @@ -33,6 +33,18 @@ Nyx::thePlotFileType () const return the_plot_file_type; } +std::string +Nyx::retrieveDM () { + return dm_chk_particle_file; +} + +#ifdef AGN +std::string +Nyx::retrieveAGN () { + return agn_chk_particle_file; +} +#endif + void Nyx::setPlotVariables () { @@ -174,8 +186,9 @@ Nyx::writePlotFile (const std::string& dir, // os << thePlotFileType() << '\n'; - if (n_data_items == 0) + if (n_data_items == 0) { amrex::Error("Must specify at least one valid data item to plot"); + } os << n_data_items << '\n'; // @@ -396,19 +409,26 @@ Nyx::writePlotFile (const std::string& dir, // Now for the full pathname of that directory. // std::string FullPath = dir; - if (!FullPath.empty() && FullPath[FullPath.size()-1] != '/') + if ( ! FullPath.empty() && FullPath[FullPath.size()-1] != '/') { FullPath += '/'; + } FullPath += Level; // // Only the I/O processor makes the directory if it doesn't already exist. // - if (ParallelDescriptor::IOProcessor()) - if (!amrex::UtilCreateDirectory(FullPath, 0755)) + if( ! levelDirectoryCreated) { + amrex::Print() << "IOIOIOIO:CD Nyx::writePlotFile: ! ldc: creating directory: " + << FullPath << '\n'; + if (ParallelDescriptor::IOProcessor()) { + if ( ! amrex::UtilCreateDirectory(FullPath, 0755)) { amrex::CreateDirectoryFailed(FullPath); - // - // Force other processors to wait till directory is built. - // - ParallelDescriptor::Barrier(); + } + } + // + // Force other processors to wait until directory is built. + // + ParallelDescriptor::Barrier(); + } if (ParallelDescriptor::IOProcessor()) { @@ -480,10 +500,50 @@ Nyx::writePlotFile (const std::string& dir, particle_plot_file(dir); // Write out all parameters into the plotfile - if (write_parameters_in_plotfile) + if (write_parameters_in_plotfile) { write_parameter_file(dir); + } + + if(Nyx::theDMPC()) { + Nyx::theDMPC()->SetLevelDirectoriesCreated(false); + } +#ifdef AGN + if(Nyx::theAPC()) { + Nyx::theAPC()->SetLevelDirectoriesCreated(false); + } +#endif + +} + +void +Nyx::writePlotFilePre (const std::string& dir, ostream& os) +{ + if(Nyx::theDMPC()) { + Nyx::theDMPC()->WritePlotFilePre(); + } +#ifdef AGN + if(Nyx::theAPC()) { + Nyx::theAPC()->WritePlotFilePre(); + } +#endif + } + +void +Nyx::writePlotFilePost (const std::string& dir, ostream& os) +{ + if(Nyx::theDMPC()) { + Nyx::theDMPC()->WritePlotFilePost(); + } +#ifdef AGN + if(Nyx::theAPC()) { + Nyx::theAPC()->WritePlotFilePost(); + } +#endif +} + + void Nyx::particle_plot_file (const std::string& dir) { @@ -513,8 +573,9 @@ Nyx::particle_plot_file (const std::string& dir) std::string FileName = dir + "/comoving_a"; std::ofstream File; File.open(FileName.c_str(), std::ios::out|std::ios::trunc); - if (!File.good()) + if ( ! File.good()) { amrex::FileOpenFailed(FileName); + } File.precision(15); if (cur_time == 0) { @@ -531,8 +592,9 @@ Nyx::particle_plot_file (const std::string& dir) std::string FileName = dir + "/" + dm_plt_particle_file + "/precision"; std::ofstream File; File.open(FileName.c_str(), std::ios::out|std::ios::trunc); - if (!File.good()) + if ( ! File.good()) { amrex::FileOpenFailed(FileName); + } File.precision(15); File << particle_plotfile_format << '\n'; File.close(); @@ -545,8 +607,9 @@ Nyx::particle_plot_file (const std::string& dir) std::string FileName = dir + "/" + agn_plt_particle_file + "/precision"; std::ofstream File; File.open(FileName.c_str(), std::ios::out|std::ios::trunc); - if (!File.good()) + if ( ! File.good()) { amrex::FileOpenFailed(FileName); + } File.precision(15); File << particle_plotfile_format << '\n'; File.close(); @@ -558,6 +621,7 @@ Nyx::particle_plot_file (const std::string& dir) void Nyx::particle_check_point (const std::string& dir) { + BL_PROFILE("Nyx::particle_check_point"); if (level == 0) { if (Nyx::theDMPC()) @@ -582,8 +646,9 @@ Nyx::particle_check_point (const std::string& dir) std::string FileName = dir + "/comoving_a"; std::ofstream File; File.open(FileName.c_str(), std::ios::out|std::ios::trunc); - if (!File.good()) + if ( ! File.good()) { amrex::FileOpenFailed(FileName); + } File.precision(15); if (cur_time == 0) { @@ -605,8 +670,9 @@ Nyx::write_parameter_file (const std::string& dir) std::string FileName = dir + "/the_parameters"; std::ofstream File; File.open(FileName.c_str(), std::ios::out|std::ios::trunc); - if (!File.good()) + if ( ! File.good()) { amrex::FileOpenFailed(FileName); + } File.precision(15); ParmParse::dumpTable(File,true); File.close(); @@ -622,8 +688,9 @@ Nyx::writeMultiFabAsPlotFile(const std::string& pltfile, std::ofstream os; if (ParallelDescriptor::IOProcessor()) { - if (!amrex::UtilCreateDirectory(pltfile, 0755)) - amrex::CreateDirectoryFailed(pltfile); + if( ! amrex::UtilCreateDirectory(pltfile, 0755)) { + amrex::CreateDirectoryFailed(pltfile); + } std::string HeaderFileName = pltfile + "/Header"; os.open(HeaderFileName.c_str(), std::ios::out|std::ios::trunc|std::ios::binary); // The first thing we write out is the plotfile type. @@ -666,17 +733,20 @@ Nyx::writeMultiFabAsPlotFile(const std::string& pltfile, // Now for the full pathname of that directory. // std::string FullPath = pltfile; - if (!FullPath.empty() && FullPath[FullPath.size()-1] != '/') + if ( ! FullPath.empty() && FullPath[FullPath.size()-1] != '/') { FullPath += '/'; + } FullPath += Level; // // Only the I/O processor makes the directory if it doesn't already exist. // - if (ParallelDescriptor::IOProcessor()) - if (!amrex::UtilCreateDirectory(FullPath, 0755)) + if (ParallelDescriptor::IOProcessor()) { + if ( ! amrex::UtilCreateDirectory(FullPath, 0755)) { amrex::CreateDirectoryFailed(FullPath); + } + } // - // Force other processors to wait till directory is built. + // Force other processors to wait until directory is built. // ParallelDescriptor::Barrier(); @@ -740,8 +810,49 @@ Nyx::checkPoint (const std::string& dir, CPUFile.close(); } } + + if(Nyx::theDMPC()) { + Nyx::theDMPC()->SetLevelDirectoriesCreated(false); + } +#ifdef AGN + if(Nyx::theAPC()) { + Nyx::theAPC()->SetLevelDirectoriesCreated(false); + } +#endif + +} + +void +Nyx::checkPointPre (const std::string& dir, + std::ostream& os) +{ + if(Nyx::theDMPC()) { + Nyx::theDMPC()->CheckpointPre(); + } +#ifdef AGN + if(Nyx::theAPC()) { + Nyx::theAPC()->CheckpointPre(); + } +#endif + } + +void +Nyx::checkPointPost (const std::string& dir, + std::ostream& os) +{ + if(Nyx::theDMPC()) { + Nyx::theDMPC()->CheckpointPost(); + } +#ifdef AGN + if(Nyx::theAPC()) { + Nyx::theAPC()->CheckpointPost(); + } +#endif +} + + #ifdef FORCING void Nyx::forcing_check_point (const std::string& dir) @@ -753,8 +864,9 @@ Nyx::forcing_check_point (const std::string& dir) std::string FileName = dir + "/forcing"; std::ofstream File; File.open(FileName.c_str(), std::ios::out|std::ios::trunc); - if (!File.good()) + if ( ! File.good()) { amrex::FileOpenFailed(FileName); + } File.setf(std::ios::scientific, std::ios::floatfield); File.precision(16); forcing->write_Spectrum(File); @@ -762,8 +874,9 @@ Nyx::forcing_check_point (const std::string& dir) FileName = dir + "/mt"; File.open(FileName.c_str(), std::ios::out|std::ios::trunc); - if (!File.good()) + if ( ! File.good()) { amrex::FileOpenFailed(FileName); + } mt_write(File); } } diff --git a/Source/Nyx_slice.H b/Source/Nyx_slice.H deleted file mode 100644 index 2ffd2163..00000000 --- a/Source/Nyx_slice.H +++ /dev/null @@ -1,11 +0,0 @@ -#ifndef _slice_util_H_ -#define _slice_util_H_ - -#include - -namespace slice_util -{ - std::unique_ptr getSliceData(int dir, const amrex::MultiFab& cell_centered_data, - int fstart, int ncomp, const amrex::Geometry& geom, amrex::Real dir_coord); -} -#endif diff --git a/Source/Nyx_slice.cpp b/Source/Nyx_slice.cpp deleted file mode 100644 index 5aa7f381..00000000 --- a/Source/Nyx_slice.cpp +++ /dev/null @@ -1,100 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include - -using std::cout; -using std::cerr; -using std::endl; -using std::istream; -using std::ostream; -using std::pair; -using std::string; - -#include -#include -#include -#include - -using namespace amrex; - -namespace slice_util -{ - - static Box - getIndexBox(const RealBox& real_box, const Geometry& geom) { - IntVect slice_lo, slice_hi; - - D_TERM(slice_lo[0]=floor((real_box.lo(0) - geom.ProbLo(0))/geom.CellSize(0));, - slice_lo[1]=floor((real_box.lo(1) - geom.ProbLo(1))/geom.CellSize(1));, - slice_lo[2]=floor((real_box.lo(2) - geom.ProbLo(2))/geom.CellSize(2));); - - D_TERM(slice_hi[0]=floor((real_box.hi(0) - geom.ProbLo(0))/geom.CellSize(0));, - slice_hi[1]=floor((real_box.hi(1) - geom.ProbLo(1))/geom.CellSize(1));, - slice_hi[2]=floor((real_box.hi(2) - geom.ProbLo(2))/geom.CellSize(2));); - - return Box(slice_lo, slice_hi) & geom.Domain(); - } - - static - std::unique_ptr allocateSlice(int dir, const MultiFab& cell_centered_data, - int ncomp, const Geometry& geom, Real dir_coord, - Array& slice_to_full_ba_map) { - - // Get our slice and convert to index space - RealBox real_slice = geom.ProbDomain(); - real_slice.setLo(dir, dir_coord); - real_slice.setHi(dir, dir_coord); - Box slice_box = getIndexBox(real_slice, geom); - - // define the multifab that stores slice - BoxArray ba = cell_centered_data.boxArray(); - const DistributionMapping& dm = cell_centered_data.DistributionMap(); - std::vector< std::pair > isects; - ba.intersections(slice_box, isects, false, 0); - Array boxes; - Array procs; - for (int i = 0; i < isects.size(); ++i) { - procs.push_back(dm[isects[i].first]); - boxes.push_back(isects[i].second); - slice_to_full_ba_map.push_back(isects[i].first); - } - procs.push_back(ParallelDescriptor::MyProc()); - BoxArray slice_ba(&boxes[0], boxes.size()); - DistributionMapping slice_dmap(procs); - std::unique_ptr slice(new MultiFab(slice_ba, slice_dmap, ncomp, 0)); - return slice; - } - - std::unique_ptr getSliceData(int dir, const MultiFab& cell_centered_data, - int fstart, int ncomp, const Geometry& geom, Real dir_coord) { - - Array slice_to_full_ba_map; - std::unique_ptr slice = allocateSlice(dir, cell_centered_data, ncomp, geom, dir_coord, - slice_to_full_ba_map); - - // Fill the slice with sampled data - int nf = cell_centered_data.nComp(); - const BoxArray& ba = cell_centered_data.boxArray(); - for (MFIter mfi(*slice); mfi.isValid(); ++mfi) { - int slice_gid = mfi.index(); - int full_gid = slice_to_full_ba_map[slice_gid]; - - const Box& slice_box = mfi.validbox(); - const Box& full_box = cell_centered_data[full_gid].box(); - const Box& tile_box = mfi.tilebox(); - - fill_slice(cell_centered_data[full_gid].dataPtr(), - full_box.loVect(), full_box.hiVect(), - &fstart, &nf, - (*slice)[slice_gid].dataPtr(), - slice_box.loVect(), slice_box.hiVect(), - tile_box.loVect(), tile_box.hiVect(), &ncomp); - } - - return slice; - } -} diff --git a/Source/Src_3d/Make.package b/Source/Src_3d/Make.package index 81e9f1fb..50a10e9f 100644 --- a/Source/Src_3d/Make.package +++ b/Source/Src_3d/Make.package @@ -2,7 +2,6 @@ f90EXE_sources += compute_temp_3d.f90 f90EXE_sources += enforce_consistent_e_3d.f90 f90EXE_sources += enforce_nonnegative_species_3d.f90 f90EXE_sources += EstDt_3d.f90 -f90EXE_sources += fill_slice_3d.f90 f90EXE_sources += Nyx_sums_3d.f90 f90EXE_sources += reset_internal_energy_3d.f90 f90EXE_sources += update_particles_3d.f90 diff --git a/Source/Src_3d/compute_temp_3d.f90 b/Source/Src_3d/compute_temp_3d.f90 index 379d346a..5add102e 100644 --- a/Source/Src_3d/compute_temp_3d.f90 +++ b/Source/Src_3d/compute_temp_3d.f90 @@ -72,7 +72,7 @@ subroutine fort_compute_temp(lo,hi, & JH = 1 if (inhomogeneous_on) then if (z .gt. diag_eos(i,j,k,ZHI_COMP)) JH = 0 - endif + end if call nyx_eos_T_given_Re(JH, JHe, diag_eos(i,j,k,TEMP_COMP), diag_eos(i,j,k,NE_COMP), & state(i,j,k,URHO), eint, comoving_a) @@ -263,6 +263,55 @@ subroutine fort_compute_rho_temp(lo,hi,dx, & end subroutine fort_compute_rho_temp + subroutine fort_compute_gas_frac(lo,hi,dx, & + state,s_l1,s_l2,s_l3,s_h1,s_h2,s_h3, & + diag_eos,d_l1,d_l2,d_l3,d_h1,d_h2,d_h3, & + rho_ave, T_cut, rho_cut, & + whim_mass, whim_vol, hh_mass, & + hh_vol, igm_mass, igm_vol, mass_sum, vol_sum) & + bind(C, name = "fort_compute_gas_frac") + + use meth_params_module, only : NVAR, URHO, NDIAG, TEMP_COMP + + use amrex_fort_module, only : rt => amrex_real + implicit none + integer , intent(in ) :: lo(3),hi(3) + integer , intent(in ) :: s_l1,s_l2,s_l3,s_h1,s_h2,s_h3 + integer , intent(in ) :: d_l1,d_l2,d_l3,d_h1,d_h2,d_h3 + real(rt), intent(in ) :: dx(3) + real(rt), intent(in ) :: rho_ave, T_cut, rho_cut + real(rt), intent(in ) :: state(s_l1:s_h1,s_l2:s_h2,s_l3:s_h3,NVAR) + real(rt), intent(inout) :: diag_eos(d_l1:d_h1,d_l2:d_h2,d_l3:d_h3,NDIAG) + real(rt), intent(inout) :: whim_mass, whim_vol, hh_mass, hh_vol, igm_mass, igm_vol + real(rt), intent(inout) :: mass_sum, vol_sum + + integer :: i,j,k + real(rt) :: vol, T, R + + vol = dx(1)*dx(2)*dx(3) + do k = lo(3),hi(3) + do j = lo(2),hi(2) + do i = lo(1),hi(1) + T = diag_eos(i,j,k,TEMP_COMP) + R = state(i,j,k,URHO) / rho_ave + if ( (T .gt. T_cut) .and. (R .le. rho_cut) ) then + whim_mass = whim_mass + state(i,j,k,URHO)*vol + whim_vol = whim_vol + vol + else if ( (T .gt. T_cut) .and. (R .gt. rho_cut) ) then + hh_mass = hh_mass + state(i,j,k,URHO)*vol + hh_vol = hh_vol + vol + else if ( (T .le. T_cut) .and. (R .le. rho_cut) ) then + igm_mass = igm_mass + state(i,j,k,URHO)*vol + igm_vol = igm_vol + vol + endif + mass_sum = mass_sum + state(i,j,k,URHO)*vol + vol_sum = vol_sum + vol + enddo + enddo + enddo + + end subroutine fort_compute_gas_frac + subroutine fort_compute_max_temp_loc(lo,hi, & state ,s_l1,s_l2,s_l3, s_h1,s_h2,s_h3, & diag_eos,d_l1,d_l2,d_l3, d_h1,d_h2,d_h3, & diff --git a/Source/Src_3d/fill_slice_3d.f90 b/Source/Src_3d/fill_slice_3d.f90 deleted file mode 100644 index c0415a95..00000000 --- a/Source/Src_3d/fill_slice_3d.f90 +++ /dev/null @@ -1,26 +0,0 @@ - - subroutine fill_slice_3d(full_data, flo, fhi, fstart, nfull, slice_data, slo, shi, tlo, thi, ncomp) & - bind(C, name="fill_slice") - - use amrex_fort_module, only : amrex_real - - integer , intent(in) :: ncomp, fstart, nfull - integer , intent(in) :: flo(3), fhi(3) - integer , intent(in) :: slo(3), shi(3) - integer , intent(in) :: tlo(3), thi(3) - real(amrex_real), intent(inout) :: full_data(flo(1):fhi(1),flo(2):fhi(2),flo(3):fhi(3), nfull) - real(amrex_real), intent(inout) :: slice_data(slo(1):shi(1),slo(2):shi(2),slo(3):shi(3), ncomp) - - integer n, i, j, k - - do n = 1, ncomp - do k = tlo(3), thi(3) - do j = tlo(2), thi(2) - do i = tlo(1), thi(1) - slice_data(i, j, k, n) = full_data(i, j, k, fstart+n) - end do - end do - end do - end do - - end subroutine fill_slice_3d diff --git a/Source/main.cpp b/Source/main.cpp index fa33f297..173bf8dd 100644 --- a/Source/main.cpp +++ b/Source/main.cpp @@ -1,572 +1,8 @@ -// @todo: deprecate windows includes - - -#include -#include -#include - -#ifndef WIN32 -#include -#endif - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#ifdef BL_USE_MPI -#include -#endif -#include - -#ifdef REEBER -#include // This actually works both in situ and in-transit. -#endif - -#include "Nyx_output.H" - -std::string inputs_name = ""; - -#ifdef GIMLET -#include -#include -#include -#include -#endif - -using namespace amrex; - -const int NyxHaloFinderSignal(42); -const int resizeSignal(43); -const int GimletSignal(55); -const int quitSignal(-44); - - -// This anonymous namespace defines the workflow of the sidecars when running -// in in-transit mode. -namespace -{ - static void ResizeSidecars(int newSize) { -#ifdef BL_USE_MPI - // ---- everyone meets here - ParallelDescriptor::Barrier(ParallelDescriptor::CommunicatorAll()); - if(ParallelDescriptor::IOProcessor()) { - std::cout << ParallelDescriptor::MyProcAll() << ": _in ResizeSidecars::newSize = " - << newSize << std::endl; - } - ParallelDescriptor::Barrier(ParallelDescriptor::CommunicatorAll()); - ParallelDescriptor::SetNProcsSidecars(newSize); -#endif /* BL_USE_MPI */ - } - - - static int SidecarEventLoop() { - -#ifdef BL_USE_MPI - BL_ASSERT(NyxHaloFinderSignal != quitSignal); - - bool finished(false); - int sidecarSignal(-1); - int whichSidecar(0); // ---- this is sidecar zero - if(ParallelDescriptor::IOProcessor()) { - std::cout << "SSSSSSSS: Starting SidecarEventLoop." << std::endl; - } - - while ( ! finished) { - // ---- Receive the sidecarSignal from the compute group. - if(ParallelDescriptor::IOProcessor()) { - std::cout << "SSSSSSSS: waiting for signal from comp..." << std::endl; - } - ParallelDescriptor::Bcast(&sidecarSignal, 1, 0, ParallelDescriptor::CommunicatorInter(whichSidecar)); - - switch(sidecarSignal) { - case NyxHaloFinderSignal: - { -#ifdef REEBER - if(ParallelDescriptor::IOProcessor()) { - std::cout << "Sidecars got the halo finder sidecarSignal!" << std::endl; - } - - Geometry geom; - Geometry::SendGeometryToSidecar(&geom, whichSidecar); - - int time_step, nComp(0), nGhost(0); - int do_analysis; - - // Receive the necessary data for doing analysis. - ParallelDescriptor::Bcast(&nComp, 1, 0, ParallelDescriptor::CommunicatorInter(whichSidecar)); - - // Get desired box array and distribution mapping from Reeber - BoxArray ba; - DistributionMapping dm; - getAnalysisDecomposition(geom, ParallelDescriptor::NProcsSidecar(whichSidecar), ba, dm); - - MultiFab mf(ba, dm, nComp + 1, nGhost); - - MultiFab *mfSource = 0; - MultiFab *mfDest = &mf; - int srcComp(0), destComp(1); - int srcNGhost(0), destNGhost(0); - const MPI_Comm &commSrc = ParallelDescriptor::CommunicatorComp(); - const MPI_Comm &commDest = ParallelDescriptor::CommunicatorSidecar(); - const MPI_Comm &commInter = ParallelDescriptor::CommunicatorInter(whichSidecar); - const MPI_Comm &commBoth = ParallelDescriptor::CommunicatorBoth(whichSidecar); - bool isSrc(false); - - MultiFab::copyInter(mfSource, mfDest, srcComp, destComp, nComp, - srcNGhost, destNGhost, - commSrc, commDest, commInter, commBoth, - isSrc); - - mf.setVal(0, 0, 1, 0); - for (int comp = 1; comp < mf.nComp(); ++comp) - MultiFab::Add(mf, mf, comp, 0, 1, 0); - - - ParallelDescriptor::Bcast(&time_step, 1, 0, ParallelDescriptor::CommunicatorInter(whichSidecar)); - ParallelDescriptor::Bcast(&do_analysis, 1, 0, ParallelDescriptor::CommunicatorInter(whichSidecar)); - - // Here Reeber constructs the local-global merge trees and computes the - // halo locations. - runReeberAnalysis(mf, geom, time_step, bool(do_analysis)); - - if(ParallelDescriptor::IOProcessor()) { - std::cout << "Sidecars completed halo finding analysis." << std::endl; - } -#else - amrex::Abort("Nyx received halo finder signal but not compiled with Reeber"); -#endif /* REEBER */ - } - break; - - case GimletSignal: - { -#ifdef GIMLET - if(ParallelDescriptor::IOProcessor()) { - std::cout << "Sidecars got the halo finder GimletSignal!" << std::endl; - } - BoxArray bac; - Geometry geom; - int time_step; - Real new_a, omega_m, omega_b, omega_l, comoving_h; - - BoxArray::RecvBoxArray(bac, whichSidecar); - - MultiFab *mfSource = 0; - MultiFab *mfDest = 0; - int srcComp(0), destComp(0), nComp(1), nGhost(0); - int srcNGhost(0), destNGhost(0); - const MPI_Comm &commSrc = ParallelDescriptor::CommunicatorComp(); - const MPI_Comm &commDest = ParallelDescriptor::CommunicatorSidecar(); - const MPI_Comm &commInter = ParallelDescriptor::CommunicatorInter(whichSidecar); - const MPI_Comm &commBoth = ParallelDescriptor::CommunicatorBoth(whichSidecar); - bool isSrc(false); - - // ---- we should probably combine all of these into one MultiFab - MultiFab density(bac, nComp, nGhost); - MultiFab temperature(bac, nComp, nGhost); - MultiFab e_int(bac, nComp, nGhost); - MultiFab dm_density(bac, nComp, nGhost); - MultiFab xmom(bac, nComp, nGhost); - MultiFab ymom(bac, nComp, nGhost); - MultiFab zmom(bac, nComp, nGhost); - - mfDest = &density; - MultiFab::copyInter(mfSource, mfDest, srcComp, destComp, nComp, - srcNGhost, destNGhost, commSrc, commDest, commInter, commBoth, isSrc); - - mfDest = &temperature; - MultiFab::copyInter(mfSource, mfDest, srcComp, destComp, nComp, - srcNGhost, destNGhost, commSrc, commDest, commInter, commBoth, isSrc); - - mfDest = &e_int; - MultiFab::copyInter(mfSource, mfDest, srcComp, destComp, nComp, - srcNGhost, destNGhost, commSrc, commDest, commInter, commBoth, isSrc); - - mfDest = &dm_density; - MultiFab::copyInter(mfSource, mfDest, srcComp, destComp, nComp, - srcNGhost, destNGhost, commSrc, commDest, commInter, commBoth, isSrc); - - mfDest = &xmom; - MultiFab::copyInter(mfSource, mfDest, srcComp, destComp, nComp, - srcNGhost, destNGhost, commSrc, commDest, commInter, commBoth, isSrc); - - mfDest = &ymom; - MultiFab::copyInter(mfSource, mfDest, srcComp, destComp, nComp, - srcNGhost, destNGhost, commSrc, commDest, commInter, commBoth, isSrc); - - mfDest = &zmom; - MultiFab::copyInter(mfSource, mfDest, srcComp, destComp, nComp, - srcNGhost, destNGhost, commSrc, commDest, commInter, commBoth, isSrc); - - Geometry::SendGeometryToSidecar(&geom, whichSidecar); - - ParallelDescriptor::Bcast(&new_a, 1, 0, commInter); - ParallelDescriptor::Bcast(&omega_m, 1, 0, commInter); - omega_l = 1.0 - omega_m; - ParallelDescriptor::Bcast(&omega_b, 1, 0, commInter); - ParallelDescriptor::Bcast(&comoving_h, 1, 0, commInter); - ParallelDescriptor::Bcast(&time_step, 1, 0, commInter); - - if(ParallelDescriptor::IOProcessor()) { - std::cout << "===== Sidecars got everything ..." << std::endl; - } - - Real time1 = ParallelDescriptor::second(); - do_analysis(omega_b, omega_m, omega_l, comoving_h, new_a, density, temperature, - e_int, dm_density, xmom, ymom, zmom, geom, time_step); - Real dtime = ParallelDescriptor::second() - time1; - ParallelDescriptor::ReduceRealMax(dtime, ParallelDescriptor::IOProcessorNumber()); - if(ParallelDescriptor::IOProcessor()) { - std::cout << std::endl << "===== Time for Gimlet in-transit to post-process (sec): " - << dtime << " sec" << std::endl << std::flush; - } - ParallelDescriptor::Barrier(); -#else - amrex::Abort("Nyx received Gimlet signal but not compiled with Gimlet"); -#endif /* GIMLET */ - } - break; - - case resizeSignal: - { - if(ParallelDescriptor::IOProcessor()) { - std::cout << "_in sidecars: Sidecars received the resize sidecarSignal." << std::endl; - } - finished = true; - } - break; - - case quitSignal: - { - if(ParallelDescriptor::IOProcessor()) { - std::cout << "Sidecars received the quit sidecarSignal." << std::endl; - } - finished = true; - } - break; - - default: - { - if(ParallelDescriptor::IOProcessor()) { - std::cout << "**** Sidecars received bad sidecarSignal = " << sidecarSignal << std::endl; - } - } - break; - } - - } - if(ParallelDescriptor::IOProcessor()) { - if(sidecarSignal == resizeSignal) { - std::cout << "===== Sidecars exiting for resize. =====" << std::endl; - } - if(sidecarSignal == quitSignal) { - std::cout << "===== Sidecars quitting. =====" << std::endl; - } - } - return sidecarSignal; -#else - return 0; -#endif /* BL_USE_MPI */ - } - -// The following function does not seem to be used -// static void SidecarInit() { -//#ifdef REEBER -// if(ParallelDescriptor::InSidecarGroup() && ParallelDescriptor::IOProcessor()) { -// std::cout << "Initializing Reeber on sidecars ... " << std::endl; -// } else if (ParallelDescriptor::IOProcessor()) { -// std::cout << "Initializing Reeber in situ ... " << std::endl; -// } -// // Reeber reads its ParmParse stuff here so we don't need to do any of it -// // in Nyx proper. -// reeber_int = initReeberAnalysis(); -// std::cout << "SidecarInit(): reeber_int = " << reeber_int << std::endl; -//#endif -// } -} - - - +void nyx_main(int argc, char* argv[]); int main (int argc, char* argv[]) { - amrex::Initialize(argc, argv); - - - // save the inputs file name for later - if (argc > 1) { - if (!strchr(argv[1], '=')) { - inputs_name = argv[1]; - } - } - BL_PROFILE_REGION_START("main()"); - BL_PROFILE_VAR("main()", pmain); - - // - // Don't start timing until all CPUs are ready to go. - // - ParallelDescriptor::Barrier("Starting main."); - - BL_COMM_PROFILE_NAMETAG("main TOP"); - -#ifdef BL_USE_MPI - const int MPI_IntraGroup_Broadcast_Rank = ParallelDescriptor::IOProcessor() ? MPI_ROOT : MPI_PROC_NULL; - int nSidecarProcsFromParmParse(-3); - Nyx::nSidecarProcs = 0; - int prevSidecarProcs(0); - int sidecarSignal(NyxHaloFinderSignal); - int resizeSidecars(false); // ---- instead of bool for bcast -#endif - - Real dRunTime1 = ParallelDescriptor::second(); - - std::cout << std::setprecision(10); - - int max_step; - Real strt_time; - Real stop_time; - ParmParse pp; - - max_step = -1; - strt_time = 0.0; - stop_time = -1.0; - - pp.query("max_step", max_step); - pp.query("strt_time", strt_time); - pp.query("stop_time", stop_time); - - int how(-1); - pp.query("how",how); - -#ifdef BL_USE_MPI - // Set up sidecars if user wants them. - if (pp.query("nSidecars", nSidecarProcsFromParmParse)) - { - if(ParallelDescriptor::IOProcessor()) { - std::cout << "nSidecarProcs from parmparse = " << nSidecarProcsFromParmParse << std::endl; - } - resizeSidecars = !(prevSidecarProcs == Nyx::nSidecarProcs); - prevSidecarProcs = Nyx::nSidecarProcs; - if(nSidecarProcsFromParmParse >= 0) { - if(nSidecarProcsFromParmParse >= ParallelDescriptor::NProcsAll()) { - amrex::Abort("**** Error: nSidecarProcsFromParmParse >= nProcs"); - } - Nyx::nSidecarProcs = nSidecarProcsFromParmParse; - } - } -#endif - - if (strt_time < 0.0) - { - amrex::Abort("MUST SPECIFY a non-negative strt_time"); - } - - if (max_step < 0 && stop_time < 0.0) - { - amrex::Abort("**** Error: either max_step or stop_time has to be positive!"); - } - - // Reeber has to do some initialization. -#ifdef REEBER - reeber_int = initReeberAnalysis(); -#endif - - if (Nyx::nSidecarProcs > 0) - Nyx::forceParticleRedist = true; - - Amr *amrptr = new Amr; - amrptr->init(strt_time,stop_time); - -#if BL_USE_MPI - // ---- initialize nyx memory monitoring - MemInfo *mInfo = MemInfo::GetInstance(); - mInfo->LogSummary("MemInit "); -#endif - - // ---- set initial sidecar size - ParallelDescriptor::Bcast(&Nyx::nSidecarProcs, 1, 0, ParallelDescriptor::CommunicatorAll()); - if(ParallelDescriptor::IOProcessor()) { - std::cout << "IIIIIIII new nSidecarProcs = " << Nyx::nSidecarProcs << std::endl; - } - -#ifdef BL_USE_MPI - if(Nyx::nSidecarProcs < prevSidecarProcs) { - ResizeSidecars(Nyx::nSidecarProcs); - amrptr->AddProcsToComp(Nyx::nSidecarProcs, prevSidecarProcs); - amrptr->RedistributeGrids(how); - } else if (Nyx::nSidecarProcs > prevSidecarProcs) { - if(ParallelDescriptor::InCompGroup()) { - amrptr->AddProcsToSidecar(Nyx::nSidecarProcs, prevSidecarProcs); - } - ResizeSidecars(Nyx::nSidecarProcs); - } -#endif - const Real time_before_main_loop = ParallelDescriptor::second(); - -#ifdef USE_CVODE - Nyx::alloc_simd_vec(); -#endif - - bool finished(false); - - while ( ! finished) { - - Nyx::forceParticleRedist = true; - - if(ParallelDescriptor::InSidecarGroup()) { // ------------------- start sidecars -#ifdef BL_USE_MPI - - int returnCode = SidecarEventLoop(); - if(returnCode == quitSignal) { - finished = true; - } - resizeSidecars = (returnCode == resizeSignal); - -#endif - } else { // ----------------------------------------------------- start comp - - // If we set the regrid_on_restart flag and if we are *not* going to take - // a time step then we want to go ahead and regrid here. - // - if (amrptr->RegridOnRestart()) { - if ( (amrptr->levelSteps(0) >= max_step ) || - ( (stop_time >= 0.0) && - (amrptr->cumTime() >= stop_time) ) ) - { - // Regrid only! - amrptr->RegridOnly(amrptr->cumTime()); - } - } - - if (amrptr->okToContinue() - && (amrptr->levelSteps(0) < max_step || max_step < 0) - && (amrptr->cumTime() < stop_time || stop_time < 0.0)) - - { - amrptr->coarseTimeStep(stop_time); // ---- Do a timestep. - } else { - finished = true; -#ifdef BL_USE_MPI - resizeSidecars = false; -#endif - } - -#ifdef BL_USE_MPI - if((finished || resizeSidecars) && Nyx::nSidecarProcs > 0 && prevSidecarProcs > 0) { - // ---- stop the sidecars - int sidecarSignal(-1); - if(finished) { - sidecarSignal = quitSignal; - } else if(resizeSidecars) { - sidecarSignal = resizeSignal; - } - int whichSidecar(0); - ParallelDescriptor::Bcast(&sidecarSignal, 1, MPI_IntraGroup_Broadcast_Rank, - ParallelDescriptor::CommunicatorInter(whichSidecar)); - } -#endif - - } // ---------------- end start comp - - - -#ifdef BL_USE_MPI - if(resizeSidecars) { // ---- both comp and sidecars are here - ParallelDescriptor::Bcast(&prevSidecarProcs, 1, 0, ParallelDescriptor::CommunicatorAll()); - ParallelDescriptor::Bcast(&Nyx::nSidecarProcs, 1, 0, ParallelDescriptor::CommunicatorAll()); - if(ParallelDescriptor::InCompGroup()) { - if(ParallelDescriptor::IOProcessor()) { - std::cout << "NNNNNNNN new nSidecarProcs = " << Nyx::nSidecarProcs << std::endl; - std::cout << "NNNNNNNN prevSidecarProcs = " << prevSidecarProcs << std::endl; - } - } - Nyx::forceParticleRedist = true; - - if(Nyx::nSidecarProcs < prevSidecarProcs) { - ResizeSidecars(Nyx::nSidecarProcs); - } - - if(Nyx::nSidecarProcs > prevSidecarProcs) { - if(ParallelDescriptor::InCompGroup()) { - amrptr->AddProcsToSidecar(Nyx::nSidecarProcs, prevSidecarProcs); - } - } - - if(Nyx::nSidecarProcs < prevSidecarProcs) { - - amrptr->AddProcsToComp(Nyx::nSidecarProcs, prevSidecarProcs); - amrptr->RedistributeGrids(how); - } - - if(Nyx::nSidecarProcs > prevSidecarProcs) { - ResizeSidecars(Nyx::nSidecarProcs); - } - if(ParallelDescriptor::IOProcessor()) { - std::cout << "@@@@@@@@ after resize sidecars: restarting event loop." << std::endl; - } - } -#endif - } // ---- end while( ! finished) - -#ifdef USE_CVODE - Nyx::dealloc_simd_vec(); -#endif - - const Real time_without_init = ParallelDescriptor::second() - time_before_main_loop; - if (ParallelDescriptor::IOProcessor()) std::cout << "Time w/o init: " << time_without_init << std::endl; - - - if(ParallelDescriptor::InCompGroup()) { - // Write final checkpoint and plotfile - if (amrptr->stepOfLastCheckPoint() < amrptr->levelSteps(0)) { - amrptr->checkPoint(); - } - if (amrptr->stepOfLastPlotFile() < amrptr->levelSteps(0)) { - amrptr->writePlotFile(); - } - } - -#ifdef BL_USE_MPI - if(Nyx::nSidecarProcs > 0) { // ---- stop the sidecars - sidecarSignal = quitSignal; - int whichSidecar(0); - ParallelDescriptor::Bcast(&sidecarSignal, 1, MPI_IntraGroup_Broadcast_Rank, - ParallelDescriptor::CommunicatorInter(whichSidecar)); - } - - ParallelDescriptor::SetNProcsSidecars(0); -#endif - - delete amrptr; - - - // - // This MUST follow the above delete as ~Amr() may dump files to disk. - // - const int IOProc = ParallelDescriptor::IOProcessorNumber(); - - Real dRunTime2 = ParallelDescriptor::second() - dRunTime1; - - ParallelDescriptor::ReduceRealMax(dRunTime2, IOProc); - - if (ParallelDescriptor::IOProcessor()) - { - std::cout << "Run time = " << dRunTime2 << std::endl; - } - - BL_PROFILE_VAR_STOP(pmain); - BL_PROFILE_REGION_STOP("main()"); - BL_PROFILE_SET_RUN_TIME(dRunTime2); - - amrex::Finalize(); - + nyx_main(argc, argv); return 0; } diff --git a/Source/nyx_main.cpp b/Source/nyx_main.cpp new file mode 100644 index 00000000..c6352cfa --- /dev/null +++ b/Source/nyx_main.cpp @@ -0,0 +1,184 @@ + +#include +#include +#include + +#ifndef WIN32 +#include +#endif + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#ifdef BL_USE_MPI +#include +#endif +#include + +#ifdef REEBER +#include // This actually works both in situ and in-transit. +#endif + +#include "Nyx_output.H" + +std::string inputs_name = ""; + +#ifdef GIMLET +#include +#include +#include +#include +#endif + +using namespace amrex; + +const int NyxHaloFinderSignal(42); +const int resizeSignal(43); +const int GimletSignal(55); +const int quitSignal(-44); + +void +nyx_main (int argc, char* argv[]) +{ + amrex::Initialize(argc, argv); + + // save the inputs file name for later + if (argc > 1) { + if (!strchr(argv[1], '=')) { + inputs_name = argv[1]; + } + } + BL_PROFILE_REGION_START("main()"); + BL_PROFILE_VAR("main()", pmain); + + // + // Don't start timing until all CPUs are ready to go. + // + ParallelDescriptor::Barrier("Starting main."); + + BL_COMM_PROFILE_NAMETAG("main TOP"); + + Real dRunTime1 = ParallelDescriptor::second(); + + std::cout << std::setprecision(10); + + int max_step; + Real strt_time; + Real stop_time; + ParmParse pp; + + max_step = -1; + strt_time = 0.0; + stop_time = -1.0; + + pp.query("max_step", max_step); + pp.query("strt_time", strt_time); + pp.query("stop_time", stop_time); + + int how(-1); + pp.query("how",how); + + if (strt_time < 0.0) + { + amrex::Abort("MUST SPECIFY a non-negative strt_time"); + } + + if (max_step < 0 && stop_time < 0.0) + { + amrex::Abort("**** Error: either max_step or stop_time has to be positive!"); + } + + // Reeber has to do some initialization. +#ifdef REEBER + reeber_int = initReeberAnalysis(); +#endif + + Amr *amrptr = new Amr; + amrptr->init(strt_time,stop_time); + +#if BL_USE_MPI + // ---- initialize nyx memory monitoring + MemInfo *mInfo = MemInfo::GetInstance(); + mInfo->LogSummary("MemInit "); +#endif + + const Real time_before_main_loop = ParallelDescriptor::second(); + +#ifdef USE_CVODE + Nyx::alloc_simd_vec(); +#endif + + bool finished(false); + + while ( ! finished) + { + // If we set the regrid_on_restart flag and if we are *not* going to take + // a time step then we want to go ahead and regrid here. + // + if (amrptr->RegridOnRestart()) { + if ( (amrptr->levelSteps(0) >= max_step ) || + ( (stop_time >= 0.0) && + (amrptr->cumTime() >= stop_time) ) ) + { + // Regrid only! + amrptr->RegridOnly(amrptr->cumTime()); + } + } + + if (amrptr->okToContinue() + && (amrptr->levelSteps(0) < max_step || max_step < 0) + && (amrptr->cumTime() < stop_time || stop_time < 0.0)) + + { + amrptr->coarseTimeStep(stop_time); // ---- Do a timestep. + } else { + finished = true; + } + + } // ---- end while( ! finished) + +#ifdef USE_CVODE + Nyx::dealloc_simd_vec(); +#endif + + const Real time_without_init = ParallelDescriptor::second() - time_before_main_loop; + if (ParallelDescriptor::IOProcessor()) std::cout << "Time w/o init: " << time_without_init << std::endl; + + // Write final checkpoint and plotfile + if (amrptr->stepOfLastCheckPoint() < amrptr->levelSteps(0)) { + amrptr->checkPoint(); + } + if (amrptr->stepOfLastPlotFile() < amrptr->levelSteps(0)) { + amrptr->writePlotFile(); + } + + delete amrptr; + + // + // This MUST follow the above delete as ~Amr() may dump files to disk. + // + const int IOProc = ParallelDescriptor::IOProcessorNumber(); + + Real dRunTime2 = ParallelDescriptor::second() - dRunTime1; + + ParallelDescriptor::ReduceRealMax(dRunTime2, IOProc); + + if (ParallelDescriptor::IOProcessor()) + { + std::cout << "Run time = " << dRunTime2 << std::endl; + } + + BL_PROFILE_VAR_STOP(pmain); + BL_PROFILE_REGION_STOP("main()"); + BL_PROFILE_SET_RUN_TIME(dRunTime2); + + amrex::Finalize(); +} diff --git a/Source/write_info.cpp b/Source/write_info.cpp index 1c1a06df..184c510b 100644 --- a/Source/write_info.cpp +++ b/Source/write_info.cpp @@ -15,11 +15,14 @@ Nyx::write_info () Real max_t = 0; Real rho_T_avg=0.0, T_avg=0.0, Tinv_avg=0.0, T_meanrho=0.0; + Real whim_mass_frac, whim_vol_frac, hh_mass_frac, hh_vol_frac, igm_mass_frac, igm_vol_frac; if (do_hydro) { compute_new_temp(); max_t = D_new.norm0(Temp_comp); compute_rho_temp(rho_T_avg, T_avg, Tinv_avg, T_meanrho); + compute_gas_fractions(1.0e5, 120.0, whim_mass_frac, whim_vol_frac, + hh_mass_frac, hh_vol_frac, igm_mass_frac, igm_vol_frac); } #endif @@ -51,6 +54,12 @@ Nyx::write_info () data_loga << std::setw(14) << "T @ "; data_loga << std::setw(14) << "T(21cm) "; data_loga << std::setw(14) << "adiab. "; + data_loga << std::setw(14) << "WHIM_m "; + data_loga << std::setw(14) << "WHIM_v "; + data_loga << std::setw(14) << "HH_m "; + data_loga << std::setw(14) << "HH_v "; + data_loga << std::setw(14) << "IGM_m "; + data_loga << std::setw(14) << "IGM_v "; } #endif data_loga << '\n'; @@ -70,6 +79,12 @@ Nyx::write_info () data_loga << std::setw(14) << std::setprecision(6) << T_meanrho; data_loga << std::setw(14) << std::setprecision(6) << 1.0/Tinv_avg; data_loga << std::setw(14) << std::setprecision(6) << 0.021*(1.0+old_z)*(1.0+old_z); + data_loga << std::setw(14) << std::setprecision(6) << whim_mass_frac; + data_loga << std::setw(14) << std::setprecision(6) << whim_vol_frac; + data_loga << std::setw(14) << std::setprecision(6) << hh_mass_frac; + data_loga << std::setw(14) << std::setprecision(6) << hh_vol_frac; + data_loga << std::setw(14) << std::setprecision(6) << igm_mass_frac; + data_loga << std::setw(14) << std::setprecision(6) << igm_vol_frac; } #endif data_loga << '\n'; @@ -91,6 +106,12 @@ Nyx::write_info () data_loga << std::setw(14) << std::setprecision(6) << T_meanrho; data_loga << std::setw(14) << std::setprecision(6) << 1.0/Tinv_avg; data_loga << std::setw(14) << std::setprecision(6) << 0.021*(1.0+new_z)*(1.0+new_z); + data_loga << std::setw(14) << std::setprecision(6) << whim_mass_frac; + data_loga << std::setw(14) << std::setprecision(6) << whim_vol_frac; + data_loga << std::setw(14) << std::setprecision(6) << hh_mass_frac; + data_loga << std::setw(14) << std::setprecision(6) << hh_vol_frac; + data_loga << std::setw(14) << std::setprecision(6) << igm_mass_frac; + data_loga << std::setw(14) << std::setprecision(6) << igm_vol_frac; } #endif data_loga << std::endl; diff --git a/UsersGuide/PostProcessing/NyxPostProcessing.tex b/UsersGuide/PostProcessing/NyxPostProcessing.tex index ae7883f4..cbd79499 100644 --- a/UsersGuide/PostProcessing/NyxPostProcessing.tex +++ b/UsersGuide/PostProcessing/NyxPostProcessing.tex @@ -27,19 +27,7 @@ \section{Usage} that these codes are in separate repositories and are not included with Nyx. Nyx and AMReX provide the capability for the user to execute an arbitrary -post-processing workflow either \textit{in situ} or in-transit. An \textit{in +post-processing workflow \textit{in situ}. An \textit{in situ} workflow is one in which all MPI processes evolving the simulation stop at specified time steps and perform the post-processing before continuing with -the simulation. In-transit means that AMReX creates a disjoint group of MPI -processes (``sidecars'') from the global pool and reserves them exclusively for -post-processing. At specified time steps the group of processes evolving the -simulation will send the necessary data to the sidecar group, and then will -continue with the simulation. The two groups then work independently of one -another on their particular tasks. - -To run the post-processing workflow \textit{in situ}, one sets the -\texttt{nSidecars} parameter in the inputs file to \texttt{0}. To run the -workflow in-transit, one sets \texttt{nSidecars > 0}. Note that the sum of all -MPI processes is constant for the duration of the simulation, so whatever -number the user dedicates to post-processing will be subtracted from the number -doing the simulation itself. +the simulation. diff --git a/Util/SliceUtils/GNUmakefile b/Util/SliceUtils/GNUmakefile new file mode 100644 index 00000000..4698f83e --- /dev/null +++ b/Util/SliceUtils/GNUmakefile @@ -0,0 +1,27 @@ +AMREX_HOME ?= ../../../amrex + +DEBUG = TRUE + +DIM = 3 + +#COMP = intel # gcc +COMP = gcc + +TINY_PROFILE = FALSE +USE_PARTICLES = FALSE + +PRECISION = DOUBLE + +USE_MPI = FALSE +USE_OMP = FALSE + +################################################### + +EBASE = sliceutils + +include $(AMREX_HOME)/Tools/GNUMake/Make.defs + +include ./Make.package +include $(AMREX_HOME)/Src/Base/Make.package + +include $(AMREX_HOME)/Tools/GNUMake/Make.rules diff --git a/Util/SliceUtils/Make.package b/Util/SliceUtils/Make.package new file mode 100644 index 00000000..fa196e0d --- /dev/null +++ b/Util/SliceUtils/Make.package @@ -0,0 +1 @@ +CEXE_sources += sliceutils.cpp diff --git a/Util/SliceUtils/slice_00340/Diag_x_D_00001 b/Util/SliceUtils/slice_00340/Diag_x_D_00001 new file mode 100644 index 00000000..4227a31b Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_x_D_00001 differ diff --git a/Util/SliceUtils/slice_00340/Diag_x_D_00003 b/Util/SliceUtils/slice_00340/Diag_x_D_00003 new file mode 100644 index 00000000..b3930612 Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_x_D_00003 differ diff --git a/Util/SliceUtils/slice_00340/Diag_x_D_00005 b/Util/SliceUtils/slice_00340/Diag_x_D_00005 new file mode 100644 index 00000000..892fb3ae Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_x_D_00005 differ diff --git a/Util/SliceUtils/slice_00340/Diag_x_D_00007 b/Util/SliceUtils/slice_00340/Diag_x_D_00007 new file mode 100644 index 00000000..79d5cb4a Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_x_D_00007 differ diff --git a/Util/SliceUtils/slice_00340/Diag_x_H b/Util/SliceUtils/slice_00340/Diag_x_H new file mode 100644 index 00000000..9c2008c5 --- /dev/null +++ b/Util/SliceUtils/slice_00340/Diag_x_H @@ -0,0 +1,76 @@ +1 +1 +2 +0 +(16 0 +((16,0,0) (16,7,7) (0,0,0)) +((16,8,0) (16,15,7) (0,0,0)) +((16,16,0) (16,23,7) (0,0,0)) +((16,24,0) (16,31,7) (0,0,0)) +((16,0,8) (16,7,15) (0,0,0)) +((16,8,8) (16,15,15) (0,0,0)) +((16,16,8) (16,23,15) (0,0,0)) +((16,24,8) (16,31,15) (0,0,0)) +((16,0,16) (16,7,23) (0,0,0)) +((16,8,16) (16,15,23) (0,0,0)) +((16,16,16) (16,23,23) (0,0,0)) +((16,24,16) (16,31,23) (0,0,0)) +((16,0,24) (16,7,31) (0,0,0)) +((16,8,24) (16,15,31) (0,0,0)) +((16,16,24) (16,23,31) (0,0,0)) +((16,24,24) (16,31,31) (0,0,0)) +) +16 +FabOnDisk: Diag_x_D_00001 0 +FabOnDisk: Diag_x_D_00001 1112 +FabOnDisk: Diag_x_D_00003 0 +FabOnDisk: Diag_x_D_00003 1114 +FabOnDisk: Diag_x_D_00001 2225 +FabOnDisk: Diag_x_D_00001 3338 +FabOnDisk: Diag_x_D_00003 2228 +FabOnDisk: Diag_x_D_00003 3343 +FabOnDisk: Diag_x_D_00005 0 +FabOnDisk: Diag_x_D_00005 1114 +FabOnDisk: Diag_x_D_00007 0 +FabOnDisk: Diag_x_D_00007 1116 +FabOnDisk: Diag_x_D_00005 2229 +FabOnDisk: Diag_x_D_00005 3343 +FabOnDisk: Diag_x_D_00007 2232 +FabOnDisk: Diag_x_D_00007 3348 + +16,2 +5.4930551640484364e+03,1.1571873809708726e+00, +3.1172217133825893e+03,1.1575306059109451e+00, +3.3604478920652809e+03,1.1575346794349017e+00, +6.3093914805103632e+03,1.1573741513926856e+00, +8.2305591921603136e+03,1.1571182429437825e+00, +4.2602572368271840e+03,1.1571630221902789e+00, +4.2286483956729853e+03,1.1573570721478719e+00, +4.7196200958825530e+03,1.1573595643008716e+00, +4.7209671794835522e+03,1.1572198643065241e+00, +6.5865580914206375e+03,1.1569070315278143e+00, +4.5975877955975166e+03,1.1570002351380535e+00, +4.6339902935008540e+03,1.1573750277470221e+00, +4.6935893312345206e+03,1.1574077749811380e+00, +3.3438428143231690e+03,1.1572211625455049e+00, +3.5327734049925789e+03,1.1572221582728885e+00, +4.4237720305766088e+03,1.1567774989760866e+00, + +16,2 +1.8793229159675258e+04,1.1577200962802874e+00, +1.1987094093223901e+04,1.1578011932579029e+00, +1.0968692220371904e+04,1.1577949143013189e+00, +2.4818255798192400e+04,1.1576901064035563e+00, +2.4004996782547474e+04,1.1576711337021877e+00, +2.2659279142698513e+04,1.1577600593710951e+00, +1.6379547344544841e+04,1.1577551670656621e+00, +1.5536021667274772e+04,1.1577515277366148e+00, +1.9372985041714284e+04,1.1577426409629368e+00, +3.3509254099589736e+04,1.1576791677325393e+00, +2.5209082278515452e+04,1.1577664232326208e+00, +1.3889866675376188e+04,1.1577505066364258e+00, +1.6351463634457756e+04,1.1577538809390759e+00, +2.2893590996331688e+04,1.1577958495450664e+00, +2.1936809132513692e+04,1.1577899891341745e+00, +3.1470476943172867e+04,1.1577566944817743e+00, + diff --git a/Util/SliceUtils/slice_00340/Diag_y_D_00002 b/Util/SliceUtils/slice_00340/Diag_y_D_00002 new file mode 100644 index 00000000..51bc5777 Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_y_D_00002 differ diff --git a/Util/SliceUtils/slice_00340/Diag_y_D_00003 b/Util/SliceUtils/slice_00340/Diag_y_D_00003 new file mode 100644 index 00000000..6a446427 Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_y_D_00003 differ diff --git a/Util/SliceUtils/slice_00340/Diag_y_D_00006 b/Util/SliceUtils/slice_00340/Diag_y_D_00006 new file mode 100644 index 00000000..4d3fd1f4 Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_y_D_00006 differ diff --git a/Util/SliceUtils/slice_00340/Diag_y_D_00007 b/Util/SliceUtils/slice_00340/Diag_y_D_00007 new file mode 100644 index 00000000..0c67b33f Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_y_D_00007 differ diff --git a/Util/SliceUtils/slice_00340/Diag_y_H b/Util/SliceUtils/slice_00340/Diag_y_H new file mode 100644 index 00000000..3a6bbe67 --- /dev/null +++ b/Util/SliceUtils/slice_00340/Diag_y_H @@ -0,0 +1,76 @@ +1 +1 +2 +0 +(16 0 +((0,16,0) (7,16,7) (0,0,0)) +((8,16,0) (15,16,7) (0,0,0)) +((16,16,0) (23,16,7) (0,0,0)) +((24,16,0) (31,16,7) (0,0,0)) +((0,16,8) (7,16,15) (0,0,0)) +((8,16,8) (15,16,15) (0,0,0)) +((16,16,8) (23,16,15) (0,0,0)) +((24,16,8) (31,16,15) (0,0,0)) +((0,16,16) (7,16,23) (0,0,0)) +((8,16,16) (15,16,23) (0,0,0)) +((16,16,16) (23,16,23) (0,0,0)) +((24,16,16) (31,16,23) (0,0,0)) +((0,16,24) (7,16,31) (0,0,0)) +((8,16,24) (15,16,31) (0,0,0)) +((16,16,24) (23,16,31) (0,0,0)) +((24,16,24) (31,16,31) (0,0,0)) +) +16 +FabOnDisk: Diag_y_D_00002 0 +FabOnDisk: Diag_y_D_00002 1112 +FabOnDisk: Diag_y_D_00003 0 +FabOnDisk: Diag_y_D_00003 1114 +FabOnDisk: Diag_y_D_00002 2225 +FabOnDisk: Diag_y_D_00002 3338 +FabOnDisk: Diag_y_D_00003 2228 +FabOnDisk: Diag_y_D_00003 3343 +FabOnDisk: Diag_y_D_00006 0 +FabOnDisk: Diag_y_D_00006 1114 +FabOnDisk: Diag_y_D_00007 0 +FabOnDisk: Diag_y_D_00007 1116 +FabOnDisk: Diag_y_D_00006 2229 +FabOnDisk: Diag_y_D_00006 3343 +FabOnDisk: Diag_y_D_00007 2232 +FabOnDisk: Diag_y_D_00007 3348 + +16,2 +3.2792825101187586e+03,1.1570008307933060e+00, +3.3092144377657196e+03,1.1576508964266408e+00, +3.3604478920652809e+03,1.1575318077632231e+00, +3.8233186217398679e+03,1.1572767512160695e+00, +5.7207693609871740e+03,1.1570048984514307e+00, +4.3142043147889635e+03,1.1573427105333609e+00, +4.4349233851452673e+03,1.1568386261972472e+00, +4.0490320307458028e+03,1.1572282996844647e+00, +6.6608957524941561e+03,1.1573507777416376e+00, +5.1271396881365454e+03,1.1571289693740552e+00, +7.9568533259167043e+03,1.1569909659466804e+00, +8.3341291493226763e+03,1.1573473101565785e+00, +3.1656414401233778e+03,1.1569851719182909e+00, +2.7850767621559107e+03,1.1571088968786343e+00, +3.4639263709068136e+03,1.1574186630336725e+00, +4.0136585644739075e+03,1.1572412616869288e+00, + +16,2 +3.3149755831112911e+04,1.1577962793321817e+00, +7.2133381685038084e+03,1.1577951075374675e+00, +1.3676897285085890e+04,1.1577949143013189e+00, +2.4821143515398024e+04,1.1577786170768296e+00, +2.7016716665451626e+04,1.1577158332709503e+00, +1.5038957286941333e+04,1.1577544751729887e+00, +3.6976050749886461e+04,1.1577551670656621e+00, +2.1449819550980745e+04,1.1577703455959287e+00, +1.5083143664889987e+04,1.1576743152361091e+00, +2.1982703093143813e+04,1.1577324107892251e+00, +4.0136338795256866e+04,1.1576541648911018e+00, +3.4676761916380165e+04,1.1577159451201486e+00, +2.3531949814174503e+04,1.1577972260162444e+00, +2.3508997823176960e+04,1.1578044421987930e+00, +2.1684037541045698e+04,1.1577899891341745e+00, +2.1413595984355037e+04,1.1577709628628663e+00, + diff --git a/Util/SliceUtils/slice_00340/Diag_z_D_00004 b/Util/SliceUtils/slice_00340/Diag_z_D_00004 new file mode 100644 index 00000000..0f45b0b3 Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_z_D_00004 differ diff --git a/Util/SliceUtils/slice_00340/Diag_z_D_00005 b/Util/SliceUtils/slice_00340/Diag_z_D_00005 new file mode 100644 index 00000000..1ccdb589 Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_z_D_00005 differ diff --git a/Util/SliceUtils/slice_00340/Diag_z_D_00006 b/Util/SliceUtils/slice_00340/Diag_z_D_00006 new file mode 100644 index 00000000..d5dd46d5 Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_z_D_00006 differ diff --git a/Util/SliceUtils/slice_00340/Diag_z_D_00007 b/Util/SliceUtils/slice_00340/Diag_z_D_00007 new file mode 100644 index 00000000..a2ab5089 Binary files /dev/null and b/Util/SliceUtils/slice_00340/Diag_z_D_00007 differ diff --git a/Util/SliceUtils/slice_00340/Diag_z_H b/Util/SliceUtils/slice_00340/Diag_z_H new file mode 100644 index 00000000..0b68a117 --- /dev/null +++ b/Util/SliceUtils/slice_00340/Diag_z_H @@ -0,0 +1,76 @@ +1 +1 +2 +0 +(16 0 +((0,0,16) (7,7,16) (0,0,0)) +((8,0,16) (15,7,16) (0,0,0)) +((16,0,16) (23,7,16) (0,0,0)) +((24,0,16) (31,7,16) (0,0,0)) +((0,8,16) (7,15,16) (0,0,0)) +((8,8,16) (15,15,16) (0,0,0)) +((16,8,16) (23,15,16) (0,0,0)) +((24,8,16) (31,15,16) (0,0,0)) +((0,16,16) (7,23,16) (0,0,0)) +((8,16,16) (15,23,16) (0,0,0)) +((16,16,16) (23,23,16) (0,0,0)) +((24,16,16) (31,23,16) (0,0,0)) +((0,24,16) (7,31,16) (0,0,0)) +((8,24,16) (15,31,16) (0,0,0)) +((16,24,16) (23,31,16) (0,0,0)) +((24,24,16) (31,31,16) (0,0,0)) +) +16 +FabOnDisk: Diag_z_D_00004 0 +FabOnDisk: Diag_z_D_00004 1112 +FabOnDisk: Diag_z_D_00005 0 +FabOnDisk: Diag_z_D_00005 1114 +FabOnDisk: Diag_z_D_00004 2225 +FabOnDisk: Diag_z_D_00004 3338 +FabOnDisk: Diag_z_D_00005 2228 +FabOnDisk: Diag_z_D_00005 3343 +FabOnDisk: Diag_z_D_00006 0 +FabOnDisk: Diag_z_D_00006 1114 +FabOnDisk: Diag_z_D_00007 0 +FabOnDisk: Diag_z_D_00007 1116 +FabOnDisk: Diag_z_D_00006 2229 +FabOnDisk: Diag_z_D_00006 3343 +FabOnDisk: Diag_z_D_00007 2232 +FabOnDisk: Diag_z_D_00007 3348 + +16,2 +4.1933723245842621e+03,1.1574569812459627e+00, +6.2588541826877354e+03,1.1572127889058177e+00, +4.7517571404308401e+03,1.1566505861523084e+00, +4.3232491157427012e+03,1.1574290925233222e+00, +8.6217487515868470e+03,1.1572597369630984e+00, +4.8678982521120888e+03,1.1571232120070059e+00, +8.7729486596545303e+03,1.1553951672921894e+00, +5.3108255366018757e+03,1.1572584663454690e+00, +3.8457681385318301e+03,1.1574231334644902e+00, +6.3334692982335073e+03,1.1572945502214882e+00, +5.1763984976872671e+03,1.1568120352057916e+00, +3.8294392687612904e+03,1.1575630827919881e+00, +3.0429283013789350e+03,1.1574266052684810e+00, +7.3448840380691199e+03,1.1570117758747822e+00, +4.4072087685240667e+03,1.1574097181828773e+00, +3.0401599141466081e+03,1.1576040897187476e+00, + +16,2 +1.2110730016437712e+04,1.1577659519985719e+00, +1.9314502622364093e+04,1.1576989645543938e+00, +4.4087797536884813e+04,1.1577410548022848e+00, +1.6897561832953790e+04,1.1577605012028558e+00, +1.6825391234142149e+04,1.1576287953653519e+00, +2.3900435802811066e+04,1.1577458607202011e+00, +9.5612889023988115e+04,1.1576568631762922e+00, +4.7345413005371141e+04,1.1577149917429379e+00, +1.2815510182008153e+04,1.1577799870320609e+00, +1.9481902423667991e+04,1.1576904714641854e+00, +3.5697193515039282e+04,1.1577716201990265e+00, +1.0594116839272448e+04,1.1577799019948465e+00, +1.5487879101365374e+04,1.1578052322925292e+00, +3.6288198514105687e+04,1.1576836752140174e+00, +1.6971849925171296e+04,1.1577760717475332e+00, +9.5263415610756929e+03,1.1578051416820965e+00, + diff --git a/Util/SliceUtils/slice_00340/State_x_D_00001 b/Util/SliceUtils/slice_00340/State_x_D_00001 new file mode 100644 index 00000000..c0c5f756 Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_x_D_00001 differ diff --git a/Util/SliceUtils/slice_00340/State_x_D_00003 b/Util/SliceUtils/slice_00340/State_x_D_00003 new file mode 100644 index 00000000..32bb43c1 Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_x_D_00003 differ diff --git a/Util/SliceUtils/slice_00340/State_x_D_00005 b/Util/SliceUtils/slice_00340/State_x_D_00005 new file mode 100644 index 00000000..a57fd45d Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_x_D_00005 differ diff --git a/Util/SliceUtils/slice_00340/State_x_D_00007 b/Util/SliceUtils/slice_00340/State_x_D_00007 new file mode 100644 index 00000000..7237befb Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_x_D_00007 differ diff --git a/Util/SliceUtils/slice_00340/State_x_H b/Util/SliceUtils/slice_00340/State_x_H new file mode 100644 index 00000000..e109d12b --- /dev/null +++ b/Util/SliceUtils/slice_00340/State_x_H @@ -0,0 +1,76 @@ +1 +1 +6 +0 +(16 0 +((16,0,0) (16,7,7) (0,0,0)) +((16,8,0) (16,15,7) (0,0,0)) +((16,16,0) (16,23,7) (0,0,0)) +((16,24,0) (16,31,7) (0,0,0)) +((16,0,8) (16,7,15) (0,0,0)) +((16,8,8) (16,15,15) (0,0,0)) +((16,16,8) (16,23,15) (0,0,0)) +((16,24,8) (16,31,15) (0,0,0)) +((16,0,16) (16,7,23) (0,0,0)) +((16,8,16) (16,15,23) (0,0,0)) +((16,16,16) (16,23,23) (0,0,0)) +((16,24,16) (16,31,23) (0,0,0)) +((16,0,24) (16,7,31) (0,0,0)) +((16,8,24) (16,15,31) (0,0,0)) +((16,16,24) (16,23,31) (0,0,0)) +((16,24,24) (16,31,31) (0,0,0)) +) +16 +FabOnDisk: State_x_D_00001 0 +FabOnDisk: State_x_D_00001 3160 +FabOnDisk: State_x_D_00003 0 +FabOnDisk: State_x_D_00003 3162 +FabOnDisk: State_x_D_00001 6321 +FabOnDisk: State_x_D_00001 9482 +FabOnDisk: State_x_D_00003 6324 +FabOnDisk: State_x_D_00003 9487 +FabOnDisk: State_x_D_00005 0 +FabOnDisk: State_x_D_00005 3162 +FabOnDisk: State_x_D_00007 0 +FabOnDisk: State_x_D_00007 3164 +FabOnDisk: State_x_D_00005 6325 +FabOnDisk: State_x_D_00005 9487 +FabOnDisk: State_x_D_00007 6328 +FabOnDisk: State_x_D_00007 9492 + +16,6 +1.7402311479921231e+09,8.4112633671406143e+10,-3.3021213836473773e+11,-1.6778546924944446e+11,2.2814497907402593e+12,2.0118563239543506e+11, +6.4487856286591995e+08,1.9394208789319084e+10,-1.0841621899787021e+11,-4.8996685942172409e+10,3.9211525744580078e+11,4.2309453455462585e+10, +7.2135612730174339e+08,2.2115579434270367e+10,3.7837562577732620e+09,-1.9556449787211679e+11,4.9615979812311890e+11,5.1019650840676758e+10, +2.2345802859118752e+09,1.4214312627560730e+11,-2.0680784397074399e+11,-3.4534615118543756e+11,5.6029793272491650e+12,2.9672468614559668e+11, +2.9344684976455088e+09,1.2049959832562849e+11,-4.0187218114692924e+10,-2.4069239463956795e+10,3.6711582202797817e+12,5.1405707601016064e+11, +1.1358836955668168e+09,4.9272953710932228e+10,-3.2883603689273987e+11,4.5057240250800438e+10,2.0766574245852124e+12,1.0184823623953247e+11, +1.2084691782367773e+09,5.3595343550833961e+10,-2.6954481042354559e+11,1.9711075627252205e+10,1.7486653628373936e+12,1.0763144999350244e+11, +1.3154470970613725e+09,7.3025626429544861e+10,-9.1821258327536255e+10,-6.4604922273046150e+10,1.7997607490360461e+12,1.3381486990999951e+11, +1.3720118727726736e+09,5.7651965689331261e+10,3.2248457039443768e+10,-2.1821120612391052e+11,1.7032849177171726e+12,1.3632304950888501e+11, +2.4744013386777534e+09,6.5174260721868179e+10,-5.0120199841019409e+11,-9.6160651978820422e+11,5.3360007612482148e+12,3.4300139380071680e+11, +1.1443212804154446e+09,6.7490970174274727e+10,-8.1179268738709399e+11,-2.7014490542188394e+11,2.1933942560032781e+12,1.1072939091772437e+11, +1.2860386221759610e+09,4.1833293113249313e+10,-1.2318024445950639e+11,2.6922375228524165e+09,7.7667362183955457e+11,1.2555029464604175e+11, +1.2656140877847629e+09,9.4752411194970245e+10,-1.6521276818656360e+11,-2.5802960506611221e+11,3.5852892885051172e+12,1.2502274000160742e+11, +7.1230262888166964e+08,2.1329674605996033e+10,-1.8941152315065234e+11,-6.8612510906435339e+11,6.6057504013434180e+11,5.0130400520089233e+10, +7.8192023809286368e+08,2.3547937315176785e+10,-3.1476665502486691e+10,-3.0491736343049115e+11,7.9228570191944482e+11,5.8139042023305786e+10, +1.1932609908343225e+09,9.2258305834097534e+10,-3.6237437766758356e+11,-5.1627818800574939e+11,3.3969585817946016e+12,1.1109930758207275e+11, + +16,6 +1.6207305836994852e+10,7.7894497442117566e+11,3.1859456445298066e+09,1.7344895234287964e+11,2.7186377092665039e+13,6.4089200137654688e+12, +6.1132905026241159e+09,2.4022014799899185e+11,3.2991144214160242e+09,2.2252112844013086e+11,1.1061286187024373e+13,1.5421556793395742e+12, +5.6936306973913765e+09,2.3278384151891553e+11,2.1029186564842386e+11,3.9214142596623215e+10,1.2963491666277406e+13,1.3142688212632441e+12, +1.3807099646091057e+10,1.2772846870673667e+12,2.0212930946326770e+11,1.2024941361765532e+09,6.9848252923929516e+13,7.2108574944714766e+12, +2.1096170013803440e+10,1.3315907250886145e+12,4.9975029378983331e+11,5.1735933596310785e+11,6.2490400894784062e+13,1.0655269910995617e+13, +1.9086290980152565e+10,1.3130338183383743e+12,1.7461378188954449e+11,7.1781379091263782e+11,5.9239349182745773e+13,9.0998768239733125e+12, +1.1185123227008989e+10,6.6241969410355786e+11,3.1712345429269676e+10,3.4153878848341229e+11,2.8246675067677922e+13,3.8552117670521641e+12, +1.0738006562219652e+10,3.5026873169137195e+11,2.8868711143848456e+11,1.1548617917404221e+11,1.3690944773777035e+13,3.5105045264276074e+12, +1.5783110991700138e+10,7.7212814045867639e+11,2.9104477582690723e+11,9.6287761157593216e+10,2.8057558529838629e+13,6.4338077128557539e+12, +3.4019512562664589e+10,1.9471783786997065e+12,3.6999291941324707e+11,5.6547697621702319e+11,8.3187445225997750e+13,2.3983414315337891e+13, +2.5186045772673286e+10,1.3980419514137812e+12,-1.4736137212669683e+09,4.6156247098073804e+11,6.5722458597953703e+13,1.3358364518794789e+13, +9.6603583368980122e+09,4.8178205975734906e+11,1.6575938692302170e+11,9.6510798603568420e+10,1.6665744083763957e+13,2.8235817773410938e+12, +9.8395484737481346e+09,4.8326370463138422e+11,1.0264484276519225e+11,-4.3269712624223347e+09,1.7661262298617090e+13,3.3857099302841992e+12, +1.6082382798983793e+10,7.0049811027261182e+11,1.6510569667663916e+11,-2.0233213464529972e+10,3.8024008907128266e+13,7.5955006450851406e+12, +1.6294587897457928e+10,6.2998515921664673e+11,4.9479903375690479e+11,1.9458826814898209e+11,2.7238214716373645e+13,7.5214677056716133e+12, +3.6872627422259178e+10,2.0181237780294709e+12,6.6196444878252185e+11,3.3250230373934100e+11,8.3670142028236578e+13,2.4411834175371625e+13, + diff --git a/Util/SliceUtils/slice_00340/State_y_D_00002 b/Util/SliceUtils/slice_00340/State_y_D_00002 new file mode 100644 index 00000000..4f87abf2 Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_y_D_00002 differ diff --git a/Util/SliceUtils/slice_00340/State_y_D_00003 b/Util/SliceUtils/slice_00340/State_y_D_00003 new file mode 100644 index 00000000..e21f403c Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_y_D_00003 differ diff --git a/Util/SliceUtils/slice_00340/State_y_D_00006 b/Util/SliceUtils/slice_00340/State_y_D_00006 new file mode 100644 index 00000000..3d402692 Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_y_D_00006 differ diff --git a/Util/SliceUtils/slice_00340/State_y_D_00007 b/Util/SliceUtils/slice_00340/State_y_D_00007 new file mode 100644 index 00000000..acbf1e5e Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_y_D_00007 differ diff --git a/Util/SliceUtils/slice_00340/State_y_H b/Util/SliceUtils/slice_00340/State_y_H new file mode 100644 index 00000000..e69e647d --- /dev/null +++ b/Util/SliceUtils/slice_00340/State_y_H @@ -0,0 +1,76 @@ +1 +1 +6 +0 +(16 0 +((0,16,0) (7,16,7) (0,0,0)) +((8,16,0) (15,16,7) (0,0,0)) +((16,16,0) (23,16,7) (0,0,0)) +((24,16,0) (31,16,7) (0,0,0)) +((0,16,8) (7,16,15) (0,0,0)) +((8,16,8) (15,16,15) (0,0,0)) +((16,16,8) (23,16,15) (0,0,0)) +((24,16,8) (31,16,15) (0,0,0)) +((0,16,16) (7,16,23) (0,0,0)) +((8,16,16) (15,16,23) (0,0,0)) +((16,16,16) (23,16,23) (0,0,0)) +((24,16,16) (31,16,23) (0,0,0)) +((0,16,24) (7,16,31) (0,0,0)) +((8,16,24) (15,16,31) (0,0,0)) +((16,16,24) (23,16,31) (0,0,0)) +((24,16,24) (31,16,31) (0,0,0)) +) +16 +FabOnDisk: State_y_D_00002 0 +FabOnDisk: State_y_D_00002 3160 +FabOnDisk: State_y_D_00003 0 +FabOnDisk: State_y_D_00003 3162 +FabOnDisk: State_y_D_00002 6321 +FabOnDisk: State_y_D_00002 9482 +FabOnDisk: State_y_D_00003 6324 +FabOnDisk: State_y_D_00003 9487 +FabOnDisk: State_y_D_00006 0 +FabOnDisk: State_y_D_00006 3162 +FabOnDisk: State_y_D_00007 0 +FabOnDisk: State_y_D_00007 3164 +FabOnDisk: State_y_D_00006 6325 +FabOnDisk: State_y_D_00006 9487 +FabOnDisk: State_y_D_00007 6328 +FabOnDisk: State_y_D_00007 9492 + +16,6 +7.0031105166047728e+08,-9.2096797064904272e+11,7.8799606060853748e+09,-2.2549257920183960e+11,3.5190392153314069e+11,4.8334882740067078e+10, +7.1283612906111419e+08,-3.6993643011137810e+10,3.4129669791464844e+09,-2.8228240777956196e+10,1.4661336022814636e+11,4.9648398335114868e+10, +7.2135612730174339e+08,-2.5314340094034954e+10,-5.6039288532823517e+10,-8.5621505972112396e+10,4.9615979812311890e+11,5.1019650840676758e+10, +9.1256668375003970e+08,-3.2485542244487866e+11,-7.9078652906172684e+10,-2.4663681780760458e+11,1.4681734812072446e+11,7.3433212639950424e+10, +1.8434114866979570e+09,-7.3491128211011963e+11,-1.3040028716828896e+11,-4.4720978841498120e+11,5.0797146221230328e+11,2.2194825282076355e+11, +1.1928127881494441e+09,-6.2847189956238800e+10,-1.9003445989868243e+11,4.1543824808300430e+10,1.0205327424947264e+12,1.0830680262547803e+11, +1.2084691782367773e+09,-3.8494463870452759e+11,-1.0225537552026127e+12,4.5820084144722755e+10,2.1700375286947542e+12,1.1279882452910620e+11, +1.0148218131951584e+09,-3.4584122012111743e+11,-2.9011509939877911e+11,-2.3576331711173514e+11,2.4926434255412112e+11,8.6482219543182892e+10, +2.4952349518677330e+09,-2.0106483004860623e+11,-3.7012119173986078e+11,-3.6112493415242696e+09,1.4126271452105635e+12,3.4979311482767834e+11, +1.5457600061356585e+09,1.8227167324468288e+10,-6.8705806398958521e+11,-1.7057427757992349e+11,1.3344677200903547e+12,1.6679985616688428e+11, +3.4658910634016538e+09,-1.9239031304535922e+11,-1.4611042599682114e+12,-8.8798029981423108e+11,6.9187720941599912e+12,5.8038132339211914e+11, +3.1131821891841998e+09,-4.9160573126481982e+11,-8.7314046683955676e+11,-5.1803473421867139e+11,4.2002984478891821e+12,5.7096222387714258e+11, +7.0455971692275202e+08,-1.8352402169137195e+11,-5.0766402560468610e+11,-3.4712508298571680e+11,3.9962929232833246e+11,4.6942890645735779e+10, +6.1197201904698551e+08,-2.3029353966388577e+10,-4.7392537461685480e+11,-3.3965972772583441e+11,4.0171237857643719e+11,3.5872376139249817e+10, +7.8192023809286368e+08,-9.3436169444524040e+09,-1.6193376830407529e+11,-5.6222232573369409e+11,7.9228570191944482e+11,5.8139042023305786e+10, +1.0040311714888414e+09,-3.8225223225345868e+11,-2.7474828794763300e+11,-4.9880272109144153e+11,6.1264088673578113e+11,8.4815174949317322e+10, + +16,6 +3.0018735277456322e+10,-1.3548794607568583e+10,7.5954812515048596e+11,1.1067740972061200e+11,4.4519863246910164e+13,2.0457108095767957e+13, +2.9106340535122523e+09,4.1244621626088371e+10,2.5185813998124638e+10,6.3085418264653389e+10,1.4695803566921064e+12,4.4186187033847400e+11, +6.4151608560575523e+09,1.3729427987723976e+11,2.6793673881796280e+10,2.8659868312865521e+11,8.8359478518734492e+12,1.8464486552753213e+12, +1.4614131558688122e+10,9.2366890430332657e+10,3.5451212443884821e+11,6.5547809999462868e+10,1.3688124623247879e+13,7.6331252058062441e+12, +2.6108742739670918e+10,2.7608611611397350e+10,3.3488473389350861e+11,1.5276793434743945e+11,2.9802818023271113e+13,1.4689573012833371e+13, +1.0835764940493595e+10,3.4773641208123743e+11,2.3793995552159576e+10,2.4125748517319650e+11,1.9957282487782922e+13,3.4290994627892764e+12, +3.8697701435531189e+10,9.7481729696236816e+11,2.1014601649552429e+10,1.6979054279330974e+12,7.3716077482786531e+13,3.0103181514458656e+13, +1.5570323348942865e+10,-9.5403058861500282e+09,1.4888297914302188e+11,2.4530006309485239e+11,1.6198290358647836e+13,7.0276587095089121e+12, +1.0697610984173067e+10,1.1841836426029803e+11,-2.9568420056417957e+10,1.4745188042877887e+11,1.2874572276999299e+13,3.3953380169556377e+12, +1.9567705377597626e+10,1.2043696175195886e+12,-4.2067782888231087e+10,3.5353338307450024e+11,5.8581466654156125e+13,9.0507019808365234e+12, +2.7762114807252014e+10,1.3980419514137812e+12,-4.1396032505833946e+10,4.6156247098073804e+11,7.5608422951837484e+13,2.2492300830881336e+13, +1.6862645076767361e+10,-1.1845280029198903e+11,-4.0859467546439545e+10,1.4580028488285767e+11,4.8109590288704008e+13,1.1491501086791617e+13, +2.4415093126769146e+10,1.6026888844872711e+11,3.3542291669992924e+10,5.4832128712902809e+10,1.8493896499726543e+13,1.2087866056789900e+13, +2.1044663789352859e+10,1.2545547042204118e+11,2.7267218132242161e+10,5.4957216529435463e+09,1.6878395346168270e+13,1.0409586512608090e+13, +1.2003599419824224e+10,2.1813204540677252e+11,3.4173942173489861e+10,-2.2287934892215954e+10,1.9739879975555789e+13,5.4773333812951230e+12, +1.4817179873145479e+10,1.9993572897309500e+11,2.6147915951993027e+10,-6.3651178501208935e+09,2.0223500866046301e+13,5.9860860323397266e+12, + diff --git a/Util/SliceUtils/slice_00340/State_z_D_00004 b/Util/SliceUtils/slice_00340/State_z_D_00004 new file mode 100644 index 00000000..0bc4ec5f Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_z_D_00004 differ diff --git a/Util/SliceUtils/slice_00340/State_z_D_00005 b/Util/SliceUtils/slice_00340/State_z_D_00005 new file mode 100644 index 00000000..93ca8614 Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_z_D_00005 differ diff --git a/Util/SliceUtils/slice_00340/State_z_D_00006 b/Util/SliceUtils/slice_00340/State_z_D_00006 new file mode 100644 index 00000000..1d9e784f Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_z_D_00006 differ diff --git a/Util/SliceUtils/slice_00340/State_z_D_00007 b/Util/SliceUtils/slice_00340/State_z_D_00007 new file mode 100644 index 00000000..1c8eabc9 Binary files /dev/null and b/Util/SliceUtils/slice_00340/State_z_D_00007 differ diff --git a/Util/SliceUtils/slice_00340/State_z_H b/Util/SliceUtils/slice_00340/State_z_H new file mode 100644 index 00000000..b75a4767 --- /dev/null +++ b/Util/SliceUtils/slice_00340/State_z_H @@ -0,0 +1,76 @@ +1 +1 +6 +0 +(16 0 +((0,0,16) (7,7,16) (0,0,0)) +((8,0,16) (15,7,16) (0,0,0)) +((16,0,16) (23,7,16) (0,0,0)) +((24,0,16) (31,7,16) (0,0,0)) +((0,8,16) (7,15,16) (0,0,0)) +((8,8,16) (15,15,16) (0,0,0)) +((16,8,16) (23,15,16) (0,0,0)) +((24,8,16) (31,15,16) (0,0,0)) +((0,16,16) (7,23,16) (0,0,0)) +((8,16,16) (15,23,16) (0,0,0)) +((16,16,16) (23,23,16) (0,0,0)) +((24,16,16) (31,23,16) (0,0,0)) +((0,24,16) (7,31,16) (0,0,0)) +((8,24,16) (15,31,16) (0,0,0)) +((16,24,16) (23,31,16) (0,0,0)) +((24,24,16) (31,31,16) (0,0,0)) +) +16 +FabOnDisk: State_z_D_00004 0 +FabOnDisk: State_z_D_00004 3160 +FabOnDisk: State_z_D_00005 0 +FabOnDisk: State_z_D_00005 3162 +FabOnDisk: State_z_D_00004 6321 +FabOnDisk: State_z_D_00004 9482 +FabOnDisk: State_z_D_00005 6324 +FabOnDisk: State_z_D_00005 9487 +FabOnDisk: State_z_D_00006 0 +FabOnDisk: State_z_D_00006 3162 +FabOnDisk: State_z_D_00007 0 +FabOnDisk: State_z_D_00007 3164 +FabOnDisk: State_z_D_00006 6325 +FabOnDisk: State_z_D_00006 9487 +FabOnDisk: State_z_D_00007 6328 +FabOnDisk: State_z_D_00007 9492 + +16,6 +1.0749663577788184e+09,-8.6952931021713409e+10,9.9837471576200652e+08,2.0912341923631691e+10,6.0432886527225244e+11,9.4873137996285400e+10, +2.1262929459353700e+09,4.7529337547017479e+10,-3.8192914198350098e+10,-2.5723869690733361e+09,2.0506250926960432e+12,2.8008502734260449e+11, +1.3990548541677501e+09,-1.1500958156478657e+12,3.2323655880801430e+10,-8.0221743169656097e+10,1.7032849177171726e+12,1.3991651105993506e+11, +1.1430376606338675e+09,-6.6273743438659314e+11,2.9919111007877773e+10,2.2535972985265373e+10,1.1063863790492346e+12,1.0400511791310693e+11, +3.7028831423252501e+09,-1.9915794577260211e+11,-1.6546914474427347e+11,8.8408814737774139e+10,2.2864910772704629e+12,7.0826998885932349e+11, +1.3869697040615013e+09,2.4437532046610962e+10,-4.7112768833728516e+11,4.2592522764640038e+10,1.4601291011221934e+12,1.4209839692393384e+11, +4.0145211096736302e+09,-3.4977853162849854e+12,-1.9958925513916897e+12,-8.5685017132233505e+10,6.0935703664948662e+12,7.4808222600535156e+11, +1.7519958275657070e+09,-2.3942941073488560e+12,-5.3612734872398865e+11,3.6380246081739288e+10,4.4923430098353311e+12,1.9582592000633838e+11, +9.0521776328873825e+08,-1.2909506042884720e+11,-2.5324473266969412e+11,8.8606517049263802e+09,2.6555756092127176e+11,7.3269606285548309e+10, +2.2912181231492829e+09,4.6426622540771500e+10,-5.1278667952824048e+11,1.7984700894674965e+10,1.1197422090010955e+12,3.0540591517080945e+11, +1.3740925734495833e+09,-2.1942151394273660e+11,-1.6656881881936558e+12,1.8886297663899818e+10,8.4430824585809790e+11,1.4970138511161829e+11, +9.0338957675460577e+08,-2.1701343261653519e+11,-3.2047276081944025e+11,8.6887567780756283e+09,4.1045957065449347e+11,7.2811158047672363e+10, +6.0651466653734934e+08,-2.4287872908822227e+10,-1.8506680899729965e+10,6.4916795186468067e+09,1.0377587644964545e+11,3.8844149923207901e+10, +2.5486075077912416e+09,4.9192013511785759e+10,-9.4426136022664139e+10,6.5254008273190641e+09,1.1426767557077524e+12,3.9396432267844104e+11, +1.0493962585724881e+09,-2.7304816489116342e+11,-1.5777023139268683e+11,6.4356970631218691e+09,2.7478148443497763e+11,9.7339581358022369e+10, +6.0677322646580923e+08,-1.7332067699948093e+11,-2.2416111209550411e+10,6.5621254914572916e+09,1.6972189858838983e+11,3.8825353193104294e+10, + +16,6 +7.4077193398585815e+09,1.0732349387754819e+11,1.1909439799936005e+11,1.8530985359034302e+11,5.1226075688071562e+12,1.8879035989353198e+12, +1.5916883227672319e+10,8.5436064537459021e+11,2.8337456241485083e+11,1.9427836748019870e+11,3.1426205979825590e+13,6.4687312472877578e+12, +5.2326180585350319e+10,7.7212814045867639e+11,1.7818923064692925e+12,8.7589886377495178e+11,9.5578761345163359e+13,4.8529496650856484e+13, +9.6825441693062935e+09,-3.1247290182834038e+10,3.0997073042894885e+11,2.8601231798245850e+11,3.5206865941147633e+13,3.3848221808929258e+12, +1.3472609253400259e+10,1.1776345649118735e+11,1.3337201834456267e+11,3.4238216368370557e+11,9.8847032999675273e+12,4.7698371590036562e+12, +2.0896256650154236e+10,1.2466743557804634e+12,1.4059046924632867e+11,5.0792320224612335e+11,5.9180803558589984e+13,1.0508348450617102e+13, +1.5304984884592789e+11,4.1342265078562090e+12,2.4682091808786562e+12,7.3989918073210361e+12,4.0879983866283156e+14,2.2730133986244478e+14, +2.7540900360025860e+10,-1.0286380720284161e+11,5.7404389623684155e+11,1.9283523382597883e+12,1.9847818701043147e+14,2.6893319098244781e+13, +8.2201547796063967e+09,1.1597701939347835e+11,-5.4309997047533073e+09,1.4745188042877887e+11,7.1621951312872383e+12,2.1872291154830566e+12, +1.4076704066044466e+10,8.6506309275355554e+11,3.3187339861052502e+10,3.5353338307450024e+11,4.6130615268650719e+13,5.7706637926893281e+12, +3.9055980707179810e+10,1.0055755486961969e+12,-3.1882194878736500e+10,7.9530247729367969e+11,7.8917756659263656e+13,2.9330625927589812e+13, +5.1214826055043192e+09,-1.5363183279653385e+10,-1.7278142790262634e+10,1.3837805729822241e+11,1.7883704422366965e+13,1.1418420598598379e+12, +9.1066217820490017e+09,3.4271466399662677e+11,1.6399262193757617e+11,3.4586901206001074e+11,1.6496974407336486e+13,2.9680472632495117e+12, +3.1566361565601830e+10,5.1224534057113098e+11,6.4141365944083276e+11,1.2374660873719297e+12,5.4747280828045375e+13,2.4100800158445191e+13, +1.0331008274722786e+10,2.2170831600208109e+11,5.6520219725312366e+11,2.9260559049886554e+11,2.5187130683193262e+13,3.6896713684115117e+12, +4.1774848334533272e+09,-1.0193318695539927e+10,1.4613526700372513e+11,1.1598575330289749e+11,9.9376279408366602e+12,8.3751880930134473e+11, + diff --git a/Util/SliceUtils/sliceutils.cpp b/Util/SliceUtils/sliceutils.cpp new file mode 100644 index 00000000..09fe6ea2 --- /dev/null +++ b/Util/SliceUtils/sliceutils.cpp @@ -0,0 +1,54 @@ +// --------------------------------------------------------------- +// sliceutils.cpp +// --------------------------------------------------------------- +#include +#include + +#include +#include +#include +#include + +using namespace amrex; + + +// --------------------------------------------------------------- +int main(int argc, char* argv[]) +{ + amrex::Initialize(argc, argv); + + MultiFab sliceMF; + + // ---- this example reads a multifab named State_x from the + // ---- directory slice_00340 and makes a plotfile named + // ---- plt_slice_00340 + + std::string plotfileName("plt_slice_00340"); + std::string sliceDirName("slice_00340"); + std::string sliceMFName(sliceDirName + "/State_x"); + int level_step(340); + + Vector varnames(6); + varnames[0] = "var0"; + varnames[1] = "var1"; + varnames[2] = "var2"; + varnames[3] = "var3"; + varnames[4] = "var4"; + varnames[5] = "var5"; + + amrex::VisMF::Read(sliceMF, sliceMFName); + + const BoxArray &ba = sliceMF.boxArray(); + Box smfDomain(ba.minimalBox()); + RealBox realDomain(0.0, 0.0, 0.0, 1.0, 1.0, 1.0); + Geometry geom(smfDomain, &realDomain); + Real sliceTime(123.4); + + amrex::WriteSingleLevelPlotfile(plotfileName, sliceMF, varnames, + geom, sliceTime, level_step); + + amrex::Finalize(); +} + +// --------------------------------------------------------------- +// --------------------------------------------------------------- diff --git a/Util/VODE_test/Makefile b/Util/VODE_test/Makefile new file mode 100644 index 00000000..853a8b55 --- /dev/null +++ b/Util/VODE_test/Makefile @@ -0,0 +1,53 @@ +all: fmain.exe fmain_vode.exe + + +# Set SUNDIALS_INSTALL as an environment variable for a sundials installation +# of a version older than 3.0 which has built cvode + +prefix = ${SUNDIALS_INSTALL} +exec_prefix = ${SUNDIALS_INSTALL} +includedir = ${SUNDIALS_INSTALL}/include +libdir = ${SUNDIALS_INSTALL}/lib + +F90 = /usr/bin/gfortran +F90FLAGS = -O0 -g +F90_LDFLAGS = -O0 -g +F90_LIBS = -lm /usr/lib/x86_64-linux-gnu/librt.so + +LINKFLAGS = -Wl,-rpath,${SUNDIALS_INSTALL}/lib + +EXAMPLES = constants_mod constants_cosmo comoving_params reion_aux_module comoving_nd cvode_interface meth_params misc_params vode_aux atomic_rates eos_hc eos_params fnvector_serial fcvode_extras f_rhs integrate_state_vode_3d ../BLAS/daxpy ../BLAS/ddot ../BLAS/dscal ../BLAS/idamax ../BLAS/dcopy ../VODE/dewset ../VODE/dgesl ../VODE/dvhin ../VODE/dvjac ../VODE/dvnlsd ../VODE/dvode ../VODE/dvsol ../VODE/dvstep ../VODE/ixsav ../VODE/xsetf ../VODE/dacopy ../VODE/dgbfa ../VODE/dgefa ../VODE/dumach ../VODE/dvindy ../VODE/dvjust ../VODE/dvnorm ../VODE/dvset ../VODE/dvsrco ../VODE/iumach ../VODE/xerrwd ../VODE/xsetun ../VODE/dgbsl + +OBJECTS = ${EXAMPLES:=.o} + +# ----------------------------------------------------------------------------------------- + +.SUFFIXES : .o .f90 .f + + %.o: %.mod + +.f90.o : + ${F90} ${F90FLAGS} ${INCLUDES} -c $< -o $(*F).o + +.f.o : + ${F90} ${F90FLAGS} ${INCLUDES} -c $< -o $(@D)/$(*F).o + +# ----------------------------------------------------------------------------------------- + +all: fmain_vode.exe fmain.exe + +fmain_vode.exe: ${OBJECTS} fmain_vode.o + ${F90} ${F90_LDFLAGS} -o fmain_vode.exe -I${includedir} ${OBJECTS} fmain_vode.o ${F90_LIBS} -L${libdir} -lsundials_fcvode -lsundials_cvode -lsundials_fcvode -lsundials_fnvecserial -lsundials_nvecserial + echo "${F90} ${F90_LDFLAGS} -o fmain_vode.exe -I${includedir} ${OBJECTS} fmain_vode.o ${F90_LIBS} -L${libdir} -lsundials_fcvode -lsundials_cvode -lsundials_fcvode -lsundials_fnvecserial -lsundials_nvecserial" + +fmain.exe: ${OBJECTS} fmain.o + ${F90} ${F90_LDFLAGS} -o fmain.exe -I${includedir} ${OBJECTS} fmain.o ${F90_LIBS} -L${libdir} -lsundials_fcvode -lsundials_cvode -lsundials_fcvode -lsundials_fnvecserial -lsundials_nvecserial + echo "${F90} ${F90_LDFLAGS} -o fmain_vode.exe -I${includedir} ${OBJECTS} fmain_vode.o ${F90_LIBS} -L${libdir} -lsundials_fcvode -lsundials_cvode -lsundials_fcvode -lsundials_fnvecserial -lsundials_nvecserial" + +clean: + rm -f ${OBJECTS} ${EXAMPLES:=.mod} + +realclean: + rm -f ${OBJECTS} ${EXAMPLES:=.mod} + rm -f *.mod *.o *.exe + diff --git a/Util/VODE_test/TREECOOL_middle b/Util/VODE_test/TREECOOL_middle new file mode 100644 index 00000000..c548b2ec --- /dev/null +++ b/Util/VODE_test/TREECOOL_middle @@ -0,0 +1,301 @@ +0.000000 5.700000e-14 3.100000e-14 1.121650e-16 3.560837e-25 4.486095e-25 5.008400e-27 +0.021189 7.131077e-14 3.942314e-14 1.290508e-16 4.465957e-25 5.631802e-25 5.728569e-27 +0.041393 8.817069e-14 4.881653e-14 1.564290e-16 5.546459e-25 6.943841e-25 6.874023e-27 +0.060698 1.080520e-13 6.036742e-14 1.892055e-16 6.806021e-25 8.499327e-25 8.214962e-27 +0.079181 1.313927e-13 7.381091e-14 2.281519e-16 8.287477e-25 1.030083e-24 9.775263e-27 +0.096910 1.574751e-13 8.920400e-14 2.740300e-16 9.950685e-25 1.237482e-24 1.157747e-26 +0.113943 1.870916e-13 1.066446e-13 3.274889e-16 1.184974e-24 1.471890e-24 1.363982e-26 +0.130334 2.201403e-13 1.260925e-13 3.893120e-16 1.397618e-24 1.732952e-24 1.598488e-26 +0.146128 2.558537e-13 1.472511e-13 4.603516e-16 1.627616e-24 2.017452e-24 1.863681e-26 +0.161368 2.977649e-13 1.718511e-13 5.410824e-16 1.893292e-24 2.347358e-24 2.160698e-26 +0.176091 3.428995e-13 1.987396e-13 6.320781e-16 2.183324e-24 2.708677e-24 2.490966e-26 +0.190332 3.912293e-13 2.276695e-13 7.337759e-16 2.493622e-24 3.095318e-24 2.855453e-26 +0.204120 4.463107e-13 2.603846e-13 8.467451e-16 2.838601e-24 3.523196e-24 3.255534e-26 +0.217484 5.046292e-13 2.943905e-13 9.710171e-16 3.208211e-24 3.984673e-24 3.690837e-26 +0.230449 5.642777e-13 3.291591e-13 1.106241e-15 3.588006e-24 4.460281e-24 4.159783e-26 +0.243038 6.309768e-13 3.700881e-13 1.252896e-15 4.013032e-24 4.994599e-24 4.663438e-26 +0.255273 7.003212e-13 4.118066e-13 1.409787e-15 4.451985e-24 5.544954e-24 5.197583e-26 +0.267172 7.734476e-13 4.548221e-13 1.577197e-15 4.911441e-24 6.119276e-24 5.762626e-26 +0.278754 8.509889e-13 5.012864e-13 1.753469e-15 5.402579e-24 6.737064e-24 6.352996e-26 +0.290035 9.292096e-13 5.484886e-13 1.937662e-15 5.899552e-24 7.363681e-24 6.965391e-26 +0.301030 1.014903e-12 6.006439e-13 2.128940e-15 6.455638e-24 8.031408e-24 7.596822e-26 +0.311754 1.100000e-12 6.524997e-13 2.325220e-15 7.009520e-24 8.691806e-24 8.240606e-26 +0.322219 1.122007e-12 6.649298e-13 2.524680e-15 7.152800e-24 8.855698e-24 8.890910e-26 +0.332438 1.137809e-12 6.737611e-13 2.725227e-15 7.256136e-24 8.971874e-24 9.541154e-26 +0.342423 1.145552e-12 6.779476e-13 2.924501e-15 7.292276e-24 9.018775e-24 1.018411e-25 +0.352183 1.154360e-12 6.828133e-13 3.119812e-15 7.336837e-24 9.075818e-24 1.081175e-25 +0.361728 1.162594e-12 6.880686e-13 3.308180e-15 7.389919e-24 9.129358e-24 1.141534e-25 +0.371068 1.173550e-12 6.950557e-13 3.486392e-15 7.462784e-24 9.205408e-24 1.198566e-25 +0.380211 1.187979e-12 7.039418e-13 3.651000e-15 7.551576e-24 9.306058e-24 1.251293e-25 +0.389166 1.198634e-12 7.104930e-13 3.797474e-15 7.612901e-24 9.375911e-24 1.298449e-25 +0.397940 1.207275e-12 7.158272e-13 3.924431e-15 7.664101e-24 9.427544e-24 1.339643e-25 +0.406540 1.213105e-12 7.194667e-13 4.033722e-15 7.705948e-24 9.444720e-24 1.375349e-25 +0.414973 1.216342e-12 7.215532e-13 4.127912e-15 7.730928e-24 9.444007e-24 1.406245e-25 +0.423246 1.219054e-12 7.229159e-13 4.207614e-15 7.750458e-24 9.437258e-24 1.432369e-25 +0.431364 1.219149e-12 7.226487e-13 4.274178e-15 7.752770e-24 9.411277e-24 1.454154e-25 +0.439333 1.221622e-12 7.238018e-13 4.326827e-15 7.768263e-24 9.401333e-24 1.471344e-25 +0.447158 1.218366e-12 7.215375e-13 4.364575e-15 7.740295e-24 9.333136e-24 1.483636e-25 +0.454845 1.222231e-12 7.235103e-13 4.388926e-15 7.757998e-24 9.322051e-24 1.491523e-25 +0.462398 1.220561e-12 7.219019e-13 4.397603e-15 7.745418e-24 9.272144e-24 1.494253e-25 +0.469822 1.209901e-12 7.148017e-13 4.393478e-15 7.678796e-24 9.156752e-24 1.492791e-25 +0.477121 1.199432e-12 7.078630e-13 4.374113e-15 7.613336e-24 9.044882e-24 1.486322e-25 +0.484300 1.193909e-12 7.040435e-13 4.342413e-15 7.575579e-24 8.958947e-24 1.475807e-25 +0.491362 1.190000e-12 7.012368e-13 4.297156e-15 7.547275e-24 8.883588e-24 1.460851e-25 +0.498311 1.178629e-12 6.940542e-13 4.239794e-15 7.471795e-24 8.754437e-24 1.441924e-25 +0.505150 1.160855e-12 6.828258e-13 4.171646e-15 7.359487e-24 8.569961e-24 1.419469e-25 +0.511883 1.150522e-12 6.759325e-13 4.091439e-15 7.295230e-24 8.440136e-24 1.393048e-25 +0.518514 1.136042e-12 6.666341e-13 4.002124e-15 7.204632e-24 8.281918e-24 1.363635e-25 +0.525045 1.123528e-12 6.584897e-13 3.904306e-15 7.121947e-24 8.137490e-24 1.331418e-25 +0.531479 1.115864e-12 6.531880e-13 3.797318e-15 7.067108e-24 8.027796e-24 1.296183e-25 +0.537819 1.095126e-12 6.402568e-13 3.683704e-15 6.929647e-24 7.825678e-24 1.258756e-25 +0.544068 1.072765e-12 6.264631e-13 3.564253e-15 6.785092e-24 7.612582e-24 1.219386e-25 +0.550228 1.061742e-12 6.193867e-13 3.439655e-15 6.716654e-24 7.478913e-24 1.178297e-25 +0.556303 1.046184e-12 6.096776e-13 3.310320e-15 6.619508e-24 7.314394e-24 1.135611e-25 +0.562293 1.036077e-12 6.031568e-13 3.177940e-15 6.556823e-24 7.189026e-24 1.091889e-25 +0.568202 1.022056e-12 5.945533e-13 3.043303e-15 6.470033e-24 7.035863e-24 1.047366e-25 +0.574031 1.005956e-12 5.847470e-13 2.907188e-15 6.370046e-24 6.869274e-24 1.002312e-25 +0.579784 9.912223e-13 5.757424e-13 2.770379e-15 6.278681e-24 6.712955e-24 9.569790e-26 +0.585461 9.680384e-13 5.618682e-13 2.633502e-15 6.132892e-24 6.504294e-24 9.115552e-26 +0.591065 9.544885e-13 5.536352e-13 2.497385e-15 6.046844e-24 6.366674e-24 8.663305e-26 +0.596597 9.306970e-13 5.394692e-13 2.362745e-15 5.895920e-24 6.161646e-24 8.215325e-26 +0.602060 9.143101e-13 5.296034e-13 2.230116e-15 5.791908e-24 6.006705e-24 7.773418e-26 +0.607455 8.991008e-13 5.202923e-13 6.307590e-16 5.694157e-24 5.863423e-24 3.786485e-26 +0.612784 8.823489e-13 5.100061e-13 3.181031e-16 5.585858e-24 5.712746e-24 2.016526e-26 +0.618048 8.751899e-13 5.052654e-13 2.134829e-16 5.538291e-24 5.624235e-24 1.429888e-26 +0.623249 8.637173e-13 4.980317e-13 1.608417e-16 5.463416e-24 5.507808e-24 1.139137e-26 +0.628389 8.528019e-13 4.915248e-13 1.289660e-16 5.396334e-24 5.407943e-24 1.052143e-26 +0.633468 8.428606e-13 4.856804e-13 1.037051e-16 5.336487e-24 5.317448e-24 9.806648e-27 +0.638489 8.382619e-13 4.829132e-13 8.621439e-17 5.310497e-24 5.260379e-24 8.760179e-27 +0.643453 8.336445e-13 4.801335e-13 7.325023e-17 5.284443e-24 5.202720e-24 8.019994e-27 +0.648360 8.267178e-13 4.759967e-13 6.313902e-17 5.244351e-24 5.141382e-24 7.475048e-27 +0.653213 8.196424e-13 4.717560e-13 5.492792e-17 5.203728e-24 5.086392e-24 6.126590e-27 +0.658011 8.135775e-13 4.680948e-13 5.019306e-17 5.169572e-24 5.037542e-24 5.049079e-27 +0.662758 8.065499e-13 4.638777e-13 4.592255e-17 5.129351e-24 4.982595e-24 4.934280e-27 +0.667453 8.027916e-13 4.615450e-13 4.201102e-17 5.109119e-24 4.948612e-24 4.841405e-27 +0.672098 7.961321e-13 4.575691e-13 3.837703e-17 5.066971e-24 4.900394e-24 4.766620e-27 +0.676694 7.886928e-13 4.531439e-13 3.495599e-17 5.019863e-24 4.847315e-24 3.977646e-27 +0.681241 7.815721e-13 4.489005e-13 3.301013e-17 4.974785e-24 4.796134e-24 3.250959e-27 +0.685742 7.747680e-13 4.448374e-13 3.108054e-17 4.931723e-24 4.746826e-24 3.256814e-27 +0.690196 7.690636e-13 4.415922e-13 2.915607e-17 4.898378e-24 4.709738e-24 3.265612e-27 +0.694605 7.642091e-13 4.389615e-13 2.722633e-17 4.872297e-24 4.681562e-24 3.277108e-27 +0.698970 7.569034e-13 4.349242e-13 2.528152e-17 4.830632e-24 4.638383e-24 2.779312e-27 +0.703291 7.496390e-13 4.309116e-13 2.415028e-17 4.789259e-24 4.595466e-24 2.292495e-27 +0.707570 7.426188e-13 4.270404e-13 2.297740e-17 4.749480e-24 4.554057e-24 2.318147e-27 +0.711807 7.358775e-13 4.234541e-13 2.175971e-17 4.710133e-24 4.516890e-24 2.344472e-27 +0.716003 7.254846e-13 4.177967e-13 2.049395e-17 4.647062e-24 4.457929e-24 2.371451e-27 +0.720159 7.152903e-13 4.122517e-13 1.917677e-17 4.585242e-24 4.400158e-24 2.060401e-27 +0.724276 7.051901e-13 4.067590e-13 1.834401e-17 4.524005e-24 4.342938e-24 1.747728e-27 +0.728354 6.953706e-13 4.014265e-13 1.746429e-17 4.464550e-24 4.287421e-24 1.774039e-27 +0.732394 6.824911e-13 3.941022e-13 1.653568e-17 4.386103e-24 4.210623e-24 1.800666e-27 +0.736397 6.764605e-13 3.906762e-13 1.555619e-17 4.351803e-24 4.175464e-24 1.827609e-27 +0.740363 6.671800e-13 3.853730e-13 1.452373e-17 4.296577e-24 4.120238e-24 1.582864e-27 +0.744293 6.580179e-13 3.801378e-13 1.387060e-17 4.242072e-24 4.065723e-24 1.333318e-27 +0.748188 6.544022e-13 3.781067e-13 1.317574e-17 4.223321e-24 4.045477e-24 1.355995e-27 +0.752048 6.481107e-13 3.742073e-13 1.243778e-17 4.185266e-24 4.006934e-24 1.378892e-27 +0.755875 6.441856e-13 3.714595e-13 1.165528e-17 4.161120e-24 3.981845e-24 1.402009e-27 +0.759668 6.390398e-13 3.680078e-13 1.082679e-17 4.129089e-24 3.949210e-24 1.255493e-27 +0.763428 6.353209e-13 3.653779e-13 1.022687e-17 4.106278e-24 3.925395e-24 1.104912e-27 +0.767156 6.297119e-13 3.616611e-13 9.589602e-18 4.071249e-24 3.889899e-24 1.124369e-27 +0.770852 6.265970e-13 3.595083e-13 8.913869e-18 4.052667e-24 3.870932e-24 1.144009e-27 +0.774517 6.224705e-13 3.573013e-13 8.198515e-18 4.028825e-24 3.850199e-24 1.163833e-27 +0.778151 6.193681e-13 3.556826e-13 7.442358e-18 4.011619e-24 3.835816e-24 1.005099e-27 +0.781755 6.051062e-13 3.476532e-13 6.941549e-18 3.922097e-24 3.752257e-24 8.413854e-28 +0.785330 5.877877e-13 3.378617e-13 6.410901e-18 3.812656e-24 3.649568e-24 8.565593e-28 +0.788875 5.676714e-13 3.264544e-13 5.849590e-18 3.684930e-24 3.529277e-24 8.718795e-28 +0.792392 5.495041e-13 3.167119e-13 5.256778e-18 3.571577e-24 3.427850e-24 8.873461e-28 +0.795880 5.363643e-13 3.106727e-13 4.631610e-18 3.493560e-24 3.367904e-24 7.118943e-28 +0.799341 5.169618e-13 3.009645e-13 4.299132e-18 3.374552e-24 3.268043e-24 5.304775e-28 +0.802774 4.995822e-13 2.923781e-13 3.947483e-18 3.268479e-24 3.180164e-24 5.402246e-28 +0.806180 4.877927e-13 2.870282e-13 3.576173e-18 3.198812e-24 3.127367e-24 5.500706e-28 +0.809560 4.759080e-13 2.816036e-13 3.184706e-18 3.128429e-24 3.073691e-24 5.600157e-28 +0.812913 4.623742e-13 2.752620e-13 2.772580e-18 3.047217e-24 3.011775e-24 4.368394e-28 +0.816241 4.520541e-13 2.711678e-13 2.571902e-18 2.987705e-24 2.981882e-24 3.092253e-28 +0.819544 4.443370e-13 2.686641e-13 2.360065e-18 2.945518e-24 2.969691e-24 3.148907e-28 +0.822822 4.345795e-13 2.649609e-13 2.136800e-18 2.889947e-24 2.944484e-24 3.206155e-28 +0.826075 4.272450e-13 2.627744e-13 1.901832e-18 2.850653e-24 2.936413e-24 3.263997e-28 +0.829304 4.200690e-13 2.607429e-13 1.654885e-18 2.812654e-24 2.930479e-24 2.576582e-28 +0.832509 4.130429e-13 2.588692e-13 1.528682e-18 2.775929e-24 2.926771e-24 1.863881e-28 +0.835691 4.062667e-13 2.568159e-13 1.395797e-18 2.739122e-24 2.916111e-24 1.897383e-28 +0.838849 3.995945e-13 2.547881e-13 1.256074e-18 2.702749e-24 2.904734e-24 1.931235e-28 +0.841985 3.930652e-13 2.529187e-13 1.109356e-18 2.667606e-24 2.895517e-24 1.965440e-28 +0.845098 3.847176e-13 2.499429e-13 9.554854e-19 2.620375e-24 2.873967e-24 1.518516e-28 +0.848189 3.667928e-13 2.407400e-13 8.818350e-19 2.507890e-24 2.780786e-24 1.055345e-28 +0.851258 3.528143e-13 2.340834e-13 8.044452e-19 2.422216e-24 2.716796e-24 1.073845e-28 +0.854306 3.393126e-13 2.275320e-13 7.232325e-19 2.338935e-24 2.654234e-24 1.092536e-28 +0.857332 3.274144e-13 2.212584e-13 6.381125e-19 2.263375e-24 2.596005e-24 1.111419e-28 +0.860338 3.155981e-13 2.150280e-13 5.490001e-19 2.188337e-24 2.538177e-24 8.680585e-29 +0.863323 3.038634e-13 2.088406e-13 5.043857e-19 2.113816e-24 2.480749e-24 6.160051e-29 +0.866287 2.922076e-13 2.026948e-13 4.576116e-19 2.039797e-24 2.423706e-24 6.264938e-29 +0.869232 2.806318e-13 1.965913e-13 4.086313e-19 1.966287e-24 2.367056e-24 6.370885e-29 +0.872156 2.691342e-13 1.905289e-13 3.573978e-19 1.893271e-24 2.310788e-24 6.477896e-29 +0.875061 2.581002e-13 1.846475e-13 3.038639e-19 1.822827e-24 2.254911e-24 4.829715e-29 +0.877947 2.486829e-13 1.793655e-13 2.810482e-19 1.761161e-24 2.199478e-24 3.124579e-29 +0.880814 2.393272e-13 1.741182e-13 2.571572e-19 1.699900e-24 2.144408e-24 3.176211e-29 +0.883661 2.300330e-13 1.689053e-13 2.321684e-19 1.639041e-24 2.089699e-24 3.228351e-29 +0.886491 2.207996e-13 1.637267e-13 2.060592e-19 1.578580e-24 2.035351e-24 3.281002e-29 +0.889302 2.116261e-13 1.585815e-13 1.788069e-19 1.518513e-24 1.981352e-24 2.619701e-29 +0.892095 2.025115e-13 1.534694e-13 1.640604e-19 1.458830e-24 1.927701e-24 1.935953e-29 +0.894870 1.934552e-13 1.483901e-13 1.486533e-19 1.399530e-24 1.874395e-24 1.966965e-29 +0.897627 1.860132e-13 1.437805e-13 1.325724e-19 1.349538e-24 1.824350e-24 1.998274e-29 +0.900367 1.790063e-13 1.393093e-13 1.158044e-19 1.302091e-24 1.775350e-24 2.029880e-29 +0.903090 1.720436e-13 1.348662e-13 9.833555e-20 1.254941e-24 1.726661e-24 2.061784e-29 +0.905796 1.651244e-13 1.304507e-13 8.015240e-20 1.208085e-24 1.678274e-24 2.093989e-29 +0.908485 1.582476e-13 1.260626e-13 6.124118e-20 1.161519e-24 1.630186e-24 2.126493e-29 +0.911158 1.514133e-13 1.217015e-13 4.158803e-20 1.115240e-24 1.582395e-24 2.159299e-29 +0.913814 1.446210e-13 1.173673e-13 2.117900e-20 1.069246e-24 1.534897e-24 2.192407e-29 +0.916454 1.378694e-13 1.130588e-13 0.000000e+00 1.023525e-24 1.487683e-24 0.000000e+00 +0.919078 1.326935e-13 1.093997e-13 0.000000e+00 9.870744e-25 1.444549e-24 0.000000e+00 +0.921686 1.275485e-13 1.057624e-13 0.000000e+00 9.508408e-25 1.401672e-24 0.000000e+00 +0.924279 1.224342e-13 1.021468e-13 0.000000e+00 9.148230e-25 1.359051e-24 0.000000e+00 +0.926857 1.173502e-13 9.855261e-14 0.000000e+00 8.790185e-25 1.316683e-24 0.000000e+00 +0.929419 1.122961e-13 9.497961e-14 0.000000e+00 8.434253e-25 1.274565e-24 0.000000e+00 +0.931966 1.072719e-13 9.142766e-14 0.000000e+00 8.080418e-25 1.232694e-24 0.000000e+00 +0.934498 1.022771e-13 8.789657e-14 0.000000e+00 7.728660e-25 1.191069e-24 0.000000e+00 +0.937016 9.731088e-14 8.438562e-14 0.000000e+00 7.378909e-25 1.149682e-24 0.000000e+00 +0.939519 9.371704e-14 8.160445e-14 0.000000e+00 7.115605e-25 1.114961e-24 0.000000e+00 +0.942008 9.014364e-14 7.883910e-14 0.000000e+00 6.853799e-25 1.080437e-24 0.000000e+00 +0.944483 8.659053e-14 7.608948e-14 0.000000e+00 6.593480e-25 1.046108e-24 0.000000e+00 +0.946943 8.305762e-14 7.335546e-14 0.000000e+00 6.334640e-25 1.011975e-24 0.000000e+00 +0.949390 7.954452e-14 7.063678e-14 0.000000e+00 6.077250e-25 9.780345e-25 0.000000e+00 +0.951823 7.605111e-14 6.793334e-14 0.000000e+00 5.821304e-25 9.442834e-25 0.000000e+00 +0.954243 7.257733e-14 6.524508e-14 0.000000e+00 5.566797e-25 9.107219e-25 0.000000e+00 +0.956649 6.912279e-14 6.257172e-14 0.000000e+00 5.313699e-25 8.773464e-25 0.000000e+00 +0.959041 6.628733e-14 6.031097e-14 0.000000e+00 5.105714e-25 8.483019e-25 0.000000e+00 +0.961421 6.386646e-14 5.832717e-14 0.000000e+00 4.927940e-25 8.221747e-25 0.000000e+00 +0.963788 6.145870e-14 5.635417e-14 0.000000e+00 4.751132e-25 7.961892e-25 0.000000e+00 +0.966142 5.906407e-14 5.439189e-14 0.000000e+00 4.575287e-25 7.703451e-25 0.000000e+00 +0.968483 5.668231e-14 5.244018e-14 0.000000e+00 4.400386e-25 7.446403e-25 0.000000e+00 +0.970812 3.834510e-14 4.402700e-14 0.000000e+00 2.595247e-25 0.000000e+00 0.000000e+00 +0.973128 4.188557e-15 4.802124e-15 0.000000e+00 6.018460e-26 0.000000e+00 0.000000e+00 +0.975432 1.865695e-15 2.134670e-15 0.000000e+00 3.180310e-26 0.000000e+00 0.000000e+00 +0.977724 1.174019e-15 1.340458e-15 0.000000e+00 2.064471e-26 0.000000e+00 0.000000e+00 +0.980003 8.471102e-16 9.651459e-16 0.000000e+00 1.519086e-26 0.000000e+00 0.000000e+00 +0.982271 6.565596e-16 7.464321e-16 0.000000e+00 1.200737e-26 0.000000e+00 0.000000e+00 +0.984527 5.315749e-16 6.030196e-16 0.000000e+00 9.923108e-27 0.000000e+00 0.000000e+00 +0.986772 4.431324e-16 5.015781e-16 0.000000e+00 8.451805e-27 0.000000e+00 0.000000e+00 +0.989005 3.771366e-16 4.259206e-16 0.000000e+00 7.356993e-27 0.000000e+00 0.000000e+00 +0.991226 3.259163e-16 3.672376e-16 0.000000e+00 6.509960e-27 0.000000e+00 0.000000e+00 +0.993436 2.849390e-16 3.203243e-16 0.000000e+00 5.834653e-27 0.000000e+00 0.000000e+00 +0.995635 2.513551e-16 2.819082e-16 0.000000e+00 5.283248e-27 0.000000e+00 0.000000e+00 +0.997823 2.232830e-16 2.498288e-16 0.000000e+00 4.824163e-27 0.000000e+00 0.000000e+00 +1.000000 1.994308e-16 2.226022e-16 0.000000e+00 4.435703e-27 0.000000e+00 0.000000e+00 +1.002166 1.788819e-16 1.991761e-16 0.000000e+00 4.102474e-27 0.000000e+00 0.000000e+00 +1.004321 1.609682e-16 1.787834e-16 0.000000e+00 3.813247e-27 0.000000e+00 0.000000e+00 +1.006466 1.451916e-16 1.608518e-16 0.000000e+00 3.559640e-27 0.000000e+00 0.000000e+00 +1.008600 1.311728e-16 1.449461e-16 0.000000e+00 3.335270e-27 0.000000e+00 0.000000e+00 +1.010724 1.186187e-16 1.307295e-16 0.000000e+00 3.135191e-27 0.000000e+00 0.000000e+00 +1.012837 1.072987e-16 1.179375e-16 0.000000e+00 2.955509e-27 0.000000e+00 0.000000e+00 +1.014940 9.702979e-17 1.063595e-16 0.000000e+00 2.743582e-27 0.000000e+00 0.000000e+00 +1.017033 8.802750e-17 9.623278e-17 0.000000e+00 2.495225e-27 0.000000e+00 0.000000e+00 +1.019116 8.019337e-17 8.744034e-17 0.000000e+00 2.264206e-27 0.000000e+00 0.000000e+00 +1.021189 7.332056e-17 7.974478e-17 0.000000e+00 2.063345e-27 0.000000e+00 0.000000e+00 +1.023252 6.724845e-17 7.296182e-17 0.000000e+00 1.887445e-27 0.000000e+00 0.000000e+00 +1.025306 6.185044e-17 6.694622e-17 0.000000e+00 1.732417e-27 0.000000e+00 0.000000e+00 +1.027350 5.702533e-17 6.158191e-17 0.000000e+00 1.595002e-27 0.000000e+00 0.000000e+00 +1.029384 5.269128e-17 5.677508e-17 0.000000e+00 1.472571e-27 0.000000e+00 0.000000e+00 +1.031408 4.878134e-17 5.244901e-17 0.000000e+00 1.362982e-27 0.000000e+00 0.000000e+00 +1.033424 4.524024e-17 4.854037e-17 0.000000e+00 1.264471e-27 0.000000e+00 0.000000e+00 +1.035430 4.202191e-17 4.499644e-17 0.000000e+00 1.175576e-27 0.000000e+00 0.000000e+00 +1.037426 3.908766e-17 4.177292e-17 0.000000e+00 1.095070e-27 0.000000e+00 0.000000e+00 +1.039414 3.640472e-17 3.883237e-17 0.000000e+00 1.021924e-27 0.000000e+00 0.000000e+00 +1.041393 2.545887e-17 2.710715e-17 0.000000e+00 9.552614e-28 0.000000e+00 0.000000e+00 +1.043362 2.376379e-17 2.525780e-17 0.000000e+00 8.943373e-28 0.000000e+00 0.000000e+00 +1.045323 2.220278e-17 2.355856e-17 0.000000e+00 8.385110e-28 0.000000e+00 0.000000e+00 +1.047275 2.076240e-17 2.199408e-17 0.000000e+00 7.872305e-28 0.000000e+00 0.000000e+00 +1.049218 1.943092e-17 2.055102e-17 0.000000e+00 7.400175e-28 0.000000e+00 0.000000e+00 +1.051153 1.819806e-17 1.921769e-17 0.000000e+00 6.964559e-28 0.000000e+00 0.000000e+00 +1.053078 1.705478e-17 1.798381e-17 0.000000e+00 6.561819e-28 0.000000e+00 0.000000e+00 +1.054996 1.599309e-17 1.684033e-17 0.000000e+00 6.188765e-28 0.000000e+00 0.000000e+00 +1.056905 1.500588e-17 1.577919e-17 0.000000e+00 5.842588e-28 0.000000e+00 0.000000e+00 +1.058805 1.408684e-17 1.479325e-17 0.000000e+00 5.520808e-28 0.000000e+00 0.000000e+00 +1.060698 1.323032e-17 1.387614e-17 0.000000e+00 5.221225e-28 0.000000e+00 0.000000e+00 +1.062582 1.243127e-17 1.302215e-17 0.000000e+00 4.941885e-28 0.000000e+00 0.000000e+00 +1.064458 1.168513e-17 1.222615e-17 0.000000e+00 4.681045e-28 0.000000e+00 0.000000e+00 +1.066326 1.098779e-17 1.148352e-17 0.000000e+00 4.437148e-28 0.000000e+00 0.000000e+00 +1.068186 1.033555e-17 1.079010e-17 0.000000e+00 4.208798e-28 0.000000e+00 0.000000e+00 +1.070038 9.725022e-18 1.014211e-17 0.000000e+00 3.994742e-28 0.000000e+00 0.000000e+00 +1.071882 9.153161e-18 9.536141e-18 0.000000e+00 3.793849e-28 0.000000e+00 0.000000e+00 +1.073718 8.617175e-18 8.969074e-18 0.000000e+00 3.605101e-28 0.000000e+00 0.000000e+00 +1.075547 8.114517e-18 8.438075e-18 0.000000e+00 3.427577e-28 0.000000e+00 0.000000e+00 +1.077368 7.642860e-18 7.940556e-18 0.000000e+00 3.260441e-28 0.000000e+00 0.000000e+00 +1.079181 7.200066e-18 7.474148e-18 0.000000e+00 3.102934e-28 0.000000e+00 0.000000e+00 +1.080987 6.784177e-18 7.036681e-18 0.000000e+00 2.954367e-28 0.000000e+00 0.000000e+00 +1.082785 6.393389e-18 6.626162e-18 0.000000e+00 2.814110e-28 0.000000e+00 0.000000e+00 +1.084576 6.026038e-18 6.240760e-18 0.000000e+00 2.681590e-28 0.000000e+00 0.000000e+00 +1.086360 5.680592e-18 5.878787e-18 0.000000e+00 2.556281e-28 0.000000e+00 0.000000e+00 +1.088136 5.355632e-18 5.538686e-18 0.000000e+00 2.437701e-28 0.000000e+00 0.000000e+00 +1.089905 5.049847e-18 5.219021e-18 0.000000e+00 2.325410e-28 0.000000e+00 0.000000e+00 +1.091667 4.762020e-18 4.918463e-18 0.000000e+00 2.219002e-28 0.000000e+00 0.000000e+00 +1.093422 4.491023e-18 4.635780e-18 0.000000e+00 2.118103e-28 0.000000e+00 0.000000e+00 +1.095169 4.235808e-18 4.369832e-18 0.000000e+00 2.022369e-28 0.000000e+00 0.000000e+00 +1.096910 3.995401e-18 4.119560e-18 0.000000e+00 1.931483e-28 0.000000e+00 0.000000e+00 +1.098644 3.768894e-18 3.883981e-18 0.000000e+00 1.845150e-28 0.000000e+00 0.000000e+00 +1.100371 3.555441e-18 3.662180e-18 0.000000e+00 1.763099e-28 0.000000e+00 0.000000e+00 +1.102091 3.354254e-18 3.453305e-18 0.000000e+00 1.685079e-28 0.000000e+00 0.000000e+00 +1.103804 3.164596e-18 3.256564e-18 0.000000e+00 1.610855e-28 0.000000e+00 0.000000e+00 +1.105510 2.985780e-18 3.071217e-18 0.000000e+00 1.540212e-28 0.000000e+00 0.000000e+00 +1.107210 2.817162e-18 2.896573e-18 0.000000e+00 1.472945e-28 0.000000e+00 0.000000e+00 +1.108903 2.658141e-18 2.731988e-18 0.000000e+00 1.408869e-28 0.000000e+00 0.000000e+00 +1.110590 2.508153e-18 2.576860e-18 0.000000e+00 1.347807e-28 0.000000e+00 0.000000e+00 +1.112270 2.366670e-18 2.430625e-18 0.000000e+00 1.289597e-28 0.000000e+00 0.000000e+00 +1.113943 2.233198e-18 2.292757e-18 0.000000e+00 1.234084e-28 0.000000e+00 0.000000e+00 +1.115611 2.107271e-18 2.162761e-18 0.000000e+00 1.181128e-28 0.000000e+00 0.000000e+00 +1.117271 1.988454e-18 2.040175e-18 0.000000e+00 1.130593e-28 0.000000e+00 0.000000e+00 +1.118926 1.876339e-18 1.924565e-18 0.000000e+00 1.082354e-28 0.000000e+00 0.000000e+00 +1.120574 1.770540e-18 1.815525e-18 0.000000e+00 1.036294e-28 0.000000e+00 0.000000e+00 +1.122216 1.670697e-18 1.712674e-18 0.000000e+00 9.923029e-29 0.000000e+00 0.000000e+00 +1.123852 1.576469e-18 1.615653e-18 0.000000e+00 9.502763e-29 0.000000e+00 0.000000e+00 +1.125481 1.487538e-18 1.524125e-18 0.000000e+00 9.101169e-29 0.000000e+00 0.000000e+00 +1.127105 1.403603e-18 1.437776e-18 0.000000e+00 8.717329e-29 0.000000e+00 0.000000e+00 +1.128722 1.324380e-18 1.356307e-18 0.000000e+00 8.350379e-29 0.000000e+00 0.000000e+00 +1.130334 1.249604e-18 1.279439e-18 0.000000e+00 7.999501e-29 0.000000e+00 0.000000e+00 +1.131939 1.179024e-18 1.206910e-18 0.000000e+00 7.663928e-29 0.000000e+00 0.000000e+00 +1.133539 1.112403e-18 1.138472e-18 0.000000e+00 7.342931e-29 0.000000e+00 0.000000e+00 +1.135133 1.049518e-18 1.073893e-18 0.000000e+00 7.035825e-29 0.000000e+00 0.000000e+00 +1.136721 0.000000e+00 1.012954e-18 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.138303 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.139879 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.141450 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.143015 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.144574 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.146128 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.147676 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.149219 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.150756 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.152288 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.153815 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.155336 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.156852 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.158362 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.159868 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.161368 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.162863 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.164353 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.165838 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.167317 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.168792 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.170262 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.171726 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.173186 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.174641 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.176091 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.177536 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.178977 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.180413 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.181844 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.183270 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.184691 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.186108 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.187521 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.188928 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.190332 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.191730 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.193125 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.194514 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.195900 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.197281 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.198657 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.200029 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.201397 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.202761 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 +1.204120 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 diff --git a/Util/VODE_test/atomic_rates.f90 b/Util/VODE_test/atomic_rates.f90 new file mode 100644 index 00000000..ea5907ff --- /dev/null +++ b/Util/VODE_test/atomic_rates.f90 @@ -0,0 +1,342 @@ +! ************************************************************************************* +! Tabulates cooling and UV heating rates. +! +! Units are CGS, temperature is in K +! +! Two sets of rates, as in: +! 1) Katz, Weinberg & Hernquist, 1996: Astrophysical Journal Supplement v. 105, p.19 +! 2) Lukic et al. 2015: Monthly Notices of the Royal Astronomical Society, v. 446, p.3697 +! +! NOTE: This is executed only once per run, and rates are ugly, thus +! execution efficiency is not important, but readability of +! the code is. -- Zarija +! +! ************************************************************************************* + +module atomic_rates_module + + use constants_module, only : rt => type_real, M_PI + use iso_c_binding, only : c_float, c_double, c_size_t + + implicit none + + ! Photo- rates (from file) + integer, private :: NCOOLFILE + real(rt), dimension(:), allocatable, private :: lzr + real(rt), dimension(:), allocatable, private :: rggh0, rgghe0, rgghep + real(rt), dimension(:), allocatable, private :: reh0, rehe0, rehep + + ! Other rates (from equations) + integer, parameter, public :: NCOOLTAB=2000 + real(rt), dimension(NCOOLTAB+1), public :: AlphaHp, AlphaHep, AlphaHepp, Alphad + real(rt), dimension(NCOOLTAB+1), public :: GammaeH0, GammaeHe0, GammaeHep + real(rt), dimension(NCOOLTAB+1), public :: BetaH0, BetaHe0, BetaHep, Betaff1, Betaff4 + real(rt), dimension(NCOOLTAB+1), public :: RecHp, RecHep, RecHepp + + real(rt), public, save :: this_z, ggh0, gghe0, gghep, eh0, ehe0, ehep + + real(rt), parameter, public :: TCOOLMIN = 0.0d0, TCOOLMAX = 9.0d0 ! in log10 + real(rt), parameter, public :: TCOOLMIN_R = 10.0d0**TCOOLMIN, TCOOLMAX_R = 10.0d0**TCOOLMAX + real(rt), parameter, public :: deltaT = (TCOOLMAX - TCOOLMIN)/NCOOLTAB + + real(rt), parameter, public :: MPROTON = 1.6726231d-24, BOLTZMANN = 1.3806e-16 + + real(rt), public, save :: uvb_density_A = 1.0d0, uvb_density_B = 0.0d0, mean_rhob + + ! Note that XHYDROGEN can be set by a call to set_xhydrogen which now + ! lives in set_method_params. + real(rt), public :: XHYDROGEN = 0.76d0 + real(rt), public :: YHELIUM = 7.8947368421d-2 ! (1.0d0-XHYDROGEN)/(4.0d0*XHYDROGEN) + + contains + + subroutine fort_tabulate_rates() bind(C, name='fort_tabulate_rates') +! use parallel, only: parallel_ioprocessor +! use amrex_parmparse_module + use fundamental_constants_module, only: Gconst + use comoving_module, only: comoving_h,comoving_OmB + use reion_aux_module, only: zhi_flash, zheii_flash, T_zhi, T_zheii, & + flash_h, flash_he, inhomogeneous_on + + real(rt), parameter :: M_PI = & + 3.141592653589793238462643383279502884197 + integer :: i, inhomo_reion + logical, parameter :: Katz96=.false. + real(rt), parameter :: t3=1.0d3, t5=1.0d5, t6=1.0d6 + real(rt) :: t, U, E, y, sqrt_t, corr_term, tmp + logical, save :: first=.true. +! logical, save :: parallel_ioprocessor=.true. + + character(len=80) :: file_in + character(len=14) :: var_name + character(len=2) :: eq_name + character(len=80) :: FMT +! type(amrex_parmparse) :: pp + + if (first) then + + first = .false. + + ! Get info from inputs +! call amrex_parmparse_build(pp, "nyx") +! call pp%query("inhomo_reion" , inhomo_reion) +! call pp%query("uvb_rates_file" , file_in) +! call pp%query("uvb_density_A" , uvb_density_A) +! call pp%query("uvb_density_B" , uvb_density_B) +! call pp%query("reionization_zHI_flash" , zhi_flash) +! call pp%query("reionization_zHeII_flash" , zheii_flash) +! call pp%query("reionization_T_zHI" , T_zhi) +! call pp%query("reionization_T_zHeII" , T_zheii) +! call amrex_parmparse_destroy(pp) +!nyx.inhomo_reion = 0 + + open(2, FILE="inputs_atomic") + + read(2,*) var_name, eq_name, inhomo_reion + read(2,*) var_name, eq_name, file_in + read(2,*) var_name,eq_name, uvb_density_A != 1.0 + read(2,*) var_name,eq_name, uvb_density_B != 0.0 + read(2,*) var_name,eq_name,zHI_flash!=-1 + read(2,*) var_name,eq_name,zHeII_flash!=-1 + read(2,*) var_name,eq_name,T_zHI!=2.00E+004 + read(2,*) var_name,eq_name,T_zHeII!=1.50E+004 + + close(2) + if (.true.) then !parallel_ioprocessor()) then + print*, 'TABULATE_RATES: reionization parameters are:' + print*, ' reionization_zHI_flash = ', zhi_flash + print*, ' reionization_zHeII_flash = ', zheii_flash + print*, ' reionization_T_zHI = ', T_zhi + print*, ' reionization_T_zHeII = ', T_zheii + + print*, 'TABULATE_RATES: rho-dependent heating parameters are:' + print*, ' A = ', uvb_density_A + print*, ' B = ', uvb_density_B + print*, ' UVB heating rates will be multiplied by A*(rho/rho_mean)**B' + endif + + ! Save mean density (in code units) for density-dependent heating + mean_rhob = comoving_OmB * 3.d0*(comoving_h*100.d0)**2 / (8.d0*M_PI*Gconst) + + ! Set options in reion_aux_module + ! Hydrogen reionization + if (zhi_flash .gt. 0.0) then + if (inhomo_reion .gt. 0) then + if (.true.) print*, 'TABULATE_RATES: ignoring reionization_zHI, as nyx.inhomo_reion > 0' + flash_h = .false. + inhomogeneous_on = .true. + else + flash_h = .true. + inhomogeneous_on = .false. + endif + else + flash_h = .false. + if (inhomo_reion .gt. 0) then + inhomogeneous_on = .true. + else + inhomogeneous_on = .false. + endif + endif + + ! Helium reionization + if (zheii_flash .gt. 0.0) then + flash_he = .true. + else + flash_he = .false. + endif + + if (.true.) then + print*, 'TABULATE_RATES: reionization flags are set to:' + print*, ' Hydrogen flash = ', flash_h + print*, ' Helium flash = ', flash_he + print*, ' inhomogeneous_on (H only) = ', inhomogeneous_on + endif + + + ! Read in UVB rates from a file + if (len(file_in) .gt. 0) then + open(unit=11, file=file_in, status='old') + if (.true.) then + print*, 'TABULATE_RATES: UVB file is set in inputs ('//file_in//').' + endif + else + open(unit=11, file='TREECOOL', status='old') + if (.true.) then + print*, 'TABULATE_RATES: UVB file is defaulted to "TREECOOL".' + endif + endif + + NCOOLFILE = 0 + do + read(11,*,end=10) tmp, tmp, tmp, tmp, tmp, tmp, tmp + NCOOLFILE = NCOOLFILE + 1 + end do + 10 rewind(11) + + allocate( lzr(NCOOLFILE), rggh0(NCOOLFILE), rgghe0(NCOOlFILE), rgghep(NCOOLFILE) ) + allocate( reh0(NCOOLFILE), rehe0(NCOOLFILE), rehep(NCOOLFILE) ) + + do i = 1, NCOOLFILE + read(11,*) lzr(i), rggh0(i), rgghe0(i), rgghep(i), & + reh0(i), rehe0(i), rehep(i) + end do + close(11) + + ! Initialize cooling tables + t = 10.0d0**TCOOLMIN + if (Katz96) then + do i = 1, NCOOLTAB+1 + ! Rates are as in Katz et al. 1996 + sqrt_t = dsqrt(t) + corr_term = 1.d0 / (1.0d0 + sqrt_t/dsqrt(t5)) + + ! Recombination rates + ! Alphad: dielectronic recombination rate of singly ioniozed helium + Alphad(i) = 1.90d-03/(t*sqrt_t) * dexp(-4.7d5/t) * (1.0d0+0.3d0*dexp(-9.4d4/t)) + AlphaHp(i) = 8.40d-11/sqrt_t * (t/t3)**(-0.2d0) / (1.0d0 + (t/t6)**0.7d0) + AlphaHep(i) = 1.50d-10 * t**(-0.6353d0) + AlphaHepp(i) = 3.36d-10/sqrt_t * (t/t3)**(-0.2d0) / (1.0d0 + (t/t6)**0.7d0) + + ! Collisional ionization rates + GammaeH0(i) = 5.85d-11*sqrt_t * dexp(-157809.1d0/t) * corr_term + GammaeHe0(i) = 2.38d-11*sqrt_t * dexp(-285335.4d0/t) * corr_term + GammaeHep(i) = 5.68d-12*sqrt_t * dexp(-631515.0d0/t) * corr_term + + ! Collisional ionization & excitation cooling rates + BetaH0(i) = 7.5d-19 * dexp(-118348.0d0/t) * corr_term + 2.171d-11*GammaeH0(i) + BetaHe0(i) = 3.941d-11 * GammaeHe0(i) + BetaHep(i) = 5.54d-17 * t**(-0.397d0) * dexp(-473638.0d0/t) * corr_term + & + 8.715d-11 * GammaeHep(i) + + ! Recombination cooling rates + RecHp(i) = 1.036d-16 * t * AlphaHp(i) + RecHep(i) = 1.036d-16 * t * AlphaHep(i) + 6.526d-11 * Alphad(i) + RecHepp(i) = 1.036d-16 * t * AlphaHepp(i) + + ! Free-free cooling rate + Betaff1(i) = 1.42d-27 * sqrt_t * (1.1d0 + 0.34d0*dexp(-(5.5d0 - dlog10(t))**2 / 3.0d0)) + Betaff4(i) = Betaff1(i) + + t = t*10.0d0**deltaT + enddo + else + do i = 1, NCOOLTAB+1 + ! Rates are as in Lukic et al. + sqrt_t = dsqrt(t) + + ! Recombination rates + ! Alphad: dielectronic recombination rate of singly ioniozed helium + Alphad(i) = 1.90d-03/(t*sqrt_t) * dexp(-4.7d5/t) * (1.0d0+0.3d0*dexp(-9.4d4/t)) + AlphaHp(i) = 7.982d-11 / (dsqrt(t/3.148d0)* (1.0d0+dsqrt(t/3.148d0))**0.252 * & + (1.0d0+dsqrt(t/7.036d5))**1.748) + if (t .le. 1.0d6) then + AlphaHep(i) = 3.294d-11 / (dsqrt(t/15.54d0)* (1.0d0+dsqrt(t/15.54d0))**0.309 * & + (1.0d0+dsqrt(t/3.676d7))**1.691) + else + AlphaHep(i) = 9.356d-10 / (dsqrt(t/4.266d-2)* (1.0d0+dsqrt(t/4.266d-2))**0.2108 * & + (1.0d0+dsqrt(t/4.677d6))**1.7892) + endif + AlphaHepp(i) = 1.891d-10 / (dsqrt(t/9.37d0)* (1.0d0+dsqrt(t/9.37d0))**0.2476 * & + (1.0d0+dsqrt(t/2.774d6))**1.7524) + + ! Collisional ionization rates + E = 13.6d0 + U = 1.16045d4*E/t + GammaeH0(i) = 2.91d-8*U**0.39*dexp(-U) / (0.232d0+U) + E = 24.6d0 + U = 1.16045d4*E/t + GammaeHe0(i) = 1.75d-8*U**0.35*dexp(-U) / (0.18d0+U) + E = 54.4d0 + U = 1.16045d4*E/t + GammaeHep(i) = 2.05d-9*(1.0d0+dsqrt(U))*U**0.25*dexp(-U) / (0.265d0+U) + + ! Collisional ionization & excitation cooling rates + corr_term = 1.d0 / (1.0d0 + sqrt_t/dsqrt(5.0d7)) + y = dlog(t) + if (t .le. 1.0d5) then + BetaH0(i) = 1.0d-20 * dexp( 2.137913d2 - 1.139492d2*y + 2.506062d1*y**2 - & + 2.762755d0*y**3 + 1.515352d-1*y**4 - & + 3.290382d-3*y**5 - 1.18415d5/t ) + else + BetaH0(i) = 1.0d-20 * dexp( 2.7125446d2 - 9.8019455d1*y + 1.400728d1*y**2 - & + 9.780842d-1*y**3 + 3.356289d-2*y**4 - & + 4.553323d-4*y**5 - 1.18415d5/t ) + endif + BetaHe0(i) = 9.38d-22 * sqrt_t * dexp(-285335.4d0/t) * corr_term + BetaHep(i) = (5.54d-17 * t**(-0.397d0) * dexp(-473638.0d0/t) + & + 4.85d-22 * sqrt_t * dexp(-631515.0d0/t) )*corr_term + + ! Recombination cooling rates + RecHp(i) = 2.851d-27 * sqrt_t * (5.914d0-0.5d0*dlog(t)+1.184d-2*t**(1.0d0/3.0d0)) + RecHep(i) = 1.55d-26 * t**0.3647 + 1.24d-13/(t*sqrt_t) * dexp(-4.7d5/t) * & + (1.0d0+0.3d0*dexp(-9.4d4/t)) + RecHepp(i) = 1.14d-26 * sqrt_t * (6.607d0-0.5d0*dlog(t)+7.459d-3*t**(1.0d0/3.0d0)) + + ! Free-free cooling rate + if (t .le. 3.2d5) then + Betaff1(i) = 1.426d-27 * sqrt_t * (0.79464d0 + 0.1243d0*dlog10(t)) + else + Betaff1(i) = 1.426d-27 * sqrt_t * (2.13164d0 - 0.1240d0*dlog10(t)) + endif + + if (t/4.0d0 .le. 3.2d5) then + Betaff4(i) = 1.426d-27 * sqrt_t * 4.0d0*(0.79464d0 + 0.1243d0*dlog10(t)) + else + Betaff4(i) = 1.426d-27 * sqrt_t * 4.0d0*(2.13164d0 - 0.1240d0*dlog10(t)) + endif + + t = t*10.0d0**deltaT + enddo + endif ! Katz rates + + end if ! first_call + + end subroutine fort_tabulate_rates + + ! **************************************************************************** + + subroutine fort_interp_to_this_z(z) bind(C, name='fort_interp_to_this_z') + + use vode_aux_module, only: z_vode + + real(rt), intent(in) :: z + real(rt) :: lopz, fact + integer :: i, j + + this_z = z + z_vode = z + lopz = dlog10(1.0d0 + z) + + if (lopz .ge. lzr(NCOOLFILE)) then + ggh0 = 0.0d0 + gghe0 = 0.0d0 + gghep = 0.0d0 + eh0 = 0.0d0 + ehe0 = 0.0d0 + ehep = 0.0d0 + return + endif + + if (lopz .le. lzr(1)) then + j = 1 + else + do i = 2, NCOOLFILE + if (lopz .lt. lzr(i)) then + j = i-1 + exit + endif + enddo + endif + + fact = (lopz-lzr(j))/(lzr(j+1)-lzr(j)) + + ggh0 = rggh0(j) + (rggh0(j+1)-rggh0(j))*fact + gghe0 = rgghe0(j) + (rgghe0(j+1)-rgghe0(j))*fact + gghep = rgghep(j) + (rgghep(j+1)-rgghep(j))*fact + eh0 = reh0(j) + (reh0(j+1)-reh0(j))*fact + ehe0 = rehe0(j) + (rehe0(j+1)-rehe0(j))*fact + ehep = rehep(j) + (rehep(j+1)-rehep(j))*fact + + end subroutine fort_interp_to_this_z + +end module atomic_rates_module diff --git a/Util/VODE_test/comoving_nd.f90 b/Util/VODE_test/comoving_nd.f90 new file mode 100644 index 00000000..0b120759 --- /dev/null +++ b/Util/VODE_test/comoving_nd.f90 @@ -0,0 +1,415 @@ +module comoving_nd_module + + use constants_module, only : rt => type_real, M_PI + + contains + +! ::: +! ::: ---------------------------------------------------------------- +! ::: + + subroutine fort_integrate_comoving_a(old_a,new_a,dt) & + bind(C, name="fort_integrate_comoving_a") + + use fundamental_constants_module, only: Hubble_const + use comoving_module , only: comoving_h, comoving_OmM, comoving_type + + implicit none + + real(rt), intent(in ) :: old_a, dt + real(rt), intent( out) :: new_a + + real(rt), parameter :: xacc = 1.0d-8 + real(rt) :: H_0, OmL + real(rt) :: Delta_t, prev_soln + real(rt) :: start_a, end_a, start_slope, end_slope + integer :: iter, j, nsteps + + if (comoving_h .eq. 0.0d0) then + new_a = old_a + return + endif + + H_0 = comoving_h * Hubble_const + OmL = 1.d0 - comoving_OmM + + prev_soln = 2.0d0 ! 0 0) then + start_slope = H_0*dsqrt(comoving_OmM / start_a + OmL*start_a**2) + else + start_slope = comoving_h + end if + + ! Compute a provisional value of ln(a) at the new time + end_a = start_a + start_slope * Delta_t + + ! Compute the slope at the new time + if (comoving_type > 0) then + end_slope = H_0*dsqrt(comoving_OmM / end_a + OmL*end_a**2) + else + end_slope = comoving_h + end if + + ! Now recompute a at the new time using the average of the two slopes + end_a = start_a + 0.5d0 * (start_slope + end_slope) * Delta_t + enddo + + new_a = end_a + if (abs(1.0d0-new_a/prev_soln) .le. xacc) return + prev_soln = new_a + + enddo + + end subroutine fort_integrate_comoving_a + +! ::: +! ::: ---------------------------------------------------------------- +! ::: + + subroutine fort_integrate_comoving_a_to_z(old_a,z_value,dt) & + bind(C, name="fort_integrate_comoving_a_to_z") + + use fundamental_constants_module, only: Hubble_const + use comoving_module , only: comoving_h, comoving_OmM, comoving_type + + implicit none + + real(rt), intent(in ) :: old_a, z_value + real(rt), intent(inout) :: dt + + real(rt), parameter :: xacc = 1.0d-8 + real(rt) :: H_0, OmL + real(rt) :: Delta_t + real(rt) :: start_a, end_a, start_slope, end_slope + real(rt) :: a_value + integer :: j, nsteps + + if (comoving_h .eq. 0.0d0) & + print*, "fort_integrate_comoving_a_to_z: Shouldn't be setting plot_z_values if not evolving a" +! call bl_error("fort_integrate_comoving_a_to_z: Shouldn't be setting plot_z_values if not evolving a") + + H_0 = comoving_h * Hubble_const + OmL = 1.d0 - comoving_OmM + + ! Translate the target "z" into a target "a" + a_value = 1.d0 / (1.d0 + z_value) + + ! Use lots of steps if we want to nail the z_value + nsteps = 1024 + + ! We integrate a, but stop when a = a_value (or close enough) + Delta_t = dt/nsteps + end_a = old_a + do j = 1, nsteps + ! This uses RK2 to integrate the ODE: + ! da / dt = H_0 * sqrt(OmM/a + OmL*a^2) + start_a = end_a + + ! Compute the slope at the old time + if (comoving_type > 0) then + start_slope = H_0*dsqrt(comoving_OmM / start_a + OmL*start_a**2) + else + start_slope = comoving_h + end if + + ! Compute a provisional value of ln(a) at the new time + end_a = start_a + start_slope * Delta_t + + ! Compute the slope at the new time + if (comoving_type > 0) then + end_slope = H_0*dsqrt(comoving_OmM / end_a + OmL*end_a**2) + else + end_slope = comoving_h + end if + + ! Now recompute a at the new time using the average of the two slopes + end_a = start_a + 0.5d0 * (start_slope + end_slope) * Delta_t + + ! We have crossed from a too small to a too big in this step + if ( (end_a - a_value) * (start_a - a_value) < 0) then + dt = ( ( end_a - a_value) * dble(j ) + & + (a_value - start_a) * dble(j+1) ) / (end_a - start_a) * Delta_t + exit + end if + end do + + end subroutine fort_integrate_comoving_a_to_z +! ::: +! ::: ---------------------------------------------------------------- +! ::: + + subroutine fort_est_maxdt_comoving_a(old_a,dt) + + use fundamental_constants_module, only: Hubble_const + use comoving_module , only: comoving_h, comoving_OmM, comoving_type + + implicit none + + real(rt), intent(in ) :: old_a + real(rt), intent(inout) :: dt + + real(rt) :: H_0, OmL + real(rt) :: max_dt + + OmL = 1.d0 - comoving_OmM + + ! This subroutine computes dt based on not changing a by more than 5% + ! if we use forward Euler integration + ! d(ln(a)) / dt = H_0 * sqrt(OmM/a^3 + OmL) + + H_0 = comoving_h * Hubble_const + + if (H_0 .ne. 0.0d0) then + if (comoving_type > 0) then + max_dt = (0.05d0) / H_0 / dsqrt(comoving_OmM / old_a**3 + OmL) + else + max_dt = (0.05d0) / abs(comoving_h) + end if + dt = min(dt,max_dt) + + else + + ! dt is unchanged + + end if + + end subroutine fort_est_maxdt_comoving_a + +! ::: +! ::: ---------------------------------------------------------------- +! ::: + + subroutine fort_estdt_comoving_a(old_a,new_a,dt,change_allowed,final_a,dt_modified) & + bind(C, name="fort_estdt_comoving_a") + + use comoving_module , only: comoving_h + + implicit none + + real(rt), intent(in ) :: old_a, change_allowed, final_a + real(rt), intent(inout) :: dt + real(rt), intent( out) :: new_a + integer , intent( out) :: dt_modified + + if (comoving_h .ne. 0.0d0) then + + ! First call this to make sure dt that we send to integration routine isnt outrageous + call fort_est_maxdt_comoving_a(old_a,dt) + + ! Initial call to see if existing dt will work + call fort_integrate_comoving_a(old_a,new_a,dt) + + ! Make sure a isn't growing too fast + call enforce_percent_change(old_a,new_a,dt,change_allowed) + + ! Make sure we don't go past final_a (if final_a is set) + if (final_a > 0.0d0) & + call enforce_final_a(old_a,new_a,dt,final_a) + + dt_modified = 1 + + else + + ! dt is unchanged by this call + + dt_modified = 0 + + endif + + end subroutine fort_estdt_comoving_a + +! ::: +! ::: ---------------------------------------------------------------- +! ::: + + subroutine enforce_percent_change(old_a,new_a,dt,change_allowed) + + implicit none + + real(rt), intent(in ) :: old_a, change_allowed + real(rt), intent(inout) :: dt + real(rt), intent(inout) :: new_a + + integer :: i + real(rt) :: factor + + factor = ( (new_a - old_a) / old_a ) / change_allowed + + ! Only go into this process if percent change exceeds change_allowed + + if (factor > 1.d0) then + + do i = 1, 100 + factor = ( (new_a - old_a) / old_a ) / change_allowed + + ! Note: 0.99 is just a fudge factor so we don't get bogged down. + if (factor > 1.d0) then + dt = (1.d0 / factor) * dt * 0.99d0 + call fort_integrate_comoving_a(old_a,new_a,dt) + else if (i.lt.100) then + call fort_integrate_comoving_a(old_a,new_a,dt) + ! We're done + return + else + print*, "Too many iterations in enforce_percent_change" + !call bl_error("Too many iterations in enforce_percent_change") + end if + end do + + else + ! We don't need to do anything + return + end if + + end subroutine enforce_percent_change + +! ::: +! ::: ---------------------------------------------------------------- +! ::: + + subroutine enforce_final_a(old_a,new_a,dt,final_a) + + implicit none + + real(rt), intent(in ) :: old_a, final_a + real(rt), intent(inout) :: dt + real(rt), intent(inout) :: new_a + + integer :: i + real(rt) :: factor + real(rt), parameter :: eps = 1.d-10 + + if (old_a > final_a) then + print*, "Oops -- old_a > final_a" + ! call bl_error("Oops -- old_a > final_a") + end if + + ! Only go into this process if new_a is past final_a + if (new_a > final_a) then + + do i = 1, 100 + if ( (new_a > (final_a+eps)) .or. (new_a < final_a) ) then + factor = (final_a - old_a) / (new_a - old_a) + dt = dt * factor + call fort_integrate_comoving_a(old_a,new_a,dt) + else if (i.lt.100) then + ! We're done + return + else + print*,"Too many iterations in enforce_final_a" +! call bl_error("Too many iterations in enforce_final_a") + end if + end do + + else + ! We don't need to do anything + return + end if + + end subroutine enforce_final_a + +! ! ::: +! ! ::: ---------------------------------------------------------------- +! ! ::: + +! subroutine fort_get_omb(frac) & +! bind(C, name="fort_get_omb") + +! use comoving_module, only: comoving_OmB, comoving_OmM + +! real(rt) :: frac + +! frac = comoving_OmB / comoving_OmM + +! end subroutine fort_get_omb + + +! ! ::: +! ! ::: ---------------------------------------------------------------- +! ! ::: + +! subroutine fort_get_omm(omm) & +! bind(C, name="fort_get_omm") + +! use comoving_module, only: comoving_OmM + +! real(rt) :: omm + +! omm = comoving_OmM + +! end subroutine fort_get_omm + +! ! ::: +! ! ::: ---------------------------------------------------------------- +! ! ::: + +! subroutine fort_get_hubble(hubble) & +! bind(C, name="fort_get_hubble") + +! use comoving_module, only: comoving_h + +! real(rt) :: hubble + +! hubble = comoving_h + +! end subroutine fort_get_hubble + + +! ::: +! ::: ---------------------------------------------------------------- +! ::: + + subroutine fort_set_omb(omb) & + bind(C, name="fort_set_omb") + + use comoving_module, only: comoving_OmB + + real(rt), intent(in) :: omb + + comoving_OmB = omb + + end subroutine fort_set_omb + + +! ::: +! ::: ---------------------------------------------------------------- +! ::: + + subroutine fort_set_omm(omm) & + bind(C, name="fort_set_omm") + + use comoving_module, only: comoving_OmM + + real(rt), intent(in) :: omm + + comoving_OmM = omm + + end subroutine fort_set_omm + +! ::: +! ::: ---------------------------------------------------------------- +! ::: + + subroutine fort_set_hubble(hubble) & + bind(C, name="fort_set_hubble") + + use comoving_module, only: comoving_h + + real(rt), intent(in) :: hubble + + comoving_h = hubble + + end subroutine fort_set_hubble + +end module comoving_nd_module diff --git a/Util/VODE_test/comoving_params.f90 b/Util/VODE_test/comoving_params.f90 new file mode 100644 index 00000000..6471bd51 --- /dev/null +++ b/Util/VODE_test/comoving_params.f90 @@ -0,0 +1,8 @@ +module comoving_module + + use constants_module, only : rt => type_real, M_PI + + integer, save :: comoving_type + real(rt), save :: comoving_OmM, comoving_OmB, comoving_OmN, comoving_h + +end module comoving_module diff --git a/Util/VODE_test/constants_cosmo.f90 b/Util/VODE_test/constants_cosmo.f90 new file mode 100644 index 00000000..157decab --- /dev/null +++ b/Util/VODE_test/constants_cosmo.f90 @@ -0,0 +1,68 @@ +! +! Nyx code units are defined as: +! Length [Mpc] +! Velocity [km/s] +! Mass [M_sun] +! (+ Kelvin for temperature) +! +! Fundamental constants are taken from Chin. Phys. C, 40, 100001 (2016), see +! http://pdg.lbl.gov/2016/reviews/rpp2016-rev-phys-constants.pdf +! http://pdg.lbl.gov/2016/reviews/rpp2016-rev-astrophysical-constants.pdf +! + +module fundamental_constants_module + + use constants_module, only : rt => type_real, M_PI + implicit none + + real(rt), parameter :: pi = 3.141592653589793238d0 + + ! Relation of our code units & CGS: + real(rt), parameter :: M_unit = 1.98848d33 ! M_sun + real(rt), parameter :: L_unit = 3.0856776d24 ! Mpc + real(rt), parameter :: V_unit = 1.d5 ! km/s + real(rt), parameter :: T_unit = L_unit/V_unit ! time unit + + ! + ! Fundamental constants + ! + real(rt), parameter :: Gconst = 6.67408e-8_rt & ! Newton [g^-1*s^-2*cm^3] + * M_unit*T_unit**2/L_unit**3 + + real(rt), parameter :: k_B = 1.38064852e-16_rt & ! Boltzmann [g*cm^2/s^2*K] + * T_unit**2/(M_unit*L_unit**2) + + real(rt), parameter :: hbar = 1.0545718e-27_rt & ! Planck/2pi [g*cm^2/s] + * T_unit/(M_unit*L_unit**2) + + real(rt), parameter :: n_A = 6.022140857e23_rt & ! Avogadro's number [mol^-1] + * M_unit + + real(rt), parameter :: m_proton = 1.672621e-24_rt & ! Proton mass [g] + / M_unit + + real(rt), parameter :: sigma_T = 6.6524587158e-25_rt & ! Thomson cross section [cm^2] + / L_unit**2 + + real(rt), parameter :: c_light = 2.99792458e10_rt & ! Speed of light [cm/s] + / V_unit + + real(rt), parameter :: Hubble_const = 100._rt ! Hubble constant / h + + ! + ! Useful quantities and conversions + ! + real(rt), parameter :: mp_over_kb = m_proton/k_B + + real(rt), parameter :: density_to_cgs = M_unit / L_unit**3 + + ! For internal energy + real(rt), parameter :: e_to_cgs = V_unit**2 + + ! For source terms we convert [erg/(s*cm^3) = g/(s^3*cm)] into code units + real(rt), parameter :: heat_from_cgs = L_unit*(T_unit**3 / M_unit) + + ! For AGN accretion rate + real(rt), parameter :: eddington_const = 4.0d0*pi * Gconst * m_proton / (sigma_T * c_light) + +end module fundamental_constants_module diff --git a/Util/VODE_test/constants_mod.f90 b/Util/VODE_test/constants_mod.f90 new file mode 100644 index 00000000..17b9610f --- /dev/null +++ b/Util/VODE_test/constants_mod.f90 @@ -0,0 +1,14 @@ +module constants_module + + use iso_c_binding, only : c_float, c_double, c_size_t + + implicit none + + integer, parameter :: type_real = c_double + ! We could/should use Fortran 2008 c_sizeof here. + integer (kind=c_size_t), parameter :: type_real_size = 8_c_size_t + + real(kind = type_real), parameter :: M_PI = & + 3.141592653589793238462643383279502884197_type_real + + end module constants_module diff --git a/Util/VODE_test/cvode_interface.f90 b/Util/VODE_test/cvode_interface.f90 new file mode 100644 index 00000000..684e37f4 --- /dev/null +++ b/Util/VODE_test/cvode_interface.f90 @@ -0,0 +1,2213 @@ +! ------------------------------------------------------------------ +! $Revision$ +! $Date$ +! ------------------------------------------------------------------ +! Programmer(s): David J. Gardner @ LLNL +! Daniel R. Reynolds @ SMU +! ------------------------------------------------------------------ +! LLNS Copyright Start +! Copyright (c) 2014, Lawrence Livermore National Security +! This work was performed under the auspices of the U.S. Department +! of Energy by Lawrence Livermore National Laboratory in part under +! Contract W-7405-Eng-48 and in part under Contract DE-AC52-07NA27344. +! Produced at the Lawrence Livermore National Laboratory. +! All rights reserved. +! For details, see the LICENSE file. +! LLNS Copyright End +! ------------------------------------------------------------------ +! This file contains Fortran modules for interfacing with the main +! CVODE integrator using the ISO_C_BINDING module. +! ------------------------------------------------------------------ +! CVODE is used to solve numerically the ordinary initial value +! problem: +! +! y' = f(t,y), +! y(t0) = y0, +! +! where t0, y0 in R^N, and f: R x R^N -> R^N are given. +! ------------------------------------------------------------------ + +module cvode_interface + + ! ================================================================= + ! C V O D E C O N S T A N T S + ! ================================================================= + use, intrinsic :: iso_c_binding, only : c_int + + ! ----------------------------------------------------------------- + ! Enumerations for inputs to CVodeCreate and CVode. + ! ----------------------------------------------------------------- + + ! lmm + integer(c_int), parameter :: CV_ADAMS = 1 + integer(c_int), parameter :: CV_BDF = 2 + + ! iter + integer(c_int), parameter :: CV_FUNCTIONAL = 1 + integer(c_int), parameter :: CV_NEWTON = 2 + + ! itask + integer(c_int), parameter :: CV_NORMAL = 1 + integer(c_int), parameter :: CV_ONE_STEP = 2 + + ! ----------------------------------------------------------------- + ! CVODE return flags + ! ----------------------------------------------------------------- + + integer(c_int), parameter :: CV_SUCCESS = 0 + integer(c_int), parameter :: CV_TSTOP_RETURN = 1 + integer(c_int), parameter :: CV_ROOT_RETURN = 2 + + integer(c_int), parameter :: CV_WARNING = 99 + + integer(c_int), parameter :: CV_TOO_MUCH_WORK = -1 + integer(c_int), parameter :: CV_TOO_MUCH_ACC = -2 + integer(c_int), parameter :: CV_ERR_FAILURE = -3 + integer(c_int), parameter :: CV_CONV_FAILURE = -4 + + integer(c_int), parameter :: CV_LINIT_FAIL = -5 + integer(c_int), parameter :: CV_LSETUP_FAIL = -6 + integer(c_int), parameter :: CV_LSOLVE_FAIL = -7 + integer(c_int), parameter :: CV_RHSFUNC_FAIL = -8 + integer(c_int), parameter :: CV_FIRST_RHSFUNC_ERR = -9 + integer(c_int), parameter :: CV_REPTD_RHSFUNC_ERR = -10 + integer(c_int), parameter :: CV_UNREC_RHSFUNC_ERR = -11 + integer(c_int), parameter :: CV_RTFUNC_FAIL = -12 + + integer(c_int), parameter :: CV_MEM_FAIL = -20 + integer(c_int), parameter :: CV_MEM_NULL = -21 + integer(c_int), parameter :: CV_ILL_INPUT = -22 + integer(c_int), parameter :: CV_NO_MALLOC = -23 + integer(c_int), parameter :: CV_BAD_K = -24 + integer(c_int), parameter :: CV_BAD_T = -25 + integer(c_int), parameter :: CV_BAD_DKY = -26 + integer(c_int), parameter :: CV_TOO_CLOSE = -27 + + ! ================================================================= + ! C V D I A G C O N S T A N T S + ! ================================================================= + + ! ----------------------------------------------------------------- + ! CVDIAG return values + ! ----------------------------------------------------------------- + + integer(c_int), parameter :: CVDIAG_SUCCESS = 0 + integer(c_int), parameter :: CVDIAG_MEM_NULL = -1 + integer(c_int), parameter :: CVDIAG_LMEM_NULL = -2 + integer(c_int), parameter :: CVDIAG_ILL_INPUT = -3 + integer(c_int), parameter :: CVDIAG_MEM_FAIL = -4 + + ! Additional last_flag values + integer(c_int), parameter :: CVDIAG_INV_FAIL = -5 + integer(c_int), parameter :: CVDIAG_RHSFUNC_UNRECVR = -6 + integer(c_int), parameter :: CVDIAG_RHSFUNC_RECVR = -7 + + ! ================================================================= + ! C V D I R E C T C O N S T A N T S + ! ================================================================= + + ! ----------------------------------------------------------------- + ! CVDLS return values + ! ----------------------------------------------------------------- + + integer(c_int), parameter :: CVDLS_SUCCESS = 0 + integer(c_int), parameter :: CVDLS_MEM_NULL = -1 + integer(c_int), parameter :: CVDLS_LMEM_NULL = -2 + integer(c_int), parameter :: CVDLS_ILL_INPUT = -3 + integer(c_int), parameter :: CVDLS_MEM_FAIL = -4 + + ! Additional last_flag values + integer(c_int), parameter :: CVDLS_JACFUNC_UNRECVR = -5 + integer(c_int), parameter :: CVDLS_JACFUNC_RECVR = -6 + + ! ================================================================= + ! C V S P A R S E C O N S T A N T S + ! ================================================================= + + ! ----------------------------------------------------------------- + ! CVSLS return values + ! ----------------------------------------------------------------- + + integer(c_int), parameter :: CVSLS_SUCCESS = 0 + integer(c_int), parameter :: CVSLS_MEM_NULL = -1 + integer(c_int), parameter :: CVSLS_LMEM_NULL = -2 + integer(c_int), parameter :: CVSLS_ILL_INPUT = -3 + integer(c_int), parameter :: CVSLS_MEM_FAIL = -4 + integer(c_int), parameter :: CVSLS_JAC_NOSET = -5 + integer(c_int), parameter :: CVSLS_PACKAGE_FAIL = -6 + + ! Additional last_flag values + integer(c_int), parameter :: CVSLS_JACFUNC_UNRECVR = -7 + integer(c_int), parameter :: CVSLS_JACFUNC_RECVR = -8 + + ! Return values for the adjoint module + integer(c_int), parameter :: CVSLS_NO_ADJ = -101 + integer(c_int), parameter :: CVSLS_LMEMB_NULL = -102 + + ! ================================================================= + ! C V S P I L S C O N S T A N T S + ! ================================================================= + + ! ----------------------------------------------------------------- + ! CVSPILS return values + ! ----------------------------------------------------------------- + + integer(c_int), parameter :: CVSPILS_SUCCESS = 0 + integer(c_int), parameter :: CVSPILS_MEM_NULL = -1 + integer(c_int), parameter :: CVSPILS_LMEM_NULL = -2 + integer(c_int), parameter :: CVSPILS_ILL_INPUT = -3 + integer(c_int), parameter :: CVSPILS_MEM_FAIL = -4 + integer(c_int), parameter :: CVSPILS_PMEM_NULL = -5 + + ! ================================================================= + ! U S E R - C A L L A B L E R O U T I N E S + ! ================================================================= + + interface + ! ================================================================= + ! Interfaces from cvode.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVodeCreate + ! ----------------------------------------------------------------- + ! FCVodeCreate creates an internal memory block for a problem to + ! be solved by CVODE. + ! + ! lmm is the type of linear multistep method to be used. + ! The legal values are CV_ADAMS and CV_BDF (see previous + ! description). + ! + ! iter is the type of iteration used to solve the nonlinear + ! system that arises during each internal time step. + ! The legal values are CV_FUNCTIONAL and CV_NEWTON. + ! + ! If successful, FCVodeCreate returns a pointer to initialized + ! problem memory. This pointer should be passed to FCVodeInit. + ! If an initialization error occurs, FCVodeCreate prints an error + ! message to standard err and returns NULL. + ! ----------------------------------------------------------------- + + type(c_ptr) function FCVodeCreate(lmm, iter) & + bind(C,name='CVodeCreate') + use, intrinsic :: iso_c_binding + implicit none + integer(c_int), value :: lmm + integer(c_int), value :: iter + end function FCVodeCreate + + ! ----------------------------------------------------------------- + ! Integrator optional input specification functions + ! ----------------------------------------------------------------- + ! The following functions can be called to set optional inputs + ! to values other than the defaults given below: + ! + ! Function | Optional input / [ default value ] + ! ----------------------------------------------------------------- + ! | + ! FCVodeSetErrHandlerFn | user-provided ErrHandler function. + ! | [internal] + ! | + ! FCVodeSetErrFile | the file pointer for an error file + ! | where all CVODE warning and error + ! | messages will be written if the default + ! | internal error handling function is used. + ! | This parameter can be stdout (standard + ! | output), stderr (standard error), or a + ! | file pointer (corresponding to a user + ! | error file opened for writing) returned + ! | by fopen. + ! | If not called, then all messages will + ! | be written to the standard error stream. + ! | [stderr] + ! | + ! FCVodeSetUserData | a pointer to user data that will be + ! | passed to the user's f function every + ! | time f is called. + ! | [NULL] + ! | + ! FCVodeSetMaxOrd | maximum lmm order to be used by the + ! | solver. + ! | [12 for Adams , 5 for BDF] + ! | + ! FCVodeSetMaxNumSteps | maximum number of internal steps to be + ! | taken by the solver in its attempt to + ! | reach tout. + ! | [500] + ! | + ! FCVodeSetMaxHnilWarns | maximum number of warning messages + ! | issued by the solver that t+h==t on the + ! | next internal step. A value of -1 means + ! | no such messages are issued. + ! | [10] + ! | + ! FCVodeSetStabLimDet | flag to turn on/off stability limit + ! | detection (TRUE = on, FALSE = off). + ! | When BDF is used and order is 3 or + ! | greater, CVsldet is called to detect + ! | stability limit. If limit is detected, + ! | the order is reduced. + ! | [FALSE] + ! | + ! FCVodeSetInitStep | initial step size. + ! | [estimated by CVODE] + ! | + ! FCVodeSetMinStep | minimum absolute value of step size + ! | allowed. + ! | [0.0] + ! | + ! FCVodeSetMaxStep | maximum absolute value of step size + ! | allowed. + ! | [infinity] + ! | + ! FCVodeSetStopTime | the independent variable value past + ! | which the solution is not to proceed. + ! | [infinity] + ! | + ! FCVodeSetMaxErrTestFails | Maximum number of error test failures + ! | in attempting one step. + ! | [7] + ! | + ! FCVodeSetMaxNonlinIters | Maximum number of nonlinear solver + ! | iterations at one solution. + ! | [3] + ! | + ! FCVodeSetMaxConvFails | Maximum number of convergence failures + ! | allowed in attempting one step. + ! | [10] + ! | + ! FCVodeSetNonlinConvCoef | Coefficient in the nonlinear + ! | convergence test. + ! | [0.1] + ! | + ! ----------------------------------------------------------------- + ! | + ! FCVodeSetIterType | Changes the current nonlinear iteration + ! | type. + ! | [set by FCVodecreate] + ! | + ! ----------------------------------------------------------------- + ! | + ! FCVodeSetRootDirection | Specifies the direction of zero + ! | crossings to be monitored + ! | [both directions] + ! | + ! FCVodeSetNoInactiveRootWarn | disable warning about possible + ! | g==0 at beginning of integration + ! | + ! ----------------------------------------------------------------- + + ! ----------------------------------------------------------------- + ! Return flag: + ! CV_SUCCESS if successful + ! CV_MEM_NULL if the cvode memory is NULL + ! CV_ILL_INPUT if an argument has an illegal value + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeSetErrHandlerFn(cvode_mem, ehfun, eh_data) & + bind(C,name='CVodeSetErrHandlerFn') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_funptr), value :: ehfun + type(c_ptr), value :: eh_data + end function FCVodeSetErrHandlerFn + + ! >>> NOT CURRENTLY IMPLEMENTED IN FORTRAN INTERFACE + ! int CVodeSetErrFile(void *cvode_mem, FILE *errfp); + + integer(c_int) function FCVodeSetUserData(cvode_mem, user_data) & + bind(C,name='CVodeSetUserData') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_ptr), value :: user_data + end function FCVodeSetUserData + + integer(c_int) function FCVodeSetMaxOrd(cvode_mem, maxord) & + bind(C,name='CVodeSetMaxOrd') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: maxord + end function FCVodeSetMaxOrd + + integer(c_int) function FCVodeSetMaxNumSteps(cvode_mem, mxsteps) & + bind(C,name='CVodeSetMaxNumSteps') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long), value :: mxsteps + end function FCVodeSetMaxNumSteps + + integer(c_int) function FCVodeSetMaxHnilWarns(cvode_mem, mxhnil) & + bind(C,name='CVodeSetMaxHnilWarns') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: mxhnil + end function FCVodeSetMaxHnilWarns + + integer(c_int) function FCVodeSetStabLimDet(cvode_mem, stldet) & + bind(C,name='CVodeSetStabLimDet') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: stldet + end function FCVodeSetStabLimDet + + integer(c_int) function FCVodeSetInitStep(cvode_mem, hin) & + bind(C,name='CVodeSetInitStep') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: hin + end function FCVodeSetInitStep + + integer(c_int) function FCVodeSetMinStep(cvode_mem, hmin) & + bind(C,name='CVodeSetMinStep') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: hmin + end function FCVodeSetMinStep + + integer(c_int) function FCVodeSetMaxStep(cvode_mem, hmax) & + bind(C,name='CVodeSetMaxStep') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: hmax + end function FCVodeSetMaxStep + + integer(c_int) function FCVodeSetStopTime(cvode_mem, tstop) & + bind(C,name='CVodeSetStopTime') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: tstop + end function FCVodeSetStopTime + + integer(c_int) function FCVodeSetMaxErrTestFails(cvode_mem, maxnef) & + bind(C,name='CVodeSetMaxErrTestFails') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: maxnef + end function FCVodeSetMaxErrTestFails + + integer(c_int) function FCVodeSetMaxNonlinIters(cvode_mem, maxcor) & + bind(C,name='CVodeSetMaxNonlinIters') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: maxcor + end function FCVodeSetMaxNonlinIters + + integer(c_int) function FCVodeSetMaxConvFails(cvode_mem, maxncf) & + bind(C,name='CVodeSetMaxConvFails') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: maxncf + end function FCVodeSetMaxConvFails + + integer(c_int) function FCVodeSetNonlinConvCoef(cvode_mem, nlscoef) & + bind(C,name='CVodeSetNonlinConvCoef') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: nlscoef + end function FCVodeSetNonlinConvCoef + + integer(c_int) function FCVodeSetIterType(cvode_mem, iter) & + bind(C,name='CVodeSetIterType') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: iter + end function FCVodeSetIterType + + integer(c_int) function FCVodeSetRootDirection(cvode_mem, rootdir) & + bind(C,name='CVodeSetRootDirection') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double) :: rootdir + end function FCVodeSetRootDirection + + integer(c_int) function FCVodeSetNoInactiveRootWarn(cvode_mem) & + bind(C,name='CVodeSetNoInactiveRootWarn') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + end function FCVodeSetNoInactiveRootWarn + + ! ----------------------------------------------------------------- + ! Function : FCVodeInit + ! ----------------------------------------------------------------- + ! FCVodeInit allocates and initializes memory for a problem to + ! to be solved by CVODE. + ! + ! cvode_mem is pointer to CVODE memory returned by FCVodeCreate. + ! + ! f is the name of the C function defining the right-hand + ! side function in y' = f(t,y). + ! + ! t0 is the initial value of t. + ! + ! y0 is the initial condition vector y(t0). + ! + ! Return flag: + ! CV_SUCCESS if successful + ! CV_MEM_NULL if the cvode memory was NULL + ! CV_MEM_FAIL if a memory allocation failed + ! CV_ILL_INPUT f an argument has an illegal value. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeInit(cvode_mem, f, t0, y0) & + bind(C,name='CVodeInit') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_funptr), value :: f + real(c_double), value :: t0 + type(c_ptr), value :: y0 + end function FCVodeInit + + ! ----------------------------------------------------------------- + ! Function : FCVodeReInit + ! ----------------------------------------------------------------- + ! FCVodeReInit re-initializes CVode for the solution of a problem, + ! where a prior call to FCVodeInit has been made with the same + ! problem size N. FCVodeReInit performs the same input checking + ! and initializations that FCVodeInit does. + ! But it does no memory allocation, assuming that the existing + ! internal memory is sufficient for the new problem. + ! + ! The use of FCVodeReInit requires that the maximum method order, + ! maxord, is no larger for the new problem than for the problem + ! specified in the last call to FCVodeInit. This condition is + ! automatically fulfilled if the multistep method parameter lmm + ! is unchanged (or changed from CV_ADAMS to CV_BDF) and the default + ! value for maxord is specified. + ! + ! All of the arguments to FCVodeReInit have names and meanings + ! identical to those of FCVodeInit. + ! + ! The return value of FCVodeReInit is equal to CV_SUCCESS = 0 if + ! there were no errors; otherwise it is a negative int equal to: + ! CV_MEM_NULL indicating cvode_mem was NULL (i.e., + ! FCVodeCreate has not been called). + ! CV_NO_MALLOC indicating that cvode_mem has not been + ! allocated (i.e., FCVodeInit has not been + ! called). + ! CV_ILL_INPUT indicating an input argument was illegal + ! (including an attempt to increase maxord). + ! In case of an error return, an error message is also printed. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeReInit(cvode_mem, t0, y0) & + bind(C,name='CVodeReInit') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: t0 + type(c_ptr), value :: y0 + end function FCVodeReInit + + ! ----------------------------------------------------------------- + ! Functions : FCVodeSStolerances + ! FCVodeSVtolerances + ! FCVodeWFtolerances + ! ----------------------------------------------------------------- + ! + ! These functions specify the integration tolerances. One of them + ! MUST be called before the first call to CVode. + ! + ! FCVodeSStolerances specifies scalar relative and absolute tolerances. + ! FCVodeSVtolerances specifies scalar relative tolerance and a vector + ! absolute tolerance (a potentially different absolute tolerance + ! for each vector component). + ! FCVodeWFtolerances specifies a user-provides function (of type CVEwtFn) + ! which will be called to set the error weight vector. + ! + ! The tolerances reltol and abstol define a vector of error weights, + ! ewt, with components + ! ewt[i] = 1/(reltol*abs(y[i]) + abstol) (in the SS case), or + ! ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (in the SV case). + ! This vector is used in all error and convergence tests, which + ! use a weighted RMS norm on all error-like vectors v: + ! WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), + ! where N is the problem dimension. + ! + ! The return value of these functions is equal to CV_SUCCESS = 0 if + ! there were no errors; otherwise it is a negative int equal to: + ! CV_MEM_NULL indicating cvode_mem was NULL (i.e., + ! FCVodeCreate has not been called). + ! CV_NO_MALLOC indicating that cvode_mem has not been + ! allocated (i.e., FCVodeInit has not been + ! called). + ! CV_ILL_INPUT indicating an input argument was illegal + ! (e.g. a negative tolerance) + ! In case of an error return, an error message is also printed. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeSStolerances(cvode_mem, reltol, abstol) & + bind(C,name='CVodeSStolerances') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: reltol + real(c_double), value :: abstol + end function FCVodeSStolerances + + integer(c_int) function FCVodeSVtolerances(cvode_mem, reltol, abstol) & + bind(C,name='CVodeSVtolerances') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: reltol + type(c_ptr), value :: abstol + end function FCVodeSVtolerances + + integer(c_int) function FCVodeWFtolerances(cvode_mem, efun) & + bind(C,name='CVodeWFtolerances') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_funptr), value :: efun + end function FCVodeWFtolerances + + ! ----------------------------------------------------------------- + ! Function : FCVodeRootInit + ! ----------------------------------------------------------------- + ! FCVodeRootInit initializes a rootfinding problem to be solved + ! during the integration of the ODE system. It must be called + ! after FCVodeCreate, and before CVode. The arguments are: + ! + ! cvode_mem = pointer to CVODE memory returned by FCVodeCreate. + ! + ! nrtfn = number of functions g_i, an int >= 0. + ! + ! g = name of user-supplied function, of type CVRootFn, + ! defining the functions g_i whose roots are sought. + ! + ! If a new problem is to be solved with a call to FCVodeReInit, + ! where the new problem has no root functions but the prior one + ! did, then call FCVodeRootInit with nrtfn = 0. + ! + ! The return value of FCVodeRootInit is CV_SUCCESS = 0 if there were + ! no errors; otherwise it is a negative int equal to: + ! CV_MEM_NULL indicating cvode_mem was NULL, or + ! CV_MEM_FAIL indicating a memory allocation failed. + ! (including an attempt to increase maxord). + ! CV_ILL_INPUT indicating nrtfn > 0 but g = NULL. + ! In case of an error return, an error message is also printed. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeRootInit(cvode_mem, nrtfn, g) & + bind(C,name='CVodeRootInit') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: nrtfn + type(c_funptr), value :: g + end function FCVodeRootInit + + ! ----------------------------------------------------------------- + ! Function : FCVode + ! ----------------------------------------------------------------- + ! FCVode integrates the ODE over an interval in t. + ! If itask is CV_NORMAL, then the solver integrates from its + ! current internal t value to a point at or beyond tout, then + ! interpolates to t = tout and returns y(tout) in the user- + ! allocated vector yout. If itask is CV_ONE_STEP, then the solver + ! takes one internal time step and returns in yout the value of + ! y at the new internal time. In this case, tout is used only + ! during the first call to CVode to determine the direction of + ! integration and the rough scale of the t variable. If tstop is + ! enabled (through a call to FCVodeSetStopTime), then CVode returns + ! the solution at tstop. Once the integrator returns at a tstop + ! time, any future testing for tstop is disabled (and can be + ! reenabled only though a new call to FCVodeSetStopTime). + ! The time reached by the solver is placed in (*tret). The + ! user is responsible for allocating the memory for this value. + ! + ! cvode_mem is the pointer to CVODE memory returned by + ! FCVodeCreate. + ! + ! tout is the next time at which a computed solution is desired. + ! + ! yout is the computed solution vector. In CV_NORMAL mode with no + ! errors and no roots found, yout=y(tout). + ! + ! tret is a pointer to a real location. CVode sets (*tret) to + ! the time reached by the solver and returns + ! yout=y(*tret). + ! + ! itask is CV_NORMAL or CV_ONE_STEP. These two modes are described above. + ! + ! Here is a brief description of each return value: + ! + ! CV_SUCCESS: CVode succeeded and no roots were found. + ! + ! CV_ROOT_RETURN: CVode succeeded, and found one or more roots. + ! If nrtfn > 1, call FCVodeGetRootInfo to see + ! which g_i were found to have a root at (*tret). + ! + ! CV_TSTOP_RETURN: CVode succeeded and returned at tstop. + ! + ! CV_MEM_NULL: The cvode_mem argument was NULL. + ! + ! CV_NO_MALLOC: cvode_mem was not allocated. + ! + ! CV_ILL_INPUT: One of the inputs to FCVode is illegal. This + ! includes the situation when a component of the + ! error weight vectors becomes < 0 during + ! internal time-stepping. It also includes the + ! situation where a root of one of the root + ! functions was found both at t0 and very near t0. + ! The ILL_INPUT flag will also be returned if the + ! linear solver routine CV--- (called by the user + ! after calling FCVodeCreate) failed to set one of + ! the linear solver-related fields in cvode_mem or + ! if the linear solver's init routine failed. In + ! any case, the user should see the printed + ! error message for more details. + ! + ! CV_TOO_MUCH_WORK: The solver took mxstep internal steps but + ! could not reach tout. The default value for + ! mxstep is MXSTEP_DEFAULT = 500. + ! + ! CV_TOO_MUCH_ACC: The solver could not satisfy the accuracy + ! demanded by the user for some internal step. + ! + ! CV_ERR_FAILURE: Error test failures occurred too many times + ! (= MXNEF = 7) during one internal time step or + ! occurred with |h| = hmin. + ! + ! CV_CONV_FAILURE: Convergence test failures occurred too many + ! times (= MXNCF = 10) during one internal time + ! step or occurred with |h| = hmin. + ! + ! CV_LINIT_FAIL: The linear solver's initialization function + ! failed. + ! + ! CV_LSETUP_FAIL: The linear solver's setup routine failed in an + ! unrecoverable manner. + ! + ! CV_LSOLVE_FAIL: The linear solver's solve routine failed in an + ! unrecoverable manner. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVode(cvode_mem, tout, yout, tret, itask) & + bind(C,name='CVode') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: tout + type(c_ptr), value :: yout + real(c_double) :: tret + integer(c_int), value :: itask + end function FCVode + + ! ----------------------------------------------------------------- + ! Function : FCVodeGetDky + ! ----------------------------------------------------------------- + ! FCVodeGetDky computes the kth derivative of the y function at + ! time t, where tn-hu <= t <= tn, tn denotes the current + ! internal time reached, and hu is the last internal step size + ! successfully used by the solver. The user may request + ! k=0, 1, ..., qu, where qu is the order last used. The + ! derivative vector is returned in dky. This vector must be + ! allocated by the caller. It is only legal to call this + ! function after a successful return from CVode. + ! + ! cvode_mem is the pointer to CVODE memory returned by + ! FCVodeCreate. + ! + ! t is the time at which the kth derivative of y is evaluated. + ! The legal range for t is [tn-hu,tn] as described above. + ! + ! k is the order of the derivative of y to be computed. The + ! legal range for k is [0,qu] as described above. + ! + ! dky is the output derivative vector [((d/dy)^k)y](t). + ! + ! The return value for FCVodeGetDky is one of: + ! + ! CV_SUCCESS: FCVodeGetDky succeeded. + ! + ! CV_BAD_K: k is not in the range 0, 1, ..., qu. + ! + ! CV_BAD_T: t is not in the interval [tn-hu,tn]. + ! + ! CV_BAD_DKY: The dky argument was NULL. + ! + ! CV_MEM_NULL: The cvode_mem argument was NULL. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeGetDky(cvode_mem, t, k, dky) & + bind(C,name='CVodeGetDky') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: t + integer(c_int), value :: k + type(c_ptr), value :: dky + end function FCVodeGetDky + + ! ----------------------------------------------------------------- + ! Integrator optional output extraction functions + ! ----------------------------------------------------------------- + ! The following functions can be called to get optional outputs + ! and statistics related to the main integrator. + ! ----------------------------------------------------------------- + ! FCVodeGetWorkSpace returns the CVODE real and integer workspaces + ! FCVodeGetNumSteps returns the cumulative number of internal + ! steps taken by the solver + ! FCVodeGetNumRhsEvals returns the number of calls to the user's + ! f function + ! FCVodeGetNumLinSolvSetups returns the number of calls made to + ! the linear solver's setup routine + ! FCVodeGetNumErrTestFails returns the number of local error test + ! failures that have occured + ! FCVodeGetLastOrder returns the order used during the last + ! internal step + ! FCVodeGetCurrentOrder returns the order to be used on the next + ! internal step + ! FCVodeGetNumStabLimOrderReds returns the number of order + ! reductions due to stability limit + ! detection + ! FCVodeGetActualInitStep returns the actual initial step size + ! used by CVODE + ! FCVodeGetLastStep returns the step size for the last internal + ! step + ! FCVodeGetCurrentStep returns the step size to be attempted on + ! the next internal step + ! FCVodeGetCurrentTime returns the current internal time reached + ! by the solver + ! FCVodeGetTolScaleFactor returns a suggested factor by which the + ! user's tolerances should be scaled when + ! too much accuracy has been requested for + ! some internal step + ! FCVodeGetErrWeights returns the current error weight vector. + ! The user must allocate space for eweight. + ! FCVodeGetEstLocalErrors returns the vector of estimated local + ! errors. The user must allocate space + ! for ele. + ! FCVodeGetNumGEvals returns the number of calls to the user's + ! g function (for rootfinding) + ! FCVodeGetRootInfo returns the indices for which g_i was found to + ! have a root. The user must allocate space for + ! rootsfound. For i = 0 ... nrtfn-1, + ! rootsfound[i] = 1 if g_i has a root, and = 0 if not. + ! + ! FCVodeGet* return values: + ! CV_SUCCESS if succesful + ! CV_MEM_NULL if the cvode memory was NULL + ! CV_NO_SLDET if stability limit was not turned on + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeGetWorkSpace(cvode_mem, lenrw, leniw) & + bind(C,name='CVodeGetWorkSpace') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: lenrw + integer(c_long) :: leniw + end function FCVodeGetWorkSpace + + integer(c_int) function FCVodeGetNumSteps(cvode_mem, nsteps) & + bind(C,name='CVodeGetNumSteps') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nsteps + end function FCVodeGetNumSteps + + integer(c_int) function FCVodeGetNumRhsEvals(cvode_mem, nfevals) & + bind(C,name='CVodeGetNumRhsEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nfevals + end function FCVodeGetNumRhsEvals + + integer(c_int) function FCVodeGetNumLinSolvSetups(cvode_mem, nlinsetups) & + bind(C,name='CVodeGetNumLinSolvSetups') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nlinsetups + end function FCVodeGetNumLinSolvSetups + + integer(c_int) function FCVodeGetNumErrTestFails(cvode_mem, netfails) & + bind(C,name='CVodeGetNumErrTestFails') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: netfails + end function FCVodeGetNumErrTestFails + + integer(c_int) function FCVodeGetLastOrder(cvode_mem, qlast) & + bind(C,name='CVodeGetLastOrder') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int) :: qlast + end function FCVodeGetLastOrder + + integer(c_int) function FCVodeGetCurrentOrder(cvode_mem, qcur) & + bind(C,name='CVodeGetCurrentOrder') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int) :: qcur + end function FCVodeGetCurrentOrder + + integer(c_int) function FCVodeGetNumStabLimOrderReds(cvode_mem, nslred) & + bind(C,name='CVodeGetNumStabLimOrderReds') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nslred + end function FCVodeGetNumStabLimOrderReds + + integer(c_int) function FCVodeGetActualInitStep(cvode_mem, hinused) & + bind(C,name='CVodeGetActualInitStep') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double) :: hinused + end function FCVodeGetActualInitStep + + integer(c_int) function FCVodeGetLastStep(cvode_mem, hlast) & + bind(C,name='CVodeGetLastStep') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double) :: hlast + end function FCVodeGetLastStep + + integer(c_int) function FCVodeGetCurrentStep(cvode_mem, hcur) & + bind(C,name='CVodeGetCurrentStep') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double) :: hcur + end function FCVodeGetCurrentStep + + integer(c_int) function FCVodeGetCurrentTime(cvode_mem, tcur) & + bind(C,name='CVodeGetCurrentTime') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double) :: tcur + end function FCVodeGetCurrentTime + + integer(c_int) function FCVodeGetTolScaleFactor(cvode_mem, tolsfac) & + bind(C,name='CVodeGetTolScaleFactor') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double) :: tolsfac + end function FCVodeGetTolScaleFactor + + integer(c_int) function FCVodeGetErrWeights(cvode_mem, eweight) & + bind(C,name='CVodeGetEffWeights') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_ptr), value :: eweight + end function FCVodeGetErrWeights + + integer(c_int) function FCVodeGetEstLocalErrors(cvode_mem, ele) & + bind(C,name='CVodeGetEstLocalErrors') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_ptr), value :: ele + end function FCVodeGetEstLocalErrors + + integer(c_int) function FCVodeGetNumGEvals(cvode_mem, ngevals) & + bind(C,name='CVodeGetNumGEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: ngevals + end function FCVodeGetNumGEvals + + integer(c_int) function FCVodeGetRootInfo(cvode_mem, rootsfound) & + bind(C,name='CVodeGetRootInfo') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int) :: rootsfound + end function FCVodeGetRootInfo + + ! ----------------------------------------------------------------- + ! As a convenience, the following functions provides the + ! optional outputs in one group. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeGetIntegratorStats(cvode_mem, nsteps, nfevals, & + nlinsetups, netfails, qlast, qcur, hinused, hlast, hcur, tcur) & + bind(C,name='CVodeGetIntegratorStats') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nsteps + integer(c_long) :: nfevals + integer(c_long) :: nlinsetups + integer(c_long) :: netfails + integer(c_int) :: qlast + integer(c_int) :: qcur + real(c_double) :: hinused + real(c_double) :: hlast + real(c_double) :: hcur + real(c_double) :: tcur + end function FCVodeGetIntegratorStats + + ! ----------------------------------------------------------------- + ! Nonlinear solver optional output extraction functions + ! ----------------------------------------------------------------- + ! The following functions can be called to get optional outputs + ! and statistics related to the nonlinear solver. + ! ----------------------------------------------------------------- + ! FCVodeGetNumNonlinSolvIters returns the number of nonlinear + ! solver iterations performed. + ! FCVodeGetNumNonlinSolvConvFails returns the number of nonlinear + ! convergence failures. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeGetNumNonlinSolvIters(cvode_mem, nniters) & + bind(C,name='CVodeGetNumNonlinSolvIters') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nniters + end function FCVodeGetNumNonlinSolvIters + + integer(c_int) function FCVodeGetNumNonlinSolvConvFails(cvode_mem, nncfails) & + bind(C,name='CVodeGetNumNonlinSolvConvFails') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nncfails + end function FCVodeGetNumNonlinSolvConvFails + + ! ----------------------------------------------------------------- + ! As a convenience, the following function provides the + ! nonlinear solver optional outputs in a group. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVodeGetNonlinSolvStats(cvode_mem, nniters, nncfails) & + bind(C,name='CVodeGetNonlinSolvStats') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nniters + integer(c_long) :: nncfails + end function FCVodeGetNonlinSolvStats + + ! ----------------------------------------------------------------- + ! The following function returns the name of the constant + ! associated with a CVODE return flag + ! ----------------------------------------------------------------- + + ! >>> NOT CURRENTLY IMPLEMENTED IN FORTRAN INTERFACE + ! char* CVodeGetReturnFlagName(long int flag); + + ! ----------------------------------------------------------------- + ! Subroutine : FCVodeFree + ! ----------------------------------------------------------------- + ! FCVodeFree frees the problem memory cvode_mem allocated by + ! FCVodeCreate and FCVodeInit. Its only argument is the pointer + ! cvode_mem returned by FCVodeCreate. + ! ----------------------------------------------------------------- + + subroutine FCVodeFree(cvode_mem) & + bind(C,name='CVodeFree') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr) :: cvode_mem ! DO NOT use value attribute input is void** + end subroutine FCVodeFree + + ! ================================================================= + ! Interfaces from cvode_band.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVBand + ! ----------------------------------------------------------------- + ! A call to the FCVBand function links the main CVODE integrator + ! with the CVBAND linear solver. + ! + ! cvode_mem is the pointer to the integrator memory returned by + ! FCVodeCreate. + ! + ! N is the size of the ODE system. + ! + ! mupper is the upper bandwidth of the band Jacobian + ! approximation. + ! + ! mlower is the lower bandwidth of the band Jacobian + ! approximation. + ! + ! The return value of FCVBand is one of: + ! CVDLS_SUCCESS if successful + ! CVDLS_MEM_NULL if the cvode memory was NULL + ! CVDLS_MEM_FAIL if there was a memory allocation failure + ! CVDLS_ILL_INPUT if a required vector operation is missing or + ! if a bandwidth has an illegal value. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVBand(cvode_mem, N, mupper, mlower) & + bind(C,name='CVBand') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long), value :: N + integer(c_long), value :: mupper + integer(c_long), value :: mlower + end function FCVBand + + ! ================================================================= + ! Interfaces from cvode_bandpre.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVBandPrecInit + ! ----------------------------------------------------------------- + ! FCVBandPrecInit allocates and initializes the BANDPRE preconditioner + ! module. This functino must be called AFTER one of the SPILS linear + ! solver modules has been attached to the CVODE integrator. + ! + ! The parameters of FCVBandPrecInit are as follows: + ! + ! cvode_mem is the pointer to CVODE memory returned by FCVodeCreate. + ! + ! N is the problem size. + ! + ! mu is the upper half bandwidth. + ! + ! ml is the lower half bandwidth. + ! + ! The return value of FCVBandPrecInit is one of: + ! CVSPILS_SUCCESS if no errors occurred + ! CVSPILS_MEM_NULL if the integrator memory is NULL + ! CVSPILS_LMEM_NULL if the linear solver memory is NULL + ! CVSPILS_ILL_INPUT if an input has an illegal value + ! CVSPILS_MEM_FAIL if a memory allocation request failed + ! + ! NOTE: The band preconditioner assumes a serial implementation + ! of the NVECTOR package. Therefore, FCVBandPrecInit will + ! first test for a compatible N_Vector internal + ! representation by checking for required functions. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVBandPrecInit(cvode_mem, N, mu, ml) & + bind(C,name='CVBandPrecInit') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long), value :: N + integer(c_long), value :: mu + integer(c_long), value :: ml + end function FCVBandPrecInit + + ! ----------------------------------------------------------------- + ! Optional output functions : FCVBandPrecGet* + ! ----------------------------------------------------------------- + ! FCVBandPrecGetWorkSpace returns the real and integer work space used + ! by FCVBANDPRE. + ! FCVBandPrecGetNumRhsEvals returns the number of calls made from + ! FCVBANDPRE to the user's right-hand side + ! routine f. + ! + ! The return value of FCVBandPrecGet* is one of: + ! CVSPILS_SUCCESS if no errors occurred + ! CVSPILS_MEM_NULL if the integrator memory is NULL + ! CVSPILS_LMEM_NULL if the linear solver memory is NULL + ! CVSPILS_PMEM_NULL if the preconditioner memory is NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVBandPrecGetWorkSpace(cvode_mem, lenrwLS, leniwLS) & + bind(C,name='CVBandPrecGetWorkSpace') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: lenrwLS + integer(c_long) :: leniwLS + end function FCVBandPrecGetWorkSpace + + integer(c_int) function FCVBandPrecGetNumRhsEvals(cvode_mem, nfevalsBP) & + bind(C,name='CVBandPrecGetNumRhsEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nfevalsBP + end function FCVBandPrecGetNumRhsEvals + + ! ================================================================= + ! Interfaces from cvode_bbdpre.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVBBDPrecInit + ! ----------------------------------------------------------------- + ! FCVBBDPrecInit allocates and initializes the BBD preconditioner. + ! + ! The parameters of FCVBBDPrecInit are as follows: + ! + ! cvode_mem is the pointer to the integrator memory. + ! + ! Nlocal is the length of the local block of the vectors y etc. + ! on the current processor. + ! + ! mudq, mldq are the upper and lower half-bandwidths to be used + ! in the difference quotient computation of the local + ! Jacobian block. + ! + ! mukeep, mlkeep are the upper and lower half-bandwidths of the + ! retained banded approximation to the local Jacobian + ! block. + ! + ! dqrely is an optional input. It is the relative increment + ! in components of y used in the difference quotient + ! approximations. To specify the default, pass 0. + ! The default is dqrely = sqrt(unit roundoff). + ! + ! gloc is the name of the user-supplied function g(t,y) that + ! approximates f and whose local Jacobian blocks are + ! to form the preconditioner. + ! + ! cfn is the name of the user-defined function that performs + ! necessary interprocess communication for the + ! execution of gloc. + ! + ! The return value of FCVBBDPrecInit is one of: + ! CVSPILS_SUCCESS if no errors occurred + ! CVSPILS_MEM_NULL if the integrator memory is NULL + ! CVSPILS_LMEM_NULL if the linear solver memory is NULL + ! CVSPILS_ILL_INPUT if an input has an illegal value + ! CVSPILS_MEM_FAIL if a memory allocation request failed + ! ----------------------------------------------------------------- + + integer(c_int) function FCVBBDPrecInit(cvode_mem, Nlocal, mudq, mldq, & + mukeep, mlkeep, dqrely, gloc, cfn) & + bind(C,name='CVBBDPrecInit') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long), value :: Nlocal + integer(c_long), value :: mudq + integer(c_long), value :: mldq + integer(c_long), value :: mukeep + integer(c_long), value :: mlkeep + real(c_double), value :: dqrely + type(c_funptr), value :: gloc + type(c_funptr), value :: cfn + end function FCVBBDPrecInit + + ! ----------------------------------------------------------------- + ! Function : FCVBBDPrecReInit + ! ----------------------------------------------------------------- + ! FCVBBDPrecReInit re-initializes the BBDPRE module when solving a + ! sequence of problems of the same size with CVSPGMR/CVBBDPRE or + ! CVSPBCG/CVBBDPRE or CVSPTFQMR/CVBBDPRE provided there is no change + ! in Nlocal, mukeep, or mlkeep. After solving one problem, and after + ! calling FCVodeReInit to re-initialize the integrator for a subsequent + ! problem, call FCVBBDPrecReInit. + ! + ! All arguments have the same names and meanings as those + ! of FCVBBDPrecInit. + ! + ! The return value of FCVBBDPrecReInit is one of: + ! CVSPILS_SUCCESS if no errors occurred + ! CVSPILS_MEM_NULL if the integrator memory is NULL + ! CVSPILS_LMEM_NULL if the linear solver memory is NULL + ! CVSPILS_PMEM_NULL if the preconditioner memory is NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVBBDPrecReInit(cvode_mem, mudq, mldq, dqrely) & + bind(C,name='CVBBNPrecReInit') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long), value :: mudq + integer(c_long), value :: mldq + real(c_double), value :: dqrely + end function FCVBBDPrecReInit + + ! ----------------------------------------------------------------- + ! BBDPRE optional output extraction routines + ! ----------------------------------------------------------------- + ! FCVBBDPrecGetWorkSpace returns the BBDPRE real and integer work space + ! sizes. + ! FCVBBDPrecGetNumGfnEvals returns the number of calls to gfn. + ! + ! The return value of FCVBBDPrecGet* is one of: + ! CVSPILS_SUCCESS if no errors occurred + ! CVSPILS_MEM_NULL if the integrator memory is NULL + ! CVSPILS_LMEM_NULL if the linear solver memory is NULL + ! CVSPILS_PMEM_NULL if the preconditioner memory is NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVBBDPrecGetWorkSpace(cvode_mem, lenrwLS, leniwLS) & + bind(C,name='CVBBDPrecGetWorkSpace') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: lenrwLS + integer(c_long) :: leniwLS + end function FCVBBDPrecGetWorkSpace + + integer(c_int) function FCVBBDPrecGetNumGfnEvals(cvode_mem, ngevalsBBDP) & + bind(C,name='CVBBDPrecGetNumGfnEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: ngevalsBBDP + end function FCVBBDPrecGetNumGfnEvals + + ! ================================================================= + ! Interfaces from cvode_dense.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function: FCVDense + ! ----------------------------------------------------------------- + ! A call to the FCVDense function links the main integrator with + ! the CVDENSE linear solver. + ! + ! cvode_mem is the pointer to the integrator memory returned by + ! FCVodeCreate. + ! + ! N is the size of the ODE system. + ! + ! The return value of FCVDense is one of: + ! CVDLS_SUCCESS if successful + ! CVDLS_MEM_NULL if the cvode memory was NULL + ! CVDLS_MEM_FAIL if there was a memory allocation failure + ! CVDLS_ILL_INPUT if a required vector operation is missing + ! ----------------------------------------------------------------- + + integer(c_int) function FCVDense(cvode_mem, N) & + bind(C,name='CVDense') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long), value :: N + end function FCVDense + + ! ================================================================= + ! Interfaces from cvode_diag.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVDiag + ! ----------------------------------------------------------------- + ! A call to the FCVDiag function links the main integrator with + ! the CVDIAG linear solver. + ! + ! cvode_mem is the pointer to the integrator memory returned by + ! FCVodeCreate. + ! + ! The return value of FCVDiag is one of: + ! CVDIAG_SUCCESS if successful + ! CVDIAG_MEM_NULL if the cvode memory was NULL + ! CVDIAG_MEM_FAIL if there was a memory allocation failure + ! CVDIAG_ILL_INPUT if a required vector operation is missing + ! ----------------------------------------------------------------- + + integer(c_int) function FCVDiag(cvode_mem) & + bind(C,name='CVDiag') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + end function FCVDiag + + ! ----------------------------------------------------------------- + ! Optional outputs from the CVDIAG linear solver + ! ----------------------------------------------------------------- + ! + ! FCVDiagGetWorkSpace returns the real and integer workspace used + ! by CVDIAG. + ! FCVDiagGetNumRhsEvals returns the number of calls to the user + ! f routine due to finite difference Jacobian + ! evaluation. + ! Note: The number of diagonal approximate + ! Jacobians formed is equal to the number of + ! CVDiagSetup calls. This number is available + ! through FCVodeGetNumLinSolvSetups. + ! FCVDiagGetLastFlag returns the last error flag set by any of + ! the CVDIAG interface functions. + ! + ! The return value of FCVDiagGet* is one of: + ! CVDIAG_SUCCESS if successful + ! CVDIAG_MEM_NULL if the cvode memory was NULL + ! CVDIAG_LMEM_NULL if the cvdiag memory was NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVDiagGetWorkSpace(cvode_mem, lenrwLS, leniwLS) & + bind(C,name='CVDiagGetWorkSpace') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: lenrwLS + integer(c_long) :: leniwLS + end function FCVDiagGetWorkSpace + + integer(c_int) function FCVDiagGetNumRhsEvals(cvode_mem, nfevalsLS) & + bind(C,name='CVDiagGetNumRhsEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nfevalsLS + end function FCVDiagGetNumRhsEvals + + integer(c_int) function FCVDiagGetLastFlag(cvode_mem, flag) & + bind(C,name='CVDiagGetLastFlag') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: flag + end function FCVDiagGetLastFlag + + ! ----------------------------------------------------------------- + ! The following function returns the name of the constant + ! associated with a CVDIAG return flag + ! ----------------------------------------------------------------- + + ! >>> NOT CURRENTLY IMPLEMENTED IN FORTRAN INTERFACE + ! char* CVDiagGetReturnFlagName(long int flag); + + ! ================================================================= + ! Interfaces from cvode_direct.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Optional inputs to the CVDLS linear solver + ! ----------------------------------------------------------------- + ! + ! FCVDlsSetDenseJacFn specifies the dense Jacobian approximation + ! routine to be used for a direct dense linear solver. + ! + ! FCVDlsSetBandJacFn specifies the band Jacobian approximation + ! routine to be used for a direct band linear solver. + ! + ! By default, a difference quotient approximation, supplied with + ! the solver is used. + ! + ! The return value is one of: + ! CVDLS_SUCCESS if successful + ! CVDLS_MEM_NULL if the CVODE memory was NULL + ! CVDLS_LMEM_NULL if the linear solver memory was NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVDlsSetDenseJacFn(cvode_mem, jac) & + bind(C,name='CVDlsSetDenseJacFn') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_funptr), value :: jac + end function FCVDlsSetDenseJacFn + + integer(c_int) function FCVDlsSetBandJacFn(cvode_mem, jac) & + bind(C,name='CVDlsSetBandJacFn') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_funptr), value :: jac + end function FCVDlsSetBandJacFn + + ! ----------------------------------------------------------------- + ! Optional outputs from the CVDLS linear solver + ! ----------------------------------------------------------------- + ! + ! FCVDlsGetWorkSpace returns the real and integer workspace used + ! by the direct linear solver. + ! FCVDlsGetNumJacEvals returns the number of calls made to the + ! Jacobian evaluation routine jac. + ! FCVDlsGetNumRhsEvals returns the number of calls to the user + ! f routine due to finite difference Jacobian + ! evaluation. + ! FCVDlsGetLastFlag returns the last error flag set by any of + ! the CVDLS interface functions. + ! + ! The return value of FCVDlsGet* is one of: + ! CVDLS_SUCCESS if successful + ! CVDLS_MEM_NULL if the CVODE memory was NULL + ! CVDLS_LMEM_NULL if the linear solver memory was NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVDlsGetWorkSpace(cvode_mem, lenrwLS, leniwLS) & + bind(C,name='CVDlsGetWorkSpace') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: lenrwLS + integer(c_long) :: leniwLS + end function FCVDlsGetWorkSpace + + integer(c_int) function FCVDlsGetNumJacEvals(cvode_mem, njevals) & + bind(C,name='CVDlsGetNumJacEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: njevals + end function FCVDlsGetNumJacEvals + + integer(c_int) function FCVDlsGetNumRhsEvals(cvode_mem, nfevalsLS) & + bind(C,name='CVDlsGetNumRhsEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nfevalsLS + end function FCVDlsGetNumRhsEvals + + integer(c_int) function FCVDlsGetLastFlag(cvode_mem, flag) & + bind(C,name='CVDlsGetLastFlag') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: flag + end function FCVDlsGetLastFlag + + ! ----------------------------------------------------------------- + ! The following function returns the name of the constant + ! associated with a CVDLS return flag + ! ----------------------------------------------------------------- + + ! >>> NOT CURRENTLY IMPLEMENTED IN FORTRAN INTERFACE + ! char* CVDlsGetReturnFlagName(long int flag); + + ! ================================================================= + ! Interfaces from cvode_hypamgpre.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVBoomerAMGInit + ! ----------------------------------------------------------------- + ! FCVBoomerAMGInit allocates and initializes the BBD preconditioner. + ! + ! The parameters of FCVBoomerAMGInit are as follows: + ! + ! cvode_mem is the pointer to the integrator memory. + ! + ! Nlocal is the length of the local block of the vectors y etc. + ! on the current processor. + ! + ! mudq, mldq are the upper and lower half-bandwidths to be used + ! in the difference quotient computation of the local + ! Jacobian block. + ! + ! mukeep, mlkeep are the upper and lower half-bandwidths of the + ! retained banded approximation to the local Jacobian + ! block. + ! + ! dqrely is an optional input. It is the relative increment + ! in components of y used in the difference quotient + ! approximations. To specify the default, pass 0. + ! The default is dqrely = sqrt(unit roundoff). + ! + ! gloc is the name of the user-supplied function g(t,y) that + ! approximates f and whose local Jacobian blocks are + ! to form the preconditioner. + ! + ! cfn is the name of the user-defined function that performs + ! necessary interprocess communication for the + ! execution of gloc. + ! + ! The return value of FCVBoomerAMGInit is one of: + ! CVSPILS_SUCCESS if no errors occurred + ! CVSPILS_MEM_NULL if the integrator memory is NULL + ! CVSPILS_LMEM_NULL if the linear solver memory is NULL + ! CVSPILS_ILL_INPUT if an input has an illegal value + ! CVSPILS_MEM_FAIL if a memory allocation request failed + ! ----------------------------------------------------------------- + + integer(c_int) function FCVBoomerAMGInit(cvode_mem, ilower, iupper, & + jlower, jupper, N) & + bind(C,name='CVBoomerAMGInit') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: ilower + integer(c_int), value :: iupper + integer(c_int), value :: jlower + integer(c_int), value :: jupper + integer(c_int), value :: N + end function FCVBoomerAMGInit + + ! ----------------------------------------------------------------- + ! Function : FCVBoomerAMGReInit + ! ----------------------------------------------------------------- + ! FCVBoomerAMGReInit re-initializes the HYPRE_BOOMERAMG module when solving a + ! sequence of problems of the same size with CVSPGMR/CVHYPRE_BOOMERAMG or + ! CVSPBCG/CVHYPRE_BOOMERAMG or CVSPTFQMR/CVHYPRE_BOOMERAMG provided there is no change + ! in Nlocal, mukeep, or mlkeep. After solving one problem, and after + ! calling FCVodeReInit to re-initialize the integrator for a subsequent + ! problem, call FCVBoomerAMGReInit. + ! + ! All arguments have the same names and meanings as those + ! of FCVBoomerAMGInit. + ! + ! The return value of FCVBoomerAMGReInit is one of: + ! CVSPILS_SUCCESS if no errors occurred + ! CVSPILS_MEM_NULL if the integrator memory is NULL + ! CVSPILS_LMEM_NULL if the linear solver memory is NULL + ! CVSPILS_PMEM_NULL if the preconditioner memory is NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVBoomerAMGReInit(cvode_mem, mudq, mldq, dqrely) & + bind(C,name='CVBoomerAMGReInit') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long), value :: mudq + integer(c_long), value :: mldq + real(c_double), value :: dqrely + end function FCVBoomerAMGReInit + + ! ----------------------------------------------------------------- + ! HYPRE_BOOMERAMG optional output extraction routines + ! ----------------------------------------------------------------- + ! FCVBoomerAMGGetWorkSpace returns the HYPRE_BOOMERAMG real and integer work space + ! sizes. + ! FCVBoomerAMGGetNumGfnEvals returns the number of calls to gfn. + ! + ! The return value of FCVBoomerAMGGet* is one of: + ! CVSPILS_SUCCESS if no errors occurred + ! CVSPILS_MEM_NULL if the integrator memory is NULL + ! CVSPILS_LMEM_NULL if the linear solver memory is NULL + ! CVSPILS_PMEM_NULL if the preconditioner memory is NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVBoomerAMGGetWorkSpace(cvode_mem, lenrwLS, leniwLS) & + bind(C,name='CVBoomerAMGGetWorkSpace') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: lenrwLS + integer(c_long) :: leniwLS + end function FCVBoomerAMGGetWorkSpace + + integer(c_int) function FCVBoomerAMGGetNumGfnEvals(cvode_mem, ngevalsBBDP) & + bind(C,name='CVBoomerAMGGetNumGfnEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: ngevalsBBDP + end function FCVBoomerAMGGetNumGfnEvals + + ! ================================================================= + ! Interfaces from cvode_klu.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVKLU + ! ----------------------------------------------------------------- + ! A call to the FCVKLU function links the main integrator + ! with the CVKLU linear solver module. + ! + ! cv_mem is the pointer to integrator memory returned by + ! FCVCreate. + ! + ! + ! FCVKLU returns: + ! CVSLU_SUCCESS = 0 if successful + ! CVSLU_LMEM_FAIL = -1 if there was a memory allocation failure + ! CVSLU_ILL_INPUT = -2 if NVECTOR found incompatible + ! + ! NOTE: The KLU linear solver assumes a serial implementation + ! of the NVECTOR package. Therefore, CVKLU will first + ! test for a compatible N_Vector internal representation + ! by checking that the functions N_VGetArrayPointer and + ! N_VSetArrayPointer exist. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVKLU(cvode_mem, n, nnz, sparsetype) & + bind(C,name='CVKLU') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: n + integer(c_int), value :: nnz + integer(c_int), value :: sparsetype + end function FCVKLU + + ! ----------------------------------------------------------------- + ! FCVKLUReInit + ! ----------------------------------------------------------------- + ! This routine reinitializes memory and flags for a new factorization + ! (symbolic and numeric) to be conducted at the next solver setup + ! call. This routine is useful in the cases where the number of nonzeroes + ! has changed or if the structure of the linear system has changed + ! which would require a new symbolic (and numeric factorization). + ! + ! The reinit_type argumenmt governs the level of reinitialization: + ! + ! reinit_type = 1: The Jacobian matrix will be destroyed and + ! a new one will be allocated based on the nnz + ! value passed to this call. New symbolic and + ! numeric factorizations will be completed at the next + ! solver setup. + ! + ! reinit_type = 2: Only symbolic and numeric factorizations will be + ! completed. It is assumed that the Jacobian size + ! has not exceeded the size of nnz given in the prior + ! call to FCVKLU. + ! + ! This routine assumes no other changes to solver use are necessary. + ! + ! The return value is CVSLS_SUCCESS = 0, CVSLS_MEM_NULL = -1, + ! CVSLS_LMEM_NULL = -2, CVSLS_ILL_INPUT = -3, or CVSLS_MEM_FAIL = -4. + ! + ! ----------------------------------------------------------------- + + integer(c_int) function FCVKLUReInit(cvode_mem, n, nnz, reinit_type) & + bind(C,name='CVKLUReInit') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: n + integer(c_int), value :: nnz + integer(c_int), value :: reinit_type + end function FCVKLUReInit + + ! ----------------------------------------------------------------- + ! Optional Input Specification Functions + ! ----------------------------------------------------------------- + ! + ! FCVKLUSetOrdering sets the ordering used by KLU for reducing fill. + ! Options are: 0 for AMD, 1 for COLAMD, and 2 for the natural ordering. + ! The default used in CVODE is 1 for COLAMD. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVKLUSetOrdering(cvode_mem, ordering_choice) & + bind(C,name='CVKLUSetOrdering') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: ordering_choice + end function FCVKLUSetOrdering + + ! ================================================================= + ! Interfaces from cvode_lapack.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVLapackDense + ! ----------------------------------------------------------------- + ! A call to the FCVLapackDense function links the main integrator + ! with the CVLAPACK linear solver using dense Jacobians. + ! + ! cvode_mem is the pointer to the integrator memory returned by + ! FCVodeCreate. + ! + ! N is the size of the ODE system. + ! + ! The return value of FCVLapackDense is one of: + ! CVLAPACK_SUCCESS if successful + ! CVLAPACK_MEM_NULL if the CVODE memory was NULL + ! CVLAPACK_MEM_FAIL if there was a memory allocation failure + ! CVLAPACK_ILL_INPUT if a required vector operation is missing + ! ----------------------------------------------------------------- + + integer(c_int) function FCVLapackDense(cvode_mem, N) & + bind(C,name='CVLapackDense') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: N + end function FCVLapackDense + + ! ----------------------------------------------------------------- + ! Function : CVLapackBand + ! ----------------------------------------------------------------- + ! A call to the FCVLapackBand function links the main integrator + ! with the CVLAPACK linear solver using banded Jacobians. + ! + ! cvode_mem is the pointer to the integrator memory returned by + ! FCVodeCreate. + ! + ! N is the size of the ODE system. + ! + ! mupper is the upper bandwidth of the band Jacobian approximation. + ! + ! mlower is the lower bandwidth of the band Jacobian approximation. + ! + ! The return value of FCVLapackBand is one of: + ! CVLAPACK_SUCCESS if successful + ! CVLAPACK_MEM_NULL if the CVODE memory was NULL + ! CVLAPACK_MEM_FAIL if there was a memory allocation failure + ! CVLAPACK_ILL_INPUT if a required vector operation is missing or + ! if a bandwidth has an illegal value. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVLapackBand(cvode_mem, N, mupper, mlower) & + bind(C,name='CVLapackBand') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: N + integer(c_int), value :: mupper + integer(c_int), value :: mlower + end function FCVLapackBand + + ! ================================================================= + ! Interfaces from cvode_sparse.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Optional inputs to the CVSPARSE linear solver + ! ----------------------------------------------------------------- + ! FCVSlsSetSparseJacFn specifies the Jacobian approximation + ! routine to be used for a sparse direct linear solver. + ! + ! The return value is one of: + ! CVSLS_SUCCESS if successful + ! CVSLS_MEM_NULL if the CVODE memory was NULL + ! CVSLS_LMEM_NULL if the linear solver memory was NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVSlsSetSparseJacFn(cvode_mem, jac) & + bind(C,name='CVSlsSetSparseJacFn') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_funptr), value :: jac + end function FCVSlsSetSparseJacFn + + ! ----------------------------------------------------------------- + ! Optional outputs from the CVSLS linear solver + ! ----------------------------------------------------------------- + ! + ! FCVSlsGetNumJacEvals returns the number of calls made to the + ! Jacobian evaluation routine jac. + ! FCVSlsGetLastFlag returns the last error flag set by any of + ! the IDADLS interface functions. + ! + ! The return value of IDADlsGet* is one of: + ! CVSLS_SUCCESS if successful + ! CVSLS_MEM_NULL if the IDA memory was NULL + ! CVSLS_LMEM_NULL if the linear solver memory was NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVSlsGetNumJacEvals(cvode_mem, njevals) & + bind(C,name='CVSlsGetNumJacEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: njevals + end function FCVSlsGetNumJacEvals + + integer(c_int) function FCVSlsGetLastFlag(cvode_mem, flag) & + bind(C,name='CVSlsGetLastFlag') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: flag + end function FCVSlsGetLastFlag + + ! ----------------------------------------------------------------- + ! The following function returns the name of the constant + ! associated with a CVSLS return flag + ! ----------------------------------------------------------------- + + ! >>> NOT CURRENTLY IMPLEMENTED IN FORTRAN INTERFACE + ! char* CVSlsGetReturnFlagName(long int flag); + + ! ================================================================= + ! Interfaces from cvode_spbcgs.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVSpbcg + ! ----------------------------------------------------------------- + ! A call to the FCVSpbcg function links the main CVODE integrator + ! with the CVSPBCG linear solver. + ! + ! cvode_mem is the pointer to the integrator memory returned by + ! FCVodeCreate. + ! + ! pretype is the type of user preconditioning to be done. + ! This must be one of the four enumeration constants + ! PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined + ! in iterative.h. These correspond to no preconditioning, + ! left preconditioning only, right preconditioning + ! only, and both left and right preconditioning, + ! respectively. + ! + ! maxl is the maximum Krylov dimension. This is an + ! optional input to the CVSPBCG solver. Pass 0 to + ! use the default value CVSPBCG_MAXL=5. + ! + ! The return value of FCVSpbcg is one of: + ! CVSPILS_SUCCESS if successful + ! CVSPILS_MEM_NULL if the cvode memory was NULL + ! CVSPILS_MEM_FAIL if there was a memory allocation failure + ! CVSPILS_ILL_INPUT if a required vector operation is missing + ! The above constants are defined in cvode_spils.h + ! + ! ----------------------------------------------------------------- + + integer(c_int) function FCVSpbcg(cvode_mem, pretype, maxl) & + bind(C,name='CVSpbcg') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: pretype + integer(c_int), value :: maxl + end function FCVSpbcg + + ! ================================================================= + ! Interfaces from cvode_spgmr.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVSpgmr + ! ----------------------------------------------------------------- + ! A call to the FCVSpgmr function links the main CVODE integrator + ! with the CVSPGMR linear solver. + ! + ! cvode_mem is the pointer to the integrator memory returned by + ! FCVodeCreate. + ! + ! pretype is the type of user preconditioning to be done. + ! This must be one of the four enumeration constants + ! PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined + ! in sundials_iterative.h. + ! These correspond to no preconditioning, + ! left preconditioning only, right preconditioning + ! only, and both left and right preconditioning, + ! respectively. + ! + ! maxl is the maximum Krylov dimension. This is an + ! optional input to the CVSPGMR solver. Pass 0 to + ! use the default value CVSPGMR_MAXL=5. + ! + ! The return value of CVSpgmr is one of: + ! CVSPILS_SUCCESS if successful + ! CVSPILS_MEM_NULL if the cvode memory was NULL + ! CVSPILS_MEM_FAIL if there was a memory allocation failure + ! CVSPILS_ILL_INPUT if a required vector operation is missing + ! The above constants are defined in cvode_spils.h + ! + ! ----------------------------------------------------------------- + + integer(c_int) function FCVSpgmr(cvode_mem, pretype, maxl) & + bind(C,name='CVSpgmr') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: pretype + integer(c_int), value :: maxl + end function FCVSpgmr + + ! ================================================================= + ! Interfaces from cvode_spils.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Optional inputs to the CVSPILS linear solver + ! ----------------------------------------------------------------- + ! + ! FCVSpilsSetPrecType resets the type of preconditioner, pretype, + ! from the value previously set. + ! This must be one of PREC_NONE, PREC_LEFT, + ! PREC_RIGHT, or PREC_BOTH. + ! + ! FCVSpilsSetGSType specifies the type of Gram-Schmidt + ! orthogonalization to be used. This must be one of + ! the two enumeration constants MODIFIED_GS or + ! CLASSICAL_GS defined in iterative.h. These correspond + ! to using modified Gram-Schmidt and classical + ! Gram-Schmidt, respectively. + ! Default value is MODIFIED_GS. + ! + ! FCVSpilsSetMaxl resets the maximum Krylov subspace size, maxl, + ! from the value previously set. + ! An input value <= 0, gives the default value. + ! + ! FCVSpilsSetEpsLin specifies the factor by which the tolerance on + ! the nonlinear iteration is multiplied to get a + ! tolerance on the linear iteration. + ! Default value is 0.05. + ! + ! FCVSpilsSetPreconditioner specifies the PrecSetup and PrecSolve functions. + ! Default is NULL for both arguments (no preconditioning) + ! + ! FCVSpilsSetJacTimesVecFn specifies the jtimes function. Default is to + ! use an internal finite difference approximation routine. + ! + ! The return value of FCVSpilsSet* is one of: + ! CVSPILS_SUCCESS if successful + ! CVSPILS_MEM_NULL if the cvode memory was NULL + ! CVSPILS_LMEM_NULL if the linear solver memory was NULL + ! CVSPILS_ILL_INPUT if an input has an illegal value + ! ----------------------------------------------------------------- + + integer(c_int) function FCVSpilsSetPrecType(cvode_mem, pretype) & + bind(C,name='CVSpilsSetPrecType') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: pretype + end function FCVSpilsSetPrecType + + integer(c_int) function FCVSpilsSetGSType(cvode_mem, gstype) & + bind(C,name='CVspilsSetGSType') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: gstype + end function FCVSpilsSetGSType + + integer(c_int) function FCVSpilsSetMaxl(cvode_mem, maxl) & + bind(C,name='CVSpilsSetMaxl') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: maxl + end function FCVSpilsSetMaxl + + integer(c_int) function FCVSpilsSetEpsLin(cvode_mem, eplifac) & + bind(C,name='FCVSpilsSetEpsLin') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + real(c_double), value :: eplifac + end function FCVSpilsSetEpsLin + + integer(c_int) function FCVSpilsSetPreconditioner(cvode_mem, pset, psolve) & + bind(C,name='CVSpilsSetPreconditioner') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_funptr), value :: pset + type(c_funptr), value :: psolve + end function FCVSpilsSetPreconditioner + + integer(c_int) function FCVSpilsSetJacTimesVecFn(cvode_mem, jtv) & + bind(C,name='CVSpilsSetJacTimesVecFn') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + type(c_funptr), value :: jtv + end function FCVSpilsSetJacTimesVecFn + + ! ----------------------------------------------------------------- + ! Optional outputs from the CVSPILS linear solver + ! ----------------------------------------------------------------- + ! FCVSpilsGetWorkSpace returns the real and integer workspace used + ! by the SPILS module. + ! + ! FCVSpilsGetNumPrecEvals returns the number of preconditioner + ! evaluations, i.e. the number of calls made + ! to PrecSetup with jok==FALSE. + ! + ! FCVSpilsGetNumPrecSolves returns the number of calls made to + ! PrecSolve. + ! + ! FCVSpilsGetNumLinIters returns the number of linear iterations. + ! + ! FCVSpilsGetNumConvFails returns the number of linear + ! convergence failures. + ! + ! FCVSpilsGetNumJtimesEvals returns the number of calls to jtimes. + ! + ! FCVSpilsGetNumRhsEvals returns the number of calls to the user + ! f routine due to finite difference Jacobian + ! times vector evaluation. + ! + ! FCVSpilsGetLastFlag returns the last error flag set by any of + ! the CVSPILS interface functions. + ! + ! The return value of FCVSpilsGet* is one of: + ! CVSPILS_SUCCESS if successful + ! CVSPILS_MEM_NULL if the cvode memory was NULL + ! CVSPILS_LMEM_NULL if the linear solver memory was NULL + ! ----------------------------------------------------------------- + + integer(c_int) function FCVSpilsGetWorkSpace(cvode_mem, lenrwLS, leniwLS) & + bind(C,name='CVSpilsGetWorkSpace') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: lenrwLS + integer(c_long) :: leniwLS + end function FCVSpilsGetWorkSpace + + integer(c_int) function FCVSpilsGetNumPrecEvals(cvode_mem, npevals) & + bind(C,name='CVSpilsGetNumPrecEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: npevals + end function FCVSpilsGetNumPrecEvals + + integer(c_int) function FCVSpilsGetNumPrecSolves(cvode_mem, npsolves) & + bind(C,name='CVSpilsGetNumPrecSolves') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: npsolves + end function FCVSpilsGetNumPrecSolves + + integer(c_int) function FCVSpilsGetNumLinIters(cvode_mem, nliters) & + bind(C,name='CVSpilsGetNumLinIters') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nliters + end function FCVSpilsGetNumLinIters + + integer(c_int) function FCVSpilsGetNumConvFails(cvode_mem, nlcfails) & + bind(C,name='CVSpilsGetNumConvFails') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nlcfails + end function FCVSpilsGetNumConvFails + + integer(c_int) function FCVSpilsGetNumJtimesEvals(cvode_mem, njvevals) & + bind(C,name='CVSpilsGetNumJtimesEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: njvevals + end function FCVSpilsGetNumJtimesEvals + + integer(c_int) function FCVSpilsGetNumRhsEvals(cvode_mem, nfevalsLS) & + bind(C,name='CVSpilsGetNumRhsEvals') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: nfevalsLS + end function FCVSpilsGetNumRhsEvals + + integer(c_int) function FCVSpilsGetLastFlag(cvode_mem, flag) & + bind(C,name='CVSpilsGetLastFalg') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_long) :: flag + end function FCVSpilsGetLastFlag + + ! ----------------------------------------------------------------- + ! The following function returns the name of the constant + ! associated with a CVSPILS return flag + ! ----------------------------------------------------------------- + + ! >>> NOT CURRENTLY IMPLEMENTED IN FORTRAN INTERFACE + ! char* CVSpilsGetReturnFlagName(long int flag); + + ! ================================================================= + ! Interfaces from cvode_sptfqmr.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVSptfqmr + ! ----------------------------------------------------------------- + ! A call to the FCVSptfqmr function links the main CVODE integrator + ! with the CVSPTFQMR linear solver. + ! + ! cvode_mem is the pointer to the integrator memory returned by + ! FCVodeCreate. + ! + ! pretype is the type of user preconditioning to be done. + ! This must be one of the four enumeration constants + ! PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined + ! in iterative.h. These correspond to no preconditioning, + ! left preconditioning only, right preconditioning + ! only, and both left and right preconditioning, + ! respectively. + ! + ! maxl is the maximum Krylov dimension. This is an + ! optional input to the CVSPTFQMR solver. Pass 0 to + ! use the default value CVSPILS_MAXL=5. + ! + ! The return value of FCVSptfqmr is one of: + ! CVSPILS_SUCCESS if successful + ! CVSPILS_MEM_NULL if the cvode memory was NULL + ! CVSPILS_MEM_FAIL if there was a memory allocation failure + ! CVSPILS_ILL_INPUT if a required vector operation is missing + ! The above constants are defined in cvode_spils.h + ! + ! ----------------------------------------------------------------- + + integer(c_int) function FCVSptfqmr(cvode_mem, pretype, maxl) & + bind(C,name='CVSptfqmr') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: pretype + integer(c_int), value :: maxl + end function FCVSptfqmr + + ! ================================================================= + ! Interfaces from cvode_superlumt.h + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : FCVSuperLUMT + ! ----------------------------------------------------------------- + ! A call to the FCVSuperLUMT function links the main integrator + ! with the CVSuperLUMT linear solver module. + ! + ! cv_mem is the pointer to integrator memory returned by + ! FCVCreate. + ! + ! + ! FCVSuperLUMT returns: + ! CVSLU_SUCCESS = 0 if successful + ! CVSLU_LMEM_FAIL = -1 if there was a memory allocation failure + ! CVSLU_ILL_INPUT = -2 if NVECTOR found incompatible + ! + ! NOTE: The CVSuperLUMT linear solver assumes a serial implementation + ! of the NVECTOR package. Therefore, CVSuperLUMT will first + ! test for a compatible N_Vector internal representation + ! by checking that the functions N_VGetArrayPointer and + ! N_VSetArrayPointer exist. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVSuperLUMT(cvode_mem, num_threads, n, nnz) & + bind(C,name='CVSuperLUMT') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: num_threads + integer(c_int), value :: n + integer(c_int), value :: nnz + end function FCVSuperLUMT + + ! ----------------------------------------------------------------- + ! Optional Input Specification Functions + ! ----------------------------------------------------------------- + ! + ! FCVSuperLUMTSetOrdering sets the ordering used by CVSuperLUMT for + ! reducing fill. + ! Options are: + ! 0 for natural ordering + ! 1 for minimal degree ordering on A'*A + ! 2 for minimal degree ordering on A'+A + ! 3 for approximate minimal degree ordering for unsymmetric matrices + ! The default used in SUNDIALS is 3 for COLAMD. + ! ----------------------------------------------------------------- + + integer(c_int) function FCVSuperLUMTSetOrdering(cvode_mem, ordering_choice) & + bind(C,name='CVSuperLUMTSetOrdering') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: cvode_mem + integer(c_int), value :: ordering_choice + end function FCVSuperLUMTSetOrdering + + end interface + +end module cvode_interface diff --git a/Util/VODE_test/eos_hc.f90 b/Util/VODE_test/eos_hc.f90 new file mode 100644 index 00000000..45c7f965 --- /dev/null +++ b/Util/VODE_test/eos_hc.f90 @@ -0,0 +1,689 @@ +! Calculates temperature and free electron density using Newton-Raphson solver +! +! Equilibrium ionization fractions, optically thin media, based on: +! Katz, Weinberg & Hernquist, 1996: Astrophysical Journal Supplement v.105, p.19 +! +! Units are CGS, **BUT** 6 fractions: ne, nh0, nhp, nhe0, nhep, nhepp +! are in units of nh (hydrogen number density) +! + +module eos_module + + use constants_module, only : rt => type_real, M_PI + use iso_c_binding, only: c_double + + implicit none + + ! Routines: + public :: nyx_eos_given_RT, nyx_eos_given_RT_vec, nyx_eos_T_given_Re, nyx_eos_T_given_Re_vec, eos_init_small_pres + public :: nyx_eos_nh0_and_nhep, iterate_ne, iterate_ne_vec + private :: ion_n + + real(rt), public :: xacc ! EOS Newton-Raphson convergence tolerance + real(c_double), public :: vode_rtol, vode_atol_scaled ! VODE integration tolerances + + contains + + subroutine fort_setup_eos_params (xacc_in, vode_rtol_in, vode_atol_scaled_in) & + bind(C, name='fort_setup_eos_params') + use constants_module, only : rt => type_real, M_PI + implicit none + real(rt), intent(in) :: xacc_in, vode_rtol_in, vode_atol_scaled_in + + xacc = xacc_in + vode_rtol = vode_rtol_in + vode_atol_scaled = vode_atol_scaled_in + + end subroutine fort_setup_eos_params + + ! **************************************************************************** + + subroutine eos_init_small_pres(R, T, Ne, P, a) + + use constants_module, only : rt => type_real, M_PI + use atomic_rates_module, ONLY: YHELIUM + use fundamental_constants_module, only: mp_over_kb + + implicit none + + real(rt), intent( out) :: P + real(rt), intent(in ) :: R, T, Ne + real(rt), intent(in ) :: a + + real(rt) :: mu + + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+Ne) + P = R*T / (mp_over_kB * mu) + + end subroutine eos_init_small_pres + + ! **************************************************************************** + + subroutine nyx_eos_soundspeed(c, R, e) + + use meth_params_module, only: gamma_const, gamma_minus_1 + + implicit none + + real(rt), intent(in ) :: R, e + real(rt), intent( out) :: c + + ! sound speed: c^2 = gamma*P/rho + c = sqrt(gamma_const * gamma_minus_1 *e) + + end subroutine nyx_eos_soundspeed + + ! **************************************************************************** + + subroutine nyx_eos_S_given_Re(S, R, T, Ne, a) + + use constants_module, only : M_PI + use atomic_rates_module, ONLY: YHELIUM + use fundamental_constants_module, only: mp_over_kb + use fundamental_constants_module, only: k_B, hbar, m_proton + implicit none + + real(rt), intent( out) :: S + real(rt), intent(in ) :: R, T, Ne, a + + real(rt) :: mu, dens, t1, t2, t3 + + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+Ne) + dens = R/(a*a*a) + + ! Entropy (per gram) of an ideal monoatomic gas (Sactur-Tetrode equation) + ! NOTE: this expression is only valid for gamma = 5/3. + t1 = (mu*m_proton); t1 = t1*t1*sqrt(t1) + t2 = (k_B*T); t2 = t2*sqrt(t2) + t3 = (2.0d0*M_PI*hbar*hbar); t3 = t3*sqrt(t3) + + S = (1.d0 / (mu*mp_over_kB)) * (2.5d0 + log(t1/dens*t2/t3)) + + end subroutine nyx_eos_S_given_Re + + ! **************************************************************************** + + subroutine nyx_eos_given_RT(e, P, R, T, Ne, a) + + use atomic_rates_module, ONLY: YHELIUM + use fundamental_constants_module, only: mp_over_kb + use meth_params_module, only: gamma_minus_1 + implicit none + + double precision, intent( out) :: e, P + double precision, intent(in ) :: R, T, Ne + double precision, intent(in ) :: a + + double precision :: mu + + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+Ne) + e = T / (gamma_minus_1 * mp_over_kB * mu) + + P = gamma_minus_1 * R * e + + end subroutine nyx_eos_given_RT + + ! **************************************************************************** + + subroutine nyx_eos_given_RT_vec(e, P, R, T, Ne, a, veclen) + + use atomic_rates_module, ONLY: YHELIUM + use fundamental_constants_module, only: mp_over_kb + use meth_params_module, only: gamma_minus_1 + implicit none + + integer, intent(in) :: veclen + real(rt), dimension(veclen), intent( out) :: e, P + real(rt), dimension(veclen), intent(in ) :: R, T, Ne + real(rt), intent(in ) :: a + + real(rt), dimension(veclen) :: mu + integer :: i + + do i = 1, veclen + mu(i) = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+Ne(i)) + e(i) = T(i) / (gamma_minus_1 * mp_over_kB * mu(i)) + + P(i) = gamma_minus_1 * R(i) * e(i) + end do + + end subroutine nyx_eos_given_RT_vec + + ! **************************************************************************** + + subroutine nyx_eos_T_given_Re(JH, JHe, T, Ne, R_in, e_in, a, species) + + use atomic_rates_module, ONLY: XHYDROGEN, MPROTON + use fundamental_constants_module, only: density_to_cgs, e_to_cgs + + ! In/out variables + integer, intent(in) :: JH, JHe + real(rt), intent(inout) :: T, Ne + real(rt), intent(in ) :: R_in, e_in + real(rt), intent(in ) :: a + real(rt), optional, intent(out) :: species(5) + + double precision :: nh, nh0, nhep, nhp, nhe0, nhepp + double precision :: z, rho, U + + ! This converts from code units to CGS + rho = R_in * density_to_cgs / a**3 + U = e_in * e_to_cgs + nh = rho*XHYDROGEN/MPROTON + + z = 1.d0/a - 1.d0 + + call iterate_ne(JH, Jhe, z, U, T, nh, ne, nh0, nhp, nhe0, nhep, nhepp) + + if (present(species)) then + species(1) = nh0 + species(2) = nhp + species(3) = nhe0 + species(4) = nhep + species(5) = nhepp + endif + + end subroutine nyx_eos_T_given_Re + + ! **************************************************************************** + + subroutine nyx_eos_T_given_Re_vec(T, Ne, R_in, e_in, a, veclen) + + use constants_module, only : rt => type_real, M_PI + use atomic_rates_module, ONLY: XHYDROGEN, MPROTON + use fundamental_constants_module, only: density_to_cgs, e_to_cgs + + ! In/out variables + integer, intent(in) :: veclen + real(rt), dimension(veclen), intent(inout) :: T, Ne + real(rt), dimension(veclen), intent(in ) :: R_in, e_in + real(rt), intent(in ) :: a + + real(rt), dimension(veclen) :: nh, nh0, nhep, nhp, nhe0, nhepp, rho, U + real(rt) :: z + + ! This converts from code units to CGS + rho = R_in * density_to_cgs / a**3 + U = e_in * e_to_cgs + nh = rho*XHYDROGEN/MPROTON + + z = 1.d0/a - 1.d0 + + call iterate_ne_vec(z, U, T, nh, ne, nh0, nhp, nhe0, nhep, nhepp, veclen) + + end subroutine nyx_eos_T_given_Re_vec + + ! **************************************************************************** + + subroutine nyx_eos_nh0_and_nhep(JH, JHe, z, rho, e, nh0, nhep) + ! This is for skewers analysis code, input is in CGS + + use atomic_rates_module, only: XHYDROGEN, MPROTON + + ! In/out variables + integer, intent(in) :: JH, Jhe + real(rt), intent(in ) :: z, rho, e + real(rt), intent( out) :: nh0, nhep + + real(rt) :: nh, nhp, nhe0, nhepp, T, ne + + nh = rho*XHYDROGEN/MPROTON + ne = 1.0d0 ! Guess + + call iterate_ne(JH, JHe, z, e, T, nh, ne, nh0, nhp, nhe0, nhep, nhepp) + + nh0 = nh*nh0 + nhep = nh*nhep + + end subroutine nyx_eos_nh0_and_nhep + + ! **************************************************************************** + + subroutine iterate_ne_vec(z, U, t, nh, ne, nh0, nhp, nhe0, nhep, nhepp, veclen) + + use atomic_rates_module, ONLY: this_z, YHELIUM, BOLTZMANN, MPROTON, TCOOLMAX_R + use meth_params_module, only: gamma_minus_1 + + integer :: i + + integer, intent(in) :: veclen + real(rt), intent (in ) :: z + real(rt), dimension(veclen), intent(in) :: U, nh + real(rt), dimension(veclen), intent (inout) :: ne + real(rt), dimension(veclen), intent ( out) :: t, nh0, nhp, nhe0, nhep, nhepp + + real(rt), parameter :: xacc = 1.0d-6 + + integer, dimension(veclen) :: JH, JHe + real(rt), dimension(veclen) :: f, df, eps, mu + real(rt), dimension(veclen) :: nhp_plus, nhep_plus, nhepp_plus + real(rt), dimension(veclen) :: dnhp_dne, dnhep_dne, dnhepp_dne, dne + real(rt), dimension(veclen):: U_in, t_in, nh_in, ne_in + real(rt), dimension(veclen) :: nhp_out, nhep_out, nhepp_out + integer :: vec_count, orig_idx(veclen) + integer :: ii + character(len=128) :: errmsg + + ! Check if we have interpolated to this z + if (abs(z-this_z) .gt. xacc*z) then + write(errmsg, *) "iterate_ne_vec(): Wrong redshift! z = ", z, " but this_z = ", this_z +! call amrex_abort(errmsg) + end if + + ii = 0 + ne(1:veclen) = 1.0d0 ! 0 is a bad guess + + do ! Newton-Raphson solver + ii = ii + 1 + + ! Ion number densities + do i = 1, veclen + mu(i) = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne(i)) + t(i) = gamma_minus_1*MPROTON/BOLTZMANN * U(i) * mu(i) + end do + vec_count = 0 + do i = 1, veclen + if (t(i) .ge. TCOOLMAX_R) then ! Fully ionized plasma + nhp(i) = 1.0d0 + nhep(i) = 0.0d0 + nhepp(i) = YHELIUM + else + vec_count = vec_count + 1 + U_in(vec_count) = U(i) + t_in(vec_count) = t(i) + nh_in(vec_count) = nh(i) + ne_in(vec_count) = ne(i) + orig_idx(vec_count) = i + endif + end do + + call ion_n_vec(JH(1:vec_count), & + JHe(1:vec_count), & + U_in(1:vec_count), & + nh_in(1:vec_count), & + ne_in(1:vec_count), & + nhp_out(1:vec_count), & + nhep_out(1:vec_count), & + nhepp_out(1:vec_count), & + t_in(1:vec_count), & + vec_count) + nhp(orig_idx(1:vec_count)) = nhp_out(1:vec_count) + nhep(orig_idx(1:vec_count)) = nhep_out(1:vec_count) + nhepp(orig_idx(1:vec_count)) = nhepp_out(1:vec_count) + + ! Forward difference derivatives + do i = 1, veclen + if (ne(i) .gt. 0.0d0) then + eps(i) = xacc*ne(i) + else + eps(i) = 1.0d-24 + endif + end do + do i = 1, veclen + mu(i) = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne(i)+eps(i)) + t(i) = gamma_minus_1*MPROTON/BOLTZMANN * U(i) * mu(i) + end do + vec_count = 0 + do i = 1, veclen + if (t(i) .ge. TCOOLMAX_R) then ! Fully ionized plasma + nhp_plus(i) = 1.0d0 + nhep_plus(i) = 0.0d0 + nhepp_plus(i) = YHELIUM + else + vec_count = vec_count + 1 + U_in(vec_count) = U(i) + t_in(vec_count) = t(i) + nh_in(vec_count) = nh(i) + ne_in(vec_count) = ne(i)+eps(i) + orig_idx(vec_count) = i + endif + end do + + call ion_n_vec(JH(1:vec_count), & + JHe(1:vec_count), & + U_in(1:vec_count), & + nh_in(1:vec_count), & + ne_in(1:vec_count), & + nhp_out(1:vec_count), & + nhep_out(1:vec_count), & + nhepp_out(1:vec_count), & + t_in(1:vec_count), & + vec_count) + nhp_plus(orig_idx(1:vec_count)) = nhp_out(1:vec_count) + nhep_plus(orig_idx(1:vec_count)) = nhep_out(1:vec_count) + nhepp_plus(orig_idx(1:vec_count)) = nhepp_out(1:vec_count) + + do i = 1, veclen + dnhp_dne(i) = (nhp_plus(i) - nhp(i)) / eps(i) + dnhep_dne(i) = (nhep_plus(i) - nhep(i)) / eps(i) + dnhepp_dne(i) = (nhepp_plus(i) - nhepp(i)) / eps(i) + end do + + do i = 1, veclen + f(i) = ne(i) - nhp(i) - nhep(i) - 2.0d0*nhepp(i) + df(i) = 1.0d0 - dnhp_dne(i) - dnhep_dne(i) - 2.0d0*dnhepp_dne(i) + dne(i) = f(i)/df(i) + end do + + do i = 1, veclen + ne(i) = max((ne(i)-dne(i)), 0.0d0) + end do + + if (maxval(abs(dne(1:veclen))) < xacc) exit + + if (ii .gt. 15) & + STOP 'iterate_ne_vec(): No convergence in Newton-Raphson!' + + enddo + + ! Get rates for the final ne + do i = 1, veclen + mu(i) = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne(i)) + t(i) = gamma_minus_1*MPROTON/BOLTZMANN * U(i) * mu(i) + end do + vec_count = 0 + do i = 1, veclen + if (t(i) .ge. TCOOLMAX_R) then ! Fully ionized plasma + nhp(i) = 1.0d0 + nhep(i) = 0.0d0 + nhepp(i) = YHELIUM + else + vec_count = vec_count + 1 + U_in(vec_count) = U(i) + t_in(vec_count) = t(i) + nh_in(vec_count) = nh(i) + ne_in(vec_count) = ne(i) + orig_idx(vec_count) = i + endif + end do + call ion_n_vec(JH(1:vec_count), & + JHe(1:vec_count), & + U_in(1:vec_count), & + nh_in(1:vec_count), & + ne_in(1:vec_count), & + nhp_out(1:vec_count), & + nhep_out(1:vec_count), & + nhepp_out(1:vec_count), & + t_in(1:vec_count), & + vec_count) + nhp(orig_idx(1:vec_count)) = nhp_out(1:vec_count) + nhep(orig_idx(1:vec_count)) = nhep_out(1:vec_count) + nhepp(orig_idx(1:vec_count)) = nhepp_out(1:vec_count) + + ! Neutral fractions: + do i = 1, veclen + nh0(i) = 1.0d0 - nhp(i) + nhe0(i) = YHELIUM - (nhep(i) + nhepp(i)) + end do + end subroutine iterate_ne_vec + + ! **************************************************************************** + + subroutine ion_n_vec(JH, JHe, U, nh, ne, nhp, nhep, nhepp, t, vec_count) + + use constants_module, only : rt => type_real, M_PI + use meth_params_module, only: gamma_minus_1 + use atomic_rates_module, ONLY: YHELIUM, MPROTON, BOLTZMANN, & + TCOOLMIN, TCOOLMAX, NCOOLTAB, deltaT, & + AlphaHp, AlphaHep, AlphaHepp, Alphad, & + GammaeH0, GammaeHe0, GammaeHep, & + ggh0, gghe0, gghep + + integer, intent(in) :: vec_count + integer, dimension(vec_count), intent(in) :: JH, JHe + real(rt), intent(in ) :: U(vec_count), nh(vec_count), ne(vec_count) + real(rt), intent( out) :: nhp(vec_count), nhep(vec_count), nhepp(vec_count), t(vec_count) + real(rt) :: ahp(vec_count), ahep(vec_count), ahepp(vec_count), ad(vec_count), & + geh0(vec_count), gehe0(vec_count), gehep(vec_count) + real(rt) :: ggh0ne(vec_count), gghe0ne(vec_count), gghepne(vec_count) + real(rt) :: mu(vec_count), tmp(vec_count), logT(vec_count), flo(vec_count), fhi(vec_count) + real(rt), parameter :: smallest_val=tiny(1.0d0) + integer :: j(vec_count), i + + mu(:) = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne(:)) + t(:) = gamma_minus_1*MPROTON/BOLTZMANN * U(:) * mu(:) + + logT(1:vec_count) = dlog10(t(1:vec_count)) + + ! Temperature floor + do i = 1, vec_count + if (logT(i) .le. TCOOLMIN) logT(i) = TCOOLMIN + 0.5d0*deltaT + end do + + ! Interpolate rates + do i = 1, vec_count + tmp(i) = (logT(i)-TCOOLMIN)/deltaT + j(i) = int(tmp(i)) + fhi(i) = tmp(i) - j(i) + flo(i) = 1.0d0 - fhi(i) + j(i) = j(i) + 1 ! F90 arrays start with 1 + end do + + do i = 1, vec_count + ahp(i) = flo(i)*AlphaHp (j(i)) + fhi(i)*AlphaHp (j(i)+1) + ahep(i) = flo(i)*AlphaHep (j(i)) + fhi(i)*AlphaHep (j(i)+1) + ahepp(i) = flo(i)*AlphaHepp(j(i)) + fhi(i)*AlphaHepp(j(i)+1) + ad(i) = flo(i)*Alphad (j(i)) + fhi(i)*Alphad (j(i)+1) + geh0(i) = flo(i)*GammaeH0 (j(i)) + fhi(i)*GammaeH0 (j(i)+1) + gehe0(i) = flo(i)*GammaeHe0(j(i)) + fhi(i)*GammaeHe0(j(i)+1) + gehep(i) = flo(i)*GammaeHep(j(i)) + fhi(i)*GammaeHep(j(i)+1) + end do + + do i = 1, vec_count + if (ne(i) .gt. 0.0d0) then + ggh0ne(i) = JH(i) * ggh0 / (ne(i)*nh(i)) + gghe0ne(i) = JH(i) * gghe0 / (ne(i)*nh(i)) + gghepne(i) = JHe(i) * gghep / (ne(i)*nh(i)) + else + ggh0ne(i) = 0.0d0 + gghe0ne(i) = 0.0d0 + gghepne(i) = 0.0d0 + endif + end do + + ! H+ + do i = 1, vec_count + nhp(i) = 1.0d0 - ahp(i)/(ahp(i) + geh0(i) + ggh0ne(i)) + end do + + ! He+ + do i = 1, vec_count + if ((gehe0(i) + gghe0ne(i)) .gt. smallest_val) then + + nhep(i) = YHELIUM/(1.0d0 + (ahep(i) + ad(i) )/(gehe0(i) + gghe0ne(i)) & + + (gehep(i) + gghepne(i))/ahepp(i)) + else + nhep(i) = 0.0d0 + endif + end do + + ! He++ + do i = 1, vec_count + if (nhep(i) .gt. 0.0d0) then + nhepp(i) = nhep(i)*(gehep(i) + gghepne(i))/ahepp(i) + else + nhepp(i) = 0.0d0 + endif + end do + + end subroutine ion_n_vec + + ! **************************************************************************** + + subroutine iterate_ne(JH, JHe, z, U, t, nh, ne, nh0, nhp, nhe0, nhep, nhepp) + + use atomic_rates_module, only: this_z, YHELIUM + use vode_aux_module, only: i_vode,j_vode,k_vode, NR_vode + + integer :: i + + integer, intent(in) :: JH, JHe + real(rt), intent (in ) :: z, U, nh + real(rt), intent (inout) :: ne + real(rt), intent ( out) :: t, nh0, nhp, nhe0, nhep, nhepp + + real(rt) :: f, df, eps + real(rt) :: nhp_plus, nhep_plus, nhepp_plus + real(rt) :: dnhp_dne, dnhep_dne, dnhepp_dne, dne + character(len=128) :: errmsg + integer :: print_radius + CHARACTER(LEN=80) :: FMT + + ! Check if we have interpolated to this z + if (abs(z-this_z) .gt. xacc*z) then + write(errmsg, *) "iterate_ne(): Wrong redshift! z = ", z, " but this_z = ", this_z +! call amrex_abort(errmsg) + end if + + i = 0 + ne = 1.0d0 ! 0 is a bad guess + do ! Newton-Raphson solver + i = i + 1 + + ! Ion number densities + call ion_n(JH, JHe, U, nh, ne, nhp, nhep, nhepp, t) + + ! Forward difference derivatives + if (ne .gt. 0.0d0) then + eps = xacc*ne + else + eps = 1.0d-24 + endif + call ion_n(JH, JHe, U, nh, (ne+eps), nhp_plus, nhep_plus, nhepp_plus, t) + + NR_vode = NR_vode + 2 + + dnhp_dne = (nhp_plus - nhp) / eps + dnhep_dne = (nhep_plus - nhep) / eps + dnhepp_dne = (nhepp_plus - nhepp) / eps + + f = ne - nhp - nhep - 2.0d0*nhepp + df = 1.0d0 - dnhp_dne - dnhep_dne - 2.0d0*dnhepp_dne + dne = f/df + + FMT = "(A6, I4, ES15.5, ES15.5E3, ES15.5, ES15.5)" + print(FMT), 'ine:',i,U,ne,dne,eps + print(FMT), 'fdine:',i,f,nhp,nhep,nhepp + print(FMT), 'dfine:',i,df,dnhp_dne,dnhep_dne,dnhepp_dne + + ne = max((ne-dne), 0.0d0) + + if (abs(dne) < xacc) exit + + if (i .gt. 10) then + !$OMP CRITICAL + print*, "ITERATION: ", i, " NUMBERS: ", z, t, ne, nhp, nhep, nhepp, df + if (i .gt. 12) & + STOP 'iterate_ne(): No convergence in Newton-Raphson!' + !$OMP END CRITICAL + endif + + enddo + + ! Get rates for the final ne + call ion_n(JH, JHe, U, nh, ne, nhp, nhep, nhepp, t) + NR_vode = NR_vode + 1 + + ! Neutral fractions: + nh0 = 1.0d0 - nhp + nhe0 = YHELIUM - (nhep + nhepp) + end subroutine iterate_ne + + ! **************************************************************************** + + subroutine ion_n(JH, JHe, U, nh, ne, nhp, nhep, nhepp, t) + + use meth_params_module, only: gamma_minus_1 + use atomic_rates_module, only: YHELIUM, MPROTON, BOLTZMANN, & + TCOOLMIN, TCOOLMAX, NCOOLTAB, deltaT, & + AlphaHp, AlphaHep, AlphaHepp, Alphad, & + GammaeH0, GammaeHe0, GammaeHep, & + ggh0, gghe0, gghep + use vode_aux_module, only: i_vode,j_vode,k_vode, NR_vode + + integer, intent(in) :: JH, JHe + real(rt), intent(in ) :: U, nh, ne + real(rt), intent( out) :: nhp, nhep, nhepp, t + real(rt) :: ahp, ahep, ahepp, ad, geh0, gehe0, gehep + real(rt) :: ggh0ne, gghe0ne, gghepne + real(rt) :: mu, tmp, logT, flo, fhi + real(rt), parameter :: smallest_val=tiny(1.0d0) + integer :: j + integer :: print_radius + CHARACTER(LEN=80) :: FMT + + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne) + t = gamma_minus_1*MPROTON/BOLTZMANN * U * mu +! print*, "MPROTON/BOLTZMANN = ", MPROTON/BOLTZMANN +! print*, "YHELIUM = ", YHELIUM +! print*, "gamma_minus_1 = ", gamma_minus_1 + + logT = dlog10(t) + if (logT .ge. TCOOLMAX) then ! Fully ionized plasma + nhp = 1.0d0 + nhep = 0.0d0 + nhepp = YHELIUM + print*,'logT = ',logT + return + endif + + ! Temperature floor + if (logT .le. TCOOLMIN) logT = TCOOLMIN + 0.5d0*deltaT + + ! Interpolate rates + tmp = (logT-TCOOLMIN)/deltaT + j = int(tmp) + fhi = tmp - j + flo = 1.0d0 - fhi + j = j + 1 ! F90 arrays start with 1 + + FMT = "(A6, I4, ES15.5, ES15.5E3, ES15.5, ES15.5)" +! if(g_debug.eq.0) then + print(FMT), 'ion:',j,U,ne,logT,AlphaHep(j) + + ahp = flo*AlphaHp (j) + fhi*AlphaHp (j+1) + ahep = flo*AlphaHep (j) + fhi*AlphaHep (j+1) + ahepp = flo*AlphaHepp(j) + fhi*AlphaHepp(j+1) + ad = flo*Alphad (j) + fhi*Alphad (j+1) + geh0 = flo*GammaeH0 (j) + fhi*GammaeH0 (j+1) + gehe0 = flo*GammaeHe0(j) + fhi*GammaeHe0(j+1) + gehep = flo*GammaeHep(j) + fhi*GammaeHep(j+1) + +! print(FMT), 'a ion:',j,ahp,ahep,ahepp,ad +! print(FMT), 'b ion:',j,geh0,gehe0,gehep,ad +! print*, "ne = ", ne + if (ne .gt. 0.0d0) then + ggh0ne = JH * ggh0 / (ne*nh) + gghe0ne = JH * gghe0 / (ne*nh) + gghepne = JHe * gghep / (ne*nh) + else + ggh0ne = 0.0d0 + gghe0ne = 0.0d0 + gghepne = 0.0d0 + endif + +! print(FMT), 'c ion:',j,ggh0ne,gghe0ne,gghepne,ad + + ! H+ + nhp = 1.0d0 - ahp/(ahp + geh0 + ggh0ne) + + ! He+ + if ((gehe0 + gghe0ne) .gt. smallest_val) then + + nhep = YHELIUM/(1.0d0 + (ahep + ad )/(gehe0 + gghe0ne) & + + (gehep + gghepne)/ahepp) + else + nhep = 0.0d0 + endif + + ! He++ + if (nhep .gt. 0.0d0) then + nhepp = nhep*(gehep + gghepne)/ahepp + else + nhepp = 0.0d0 + endif + + end subroutine ion_n + + +end module eos_module diff --git a/Util/VODE_test/eos_params.f90 b/Util/VODE_test/eos_params.f90 new file mode 100644 index 00000000..8de2d03a --- /dev/null +++ b/Util/VODE_test/eos_params.f90 @@ -0,0 +1,14 @@ + +! This module stores the runtime EOS species IF they are defined to be constants. +! These parameter are initialized in set_eos_params(). + +module eos_params_module + + use constants_module, only : rt => type_real, M_PI + + implicit none + + real(rt), save :: h_species + real(rt), save :: he_species + +end module eos_params_module diff --git a/Util/VODE_test/f_rhs.f90 b/Util/VODE_test/f_rhs.f90 new file mode 100644 index 00000000..5c00e2d7 --- /dev/null +++ b/Util/VODE_test/f_rhs.f90 @@ -0,0 +1,279 @@ + +subroutine f_rhs(num_eq, time, e_in, energy, rpar, ipar) + + use constants_module, only : rt => type_real, M_PI + use fundamental_constants_module, only: e_to_cgs, density_to_cgs, & + heat_from_cgs + use eos_module, only: iterate_ne + use atomic_rates_module, ONLY: TCOOLMIN, TCOOLMAX, NCOOLTAB, deltaT, & + MPROTON, XHYDROGEN, & + uvb_density_A, uvb_density_B, mean_rhob, & + BetaH0, BetaHe0, BetaHep, Betaff1, Betaff4, & + RecHp, RecHep, RecHepp, & + eh0, ehe0, ehep + + use vode_aux_module , only: z_vode, rho_vode, T_vode, ne_vode, & + JH_vode, JHe_vode, i_vode, j_vode, k_vode, fn_vode, NR_vode + + integer, intent(in) :: num_eq, ipar + real(rt), intent(inout) :: e_in(num_eq) + real(rt), intent(in ) :: time + real(rt), intent(in ) :: rpar + real(rt), intent( out) :: energy + + real(rt), parameter :: compt_c = 1.01765467d-37, T_cmb = 2.725d0 + + real(rt) :: logT, tmp, fhi, flo + real(rt) :: ahp, ahep, ahepp, ad, geh0, gehe0, gehep + real(rt) :: bh0, bhe0, bhep, bff1, bff4, rhp, rhep, rhepp + real(rt) :: lambda_c, lambda_ff, lambda, heat + real(rt) :: rho, U, a, rho_heat + real(rt) :: nh, nh0, nhp, nhe0, nhep, nhepp + integer :: j + integer :: print_radius + CHARACTER(LEN=80) :: FMT + + fn_vode=fn_vode+1; + + FMT = "(A6, I4, ES15.5, ES15.5E3, ES15.5, ES15.5)" + print(FMT), 'frh:',fn_vode,e_in,rho_vode,T_vode,time + + if (e_in(1) .lt. 0.d0) & + e_in(1) = tiny(e_in(1)) + + ! Converts from code units to CGS + rho = rho_vode * density_to_cgs * (1.0d0+z_vode)**3 + U = e_in(1) * e_to_cgs + nh = rho*XHYDROGEN/MPROTON +! print*, "rho = ", rho + print*, "nh = ", nh +! nh = 1.85e-2 +! print*, "Replacing with nh = ",nh +! print*, "XHYDROGEN = ", XHYDROGEN +! print*, "MPROTON = ", MPROTON +! print*, "density_to_cgs = ", density_to_cgs +! print*, "e_to_cgs = ", e_to_cgs + + if (time .gt. 1) then + print *,'TIME INTO F_RHS ',time + print *,'AT ',i_vode,j_vode,k_vode +! call bl_pd_abort("TOO BIG TIME IN F_RHS") + end if + + ! Get gas temperature and individual ionization species + ! testing different memory structures +! NR_vode=0 + call iterate_ne(JH_vode, JHe_vode, z_vode, U, T_vode, nh, ne_vode, nh0, nhp, nhe0, nhep, nhepp) + + ! Convert species to CGS units: + ne_vode = nh * ne_vode + nh0 = nh * nh0 + nhp = nh * nhp + nhe0 = nh * nhe0 + nhep = nh * nhep + nhepp = nh * nhepp + + logT = dlog10(T_vode) + if (logT .ge. TCOOLMAX) then ! Only free-free and Compton cooling are relevant + lambda_ff = 1.42d-27 * dsqrt(T_vode) * (1.1d0 + 0.34d0*dexp(-(5.5d0 - logT)**2 / 3.0d0)) & + * (nhp + 4.0d0*nhepp)*ne_vode + lambda_c = compt_c*T_cmb**4 * ne_vode * (T_vode - T_cmb*(1.0d0+z_vode))*(1.0d0 + z_vode)**4 + + energy = (-lambda_ff -lambda_c) * heat_from_cgs/(1.0d0+z_vode)**4 + + ! Convert to the actual term to be used in e_out = e_in + dt*energy + energy = energy / rho_vode * (1.0d0+z_vode) + ne_vode = ne_vode / nh + +! print *, 'enr = ', energy, 'at (i,j,k) ',i_vode,j_vode,k_vode +! print *, 'rho_heat = ', rho_heat, 'at (i,j,k) ',i_vode,j_vode,k_vode +! print *, 'rho = ', rho_vode, 'at (i,j,k) ',i_vode,j_vode,k_vode + + return + end if + + ! Temperature floor + if (logT .le. TCOOLMIN) logT = TCOOLMIN + 0.5d0*deltaT + + ! Interpolate rates + tmp = (logT-TCOOLMIN)/deltaT + j = int(tmp) + fhi = tmp - j + flo = 1.0d0 - fhi + j = j + 1 ! F90 arrays start with 1 + + bh0 = flo*BetaH0 (j) + fhi*BetaH0 (j+1) + bhe0 = flo*BetaHe0 (j) + fhi*BetaHe0 (j+1) + bhep = flo*BetaHep (j) + fhi*BetaHep (j+1) + bff1 = flo*Betaff1 (j) + fhi*Betaff1 (j+1) + bff4 = flo*Betaff4 (j) + fhi*Betaff4 (j+1) + rhp = flo*RecHp (j) + fhi*RecHp (j+1) + rhep = flo*RecHep (j) + fhi*RecHep (j+1) + rhepp = flo*RecHepp (j) + fhi*RecHepp (j+1) + + ! Cooling: + lambda = ( bh0*nh0 + bhe0*nhe0 + bhep*nhep + & + rhp*nhp + rhep*nhep + rhepp*nhepp + & + bff1*(nhp+nhep) + bff4*nhepp ) * ne_vode + + lambda_c = compt_c*T_cmb**4*ne_vode*(T_vode - T_cmb*(1.0d0+z_vode))*(1.0d0 + z_vode)**4 ! Compton cooling + lambda = lambda + lambda_c + + ! Heating terms + heat = JH_vode*nh0*eh0 + JH_vode*nhe0*ehe0 + JHe_vode*nhep*ehep + rho_heat = uvb_density_A * (rho_vode/mean_rhob)**uvb_density_B + heat = rho_heat*heat + + ! Convert back to code units + ne_vode = ne_vode / nh + energy = (heat - lambda)*heat_from_cgs/(1.0d0+z_vode)**4 + + ! Convert to the actual term to be used in e_out = e_in + dt*energy + a = 1.d0 / (1.d0 + z_vode) + energy = energy / rho_vode / a + + print *, 'energy = ', energy, 'at (i,j,k) ',i_vode,j_vode,k_vode +! print *, 'rho_heat = ', rho_heat, 'at (i,j,k) ',i_vode,j_vode,k_vode +! print *, 'rho_vd = ', rho_vode, 'at (i,j,k) ',i_vode,j_vode,k_vode + +end subroutine f_rhs + + +subroutine f_rhs_vec(time, e_in, energy) + + use constants_module, only : rt => type_real, M_PI + use fundamental_constants_module, only: e_to_cgs, density_to_cgs, & + heat_from_cgs + use eos_module, only: iterate_ne_vec + use atomic_rates_module, ONLY: TCOOLMIN, TCOOLMAX, NCOOLTAB, deltaT, & + MPROTON, XHYDROGEN, & + BetaH0, BetaHe0, BetaHep, Betaff1, Betaff4, & + RecHp, RecHep, RecHepp, & + eh0, ehe0, ehep + + use vode_aux_module , only: T_vode_vec, ne_vode_vec, rho_vode_vec, z_vode + use misc_params, only: simd_width + + implicit none + + real(rt), intent(in ) :: time + real(rt), dimension(simd_width), intent(inout) :: e_in + real(rt), dimension(simd_width), intent( out) :: energy + + real(rt), parameter :: compt_c = 1.01765467d-37, T_cmb = 2.725d0 + + real(rt), dimension(simd_width) :: logT, tmp, fhi, flo + real(rt), dimension(simd_width) :: ahp, ahep, ahepp, ad, geh0, gehe0, gehep + real(rt), dimension(simd_width) :: bh0, bhe0, bhep, bff1, bff4, rhp, rhep, rhepp + real(rt), dimension(simd_width) :: lambda_c, lambda_ff, lambda, heat + real(rt), dimension(simd_width) :: rho, U + real(rt) :: a + real(rt), dimension(simd_width) :: nh, nh0, nhp, nhe0, nhep, nhepp + integer, dimension(simd_width) :: j + integer :: m + logical, dimension(simd_width) :: hot + + do m = 1, simd_width + if (e_in(m) .lt. 0.d0) then + e_in(m) = tiny(e_in(m)) + endif + end do + + ! Converts from code units to CGS + rho = rho_vode_vec(1:simd_width) * density_to_cgs * (1.0d0+z_vode)**3 + U = e_in * e_to_cgs + nh = rho*XHYDROGEN/MPROTON + + if (time .gt. 1) then + print *,'TIME INTO F_RHS ',time +! call bl_pd_abort("TOO BIG TIME IN F_RHS") + end if + + ! Get gas temperature and individual ionization species + call iterate_ne_vec(z_vode, U, T_vode_vec, nh, ne_vode_vec, nh0, nhp, nhe0, nhep, nhepp, simd_width) + + ! Convert species to CGS units: + ne_vode_vec(1:simd_width) = nh * ne_vode_vec(1:simd_width) + nh0 = nh * nh0 + nhp = nh * nhp + nhe0 = nh * nhe0 + nhep = nh * nhep + nhepp = nh * nhepp + + logT = dlog10(T_vode_vec(1:simd_width)) + do m = 1, simd_width + if (logT(m) .ge. TCOOLMAX) then ! Only free-free and Compton cooling are relevant + lambda_ff(m) = 1.42d-27 * dsqrt(T_vode_vec(m)) * (1.1d0 + 0.34d0*dexp(-(5.5d0 - logT(m))**2 / 3.0d0)) & + * (nhp(m) + 4.0d0*nhepp(m))*ne_vode_vec(m) + lambda_c(m) = compt_c*T_cmb**4 * ne_vode_vec(m) * (T_vode_vec(m) - T_cmb*(1.0d0+z_vode))*(1.0d0 + z_vode)**4 + + energy(m) = (-lambda_ff(m) -lambda_c(m)) * heat_from_cgs/(1.0d0+z_vode)**4 + + ! Convert to the actual term to be used in e_out = e_in + dt*energy + energy(m) = energy(m) / rho_vode_vec(m) * (1.0d0+z_vode) + ne_vode_vec(m) = ne_vode_vec(m) / nh(m) + hot(m) = .true. + else + hot(m) = .false. + endif + end do + + do m = 1, simd_width + if (.not. hot(m)) then + ! Temperature floor + if (logT(m) .le. TCOOLMIN) logT(m) = TCOOLMIN + 0.5d0*deltaT + + ! Interpolate rates + tmp(m) = (logT(m)-TCOOLMIN)/deltaT + j(m) = int(tmp(m)) + fhi(m) = tmp(m) - j(m) + flo(m) = 1.0d0 - fhi(m) + j(m) = j(m) + 1 ! F90 arrays start with 1 + + bh0(m) = flo(m)*BetaH0 (j(m)) + fhi(m)*BetaH0 (j(m)+1) + bhe0(m) = flo(m)*BetaHe0 (j(m)) + fhi(m)*BetaHe0 (j(m)+1) + bhep(m) = flo(m)*BetaHep (j(m)) + fhi(m)*BetaHep (j(m)+1) + bff1(m) = flo(m)*Betaff1 (j(m)) + fhi(m)*Betaff1 (j(m)+1) + bff4(m) = flo(m)*Betaff4 (j(m)) + fhi(m)*Betaff4 (j(m)+1) + rhp(m) = flo(m)*RecHp (j(m)) + fhi(m)*RecHp (j(m)+1) + rhep(m) = flo(m)*RecHep (j(m)) + fhi(m)*RecHep (j(m)+1) + rhepp(m) = flo(m)*RecHepp (j(m)) + fhi(m)*RecHepp (j(m)+1) + + ! Cooling: + lambda(m) = ( bh0(m)*nh0(m) + bhe0(m)*nhe0(m) + bhep(m)*nhep(m) + & + rhp(m)*nhp(m) + rhep(m)*nhep(m) + rhepp(m)*nhepp(m) + & + bff1(m)*(nhp(m)+nhep(m)) + bff4(m)*nhepp(m) ) * ne_vode_vec(m) + + lambda_c(m) = compt_c*T_cmb**4*ne_vode_vec(m)*(T_vode_vec(m) - T_cmb*(1.0d0+z_vode))*(1.0d0 + z_vode)**4 ! Compton cooling + lambda(m) = lambda(m) + lambda_c(m) + + ! Heating terms + heat(m) = nh0(m)*eh0 + nhe0(m)*ehe0 + nhep(m)*ehep + + ! Convert back to code units + ne_vode_vec(m) = ne_vode_vec(m) / nh(m) + energy(m) = (heat(m) - lambda(m))*heat_from_cgs/(1.0d0+z_vode)**4 + + ! Convert to the actual term to be used in e_out = e_in + dt*energy + a = 1.d0 / (1.d0 + z_vode) + energy(m) = energy(m) / rho_vode_vec(m) / a + end if + end do + +end subroutine f_rhs_vec + + +subroutine jac(neq, t, y, ml, mu, pd, nrpd, rpar, ipar) + + use constants_module, only : rt => type_real, M_PI + implicit none + + integer , intent(in ) :: neq, ml, mu, nrpd, ipar + real(rt), intent(in ) :: y(neq), rpar, t + real(rt), intent( out) :: pd(neq,neq) + + ! Should never get here, we are using a numerical Jacobian + print *,'IN JAC ROUTINE' + stop + +end subroutine jac diff --git a/Util/VODE_test/fcvode_extras.f90 b/Util/VODE_test/fcvode_extras.f90 new file mode 100644 index 00000000..6f58c42f --- /dev/null +++ b/Util/VODE_test/fcvode_extras.f90 @@ -0,0 +1,186 @@ +module fcvode_extras + + implicit none + + contains + + subroutine fcvode_wrapper(dt, rho_in, T_in, ne_in, e_in, neq, cvmem, & + sunvec_y, yvec, T_out, ne_out, e_out) + + use constants_module, only : rt => type_real, M_PI + use vode_aux_module, only: rho_vode, T_vode, ne_vode, z_vode + use atomic_rates_module, only: this_z + use cvode_interface + use fnvector_serial + use eos_module, only: vode_rtol, vode_atol_scaled + use, intrinsic :: iso_c_binding + + implicit none + + real(rt), intent(in ) :: dt + real(rt), intent(in ) :: rho_in, T_in, ne_in, e_in + type(c_ptr), value :: cvmem + type(c_ptr), value :: sunvec_y + real(rt), intent( out) :: T_out,ne_out,e_out + + real(c_double) :: atol, rtol + real(c_double) :: time, tout + integer(c_long), intent(in) :: neq + real(c_double), pointer, intent(in) :: yvec(:) + + integer(c_int) :: ierr + + real(c_double) :: t_soln + + T_vode = T_in + ne_vode = ne_in + rho_vode = rho_in + + ! Initialize the integration time + time = 0.d0 + + ! We will integrate "e" in time. + yvec(1) = e_in + + ! Set the tolerances. + atol = vode_atol_scaled * e_in + rtol = vode_rtol + + ierr = FCVodeReInit(cvmem, time, sunvec_y) + ierr = FCVodeSStolerances(CVmem, rtol, atol) + + ierr = FCVode(CVmem, dt, sunvec_y, time, CV_NORMAL) + + e_out = yvec(1) + T_out = T_vode + ne_out = ne_vode + + end subroutine fcvode_wrapper + + subroutine fcvode_wrapper_vec(dt, rho_in, T_in, ne_in, e_in, neq, cvmem, & + sunvec_y, yvec, T_out, ne_out, e_out) + + use constants_module, only : rt => type_real, M_PI + use vode_aux_module, only: rho_vode_vec, T_vode_vec, ne_vode_vec + use cvode_interface + use fnvector_serial + use misc_params, only: simd_width + use eos_module, only: vode_rtol, vode_atol_scaled + use, intrinsic :: iso_c_binding + + implicit none + + real(rt), intent(in ) :: dt + real(rt), dimension(simd_width), intent(in ) :: rho_in, T_in, ne_in, e_in + type(c_ptr), value :: cvmem + type(c_ptr), value :: sunvec_y + real(rt), dimension(simd_width), intent( out) :: T_out,ne_out,e_out + + real(c_double) :: rtol + real(c_double), pointer, dimension(:) :: atol + real(c_double) :: time, tout + integer(c_long), intent(in) :: neq + real(c_double), pointer, intent(in) :: yvec(:) + type(c_ptr) :: sunvec_atol + + integer(c_int) :: ierr + + real(c_double) :: t_soln + + allocate(atol(simd_width)) + + sunvec_atol = N_VMake_Serial(neq, atol) + + T_vode_vec(1:simd_width) = T_in(1:simd_width) + ne_vode_vec(1:simd_width) = ne_in(1:simd_width) + rho_vode_vec(1:simd_width) = rho_in(1:simd_width) + + ! Initialize the integration time + time = 0.d0 + + ! We will integrate "e" in time. + yvec(1:simd_width) = e_in(1:simd_width) + + ! Set the tolerances. + atol(1:simd_width) = vode_atol_scaled * e_in(1:simd_width) + rtol = vode_rtol + + ierr = FCVodeReInit(cvmem, time, sunvec_y) + ierr = FCVodeSVtolerances(CVmem, rtol, sunvec_atol) + + ierr = FCVode(CVmem, dt, sunvec_y, time, CV_NORMAL) + + e_out(1:simd_width) = yvec(1:simd_width) + T_out(1:simd_width) = T_vode_vec(1:simd_width) + ne_out(1:simd_width) = ne_vode_vec(1:simd_width) + + call N_VDestroy_Serial(sunvec_atol) + deallocate(atol) + + end subroutine fcvode_wrapper_vec + + integer(c_int) function RhsFn(tn, sunvec_y, sunvec_f, user_data) & + result(ierr) bind(C,name='RhsFn') + + use, intrinsic :: iso_c_binding + use fnvector_serial + use cvode_interface + implicit none + + real(c_double), value :: tn + type(c_ptr), value :: sunvec_y + type(c_ptr), value :: sunvec_f + type(c_ptr), value :: user_data + + ! pointers to data in SUNDAILS vectors + real(c_double), pointer :: yvec(:) + real(c_double), pointer :: fvec(:) + + real(c_double) :: energy + + integer(c_long), parameter :: neq = 1 + + ! get data arrays from SUNDIALS vectors + call N_VGetData_Serial(sunvec_y, neq, yvec) + call N_VGetData_Serial(sunvec_f, neq, fvec) + + call f_rhs(1, tn, yvec(1), energy, 0.0, 0) + + fvec(1) = energy + + ierr = 0 + end function RhsFn + + + integer(c_int) function RhsFn_vec(tn, sunvec_y, sunvec_f, user_data) & + result(ierr) bind(C,name='RhsFn_vec') + + use, intrinsic :: iso_c_binding + use fnvector_serial + use cvode_interface + use misc_params, only: simd_width + implicit none + + real(c_double), value :: tn + type(c_ptr), value :: sunvec_y, sunvec_f, user_data + + ! pointers to data in SUNDAILS vectors + real(c_double), dimension(:), pointer :: yvec, fvec + + integer(c_long) :: neq + real(c_double) :: energy(simd_width) + + neq = int(simd_width, c_long) + + ! get data arrays from SUNDIALS vectors + call N_VGetData_Serial(sunvec_y, neq, yvec) + call N_VGetData_Serial(sunvec_f, neq, fvec) + + call f_rhs_vec(tn, yvec, energy) + + fvec = energy + + ierr = 0 + end function RhsFn_vec + +end module fcvode_extras diff --git a/Util/VODE_test/fmain.f90 b/Util/VODE_test/fmain.f90 new file mode 100644 index 00000000..734da858 --- /dev/null +++ b/Util/VODE_test/fmain.f90 @@ -0,0 +1,226 @@ + +program main + + use constants_module, only : rt => type_real, M_PI + use meth_params_module, only : NVAR, URHO, UEDEN, UEINT, & + NDIAG, TEMP_COMP, NE_COMP, ZHI_COMP, & + gamma_minus_1 + use eos_params_module + use eos_module, only: nyx_eos_T_given_Re, nyx_eos_given_RT, fort_setup_eos_params + use fundamental_constants_module + use comoving_module, only: comoving_h, comoving_OmB + use comoving_nd_module, only: fort_integrate_comoving_a + use atomic_rates_module, only: YHELIUM, fort_tabulate_rates, fort_interp_to_this_z + use vode_aux_module , only: JH_vode, JHe_vode, z_vode, i_vode, j_vode, k_vode, & + NR_vode, fn_vode + use reion_aux_module , only: zhi_flash, zheii_flash, flash_h, flash_he, & + T_zhi, T_zheii, inhomogeneous_on + use cvode_interface + use fnvector_serial + use fcvode_extras + use misc_params, only: simd_width + use, intrinsic :: iso_c_binding + + implicit none + + real(rt) :: a, half_dt + integer :: i, j, k + real(rt) :: z, z_end, a_end, rho, H_reion_z, He_reion_z + real(rt) :: T_orig, ne_orig, e_orig + real(rt) :: T_out , ne_out , e_out, mu, mean_rhob, T_H, T_He + real(rt) :: species(5) + + integer(c_int) :: ierr ! error flag from C functions + real(c_double) :: tstart ! initial time + real(c_double) :: atol, rtol + type(c_ptr) :: sunvec_y ! sundials vector + type(c_ptr) :: CVmem ! CVODE memory + integer(c_long), parameter :: neq = 1 +! call amrex_init() + + real(c_double), pointer :: yvec(:) + real(c_double) :: vode_atol_scaled_in, vode_rtol_in, xacc_in + CHARACTER(LEN=80) :: FMT, arg + CHARACTER(LEN=6) :: string + integer :: STRANG_COMP +! integer :: i_loop, j_loop + + DO i = 1, iargc() + CALL getarg(i, arg) + WRITE (*,*) arg + END DO + + print*,"Created data" + + allocate(yvec(neq)) + + print*,"Created data" + + print*,"Read table" + call fort_tabulate_rates() + simd_width = 1 + vode_atol_scaled_in = 1e-4 + vode_rtol_in = 1e-4 + xacc_in = 1e-6 + gamma_minus_1 = 2.d0/3.d0 + call fort_setup_eos_params(xacc_in, vode_rtol_in, vode_atol_scaled_in) + + print*,"Finished reading table" + + allocate(yvec(neq)) + + fn_vode = 0 + NR_vode = 0 + + FMT="(A6,I1,/,ES21.15,/,ES21.15E2,/,ES21.15,/,ES21.15,/,ES21.15,/,ES21.15,/,ES21.15)" + + open(1,FILE=arg) + read(1,FMT) string, STRANG_COMP, a, half_dt, rho, T_orig, ne_orig, e_orig + close(1) + + yvec(1) = e_orig + + print(FMT), string,STRANG_COMP, a, half_dt, rho, T_orig, ne_orig, e_orig + + z = 1.d0/a - 1.d0 + call fort_integrate_comoving_a(a, a_end, half_dt) + z_end = 1.0d0/a_end - 1.0d0 + !Added z_vode arbitrarily to be z, since it was set to 0 + call fort_interp_to_this_z(z) + z_vode = z + + mean_rhob = comoving_OmB * 3.d0*(comoving_h*100.d0)**2 / (8.d0*M_PI*Gconst) + + ! Flash reionization? + if ((flash_h .eqv. .true.) .and. (z .gt. zhi_flash)) then + JH_vode = 0 + else + JH_vode = 1 + endif + if ((flash_he .eqv. .true.) .and. (z .gt. zheii_flash)) then + JHe_vode = 0 + else + JHe_vode = 1 + endif + + if (flash_h ) H_reion_z = zhi_flash + if (flash_he) He_reion_z = zheii_flash + + ! Note that (lo,hi) define the region of the box containing the grow cells + ! Do *not* assume this is just the valid region + ! apply heating-cooling to UEDEN and UEINT + + sunvec_y = N_VMake_Serial(NEQ, yvec) +! if (.not. c_associated(sunvec_y)) then +! call amrex_abort('integrate_state_fcvode: sunvec = NULL') +! end if + + CVmem = FCVodeCreate(CV_BDF, CV_NEWTON) +! if (.not. c_associated(CVmem)) then +! call amrex_abort('integrate_state_fcvode: CVmem = NULL') +! end if + + tstart = 0.0 + ! CVodeMalloc allocates variables and initialize the solver. We can initialize the solver with junk because once we enter the + ! (i,j,k) loop we will immediately call fcvreinit which reuses the same memory allocated from CVodeMalloc but sets up new + ! initial conditions. + ierr = FCVodeInit(CVmem, c_funloc(RhsFn), tstart, sunvec_y) + if (ierr /= 0) then + print*, 'integrate_state_fcvode: FCVodeInit() failed' +! call amrex_abort('integrate_state_fcvode: FCVodeInit() failed') + end if + + ! Set dummy tolerances. These will be overwritten as soon as we enter the loop and reinitialize the solver. + rtol = 1.0d-4 + atol = 1.0d-4*e_orig + ierr = FCVodeSStolerances(CVmem, rtol, atol) + print*, "rtol = ",rtol + print*, "atol = ", atol + +! if (ierr /= 0) then +! call amrex_abort('integrate_state_fcvode: FCVodeSStolerances() failed') +! end if + + ierr = FCVDense(CVmem, neq) +! if (ierr /= 0) then +! call amrex_abort('integrate_state_fcvode: FCVDense() failed') +! end if + + !-----------------cut out do ijk loops + ! Original values + rho = rho !state(i,j,k,URHO) + e_orig = e_orig !state(i,j,k,UEINT) / rho + T_orig = T_orig!diag_eos(i,j,k,TEMP_COMP) + ne_orig = ne_orig!diag_eos(i,j,k, NE_COMP) + + if (inhomogeneous_on) then + H_reion_z = 1*H_reion_z!diag_eos(i,j,k,ZHI_COMP) + if (z .gt. H_reion_z) then + JH_vode = 0 + else + JH_vode = 1 + endif + endif + + if (e_orig .lt. 0.d0) then + !$OMP CRITICAL + print *,'negative e entering strang integration ',z, i,j,k, rho/mean_rhob, e_orig +! call bl_abort('bad e in strang') + !$OMP END CRITICAL + end if + + i_vode = i + j_vode = j + k_vode = k + + call fcvode_wrapper(half_dt,rho,T_orig,ne_orig,e_orig,neq,CVmem,sunvec_y,yvec, & + T_out ,ne_out ,e_out) + + if (e_out .lt. 0.d0) then + !$OMP CRITICAL + print *,'negative e exiting strang integration ',z, i,j,k, rho/mean_rhob, e_out + call flush(6) + !$OMP END CRITICAL + T_out = 10.0 + ne_out = 0.0 + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne_out) + e_out = T_out / (gamma_minus_1 * mp_over_kB * mu) +! call bl_abort('bad e out of strang') + end if + + ! Update T and ne (do not use stuff computed in f_rhs, per vode manual) + call nyx_eos_T_given_Re(JH_vode, JHe_vode, T_out, ne_out, rho, e_out, a, species) + + ! Instanteneous heating from reionization: + T_H = 0.0d0 + if (inhomogeneous_on .or. flash_h) then + if ((H_reion_z .lt. z) .and. (H_reion_z .ge. z_end)) T_H = (1.0d0 - species(2))*max((T_zhi-T_out), 0.0d0) + endif + + T_He = 0.0d0 + if (flash_he) then + if ((He_reion_z .lt. z) .and. (He_reion_z .ge. z_end)) T_He = (1.0d0 - species(5))*max((T_zheii-T_out), 0.0d0) + endif + + if ((T_H .gt. 0.0d0) .or. (T_He .gt. 0.0d0)) then + T_out = T_out + T_H + T_He ! For simplicity, we assume + ne_out = 1.0d0 + YHELIUM ! completely ionized medium at + if (T_He .gt. 0.0d0) ne_out = ne_out + YHELIUM ! this point. It's a very minor + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne_out) ! detail compared to the overall approximation. + e_out = T_out / (gamma_minus_1 * mp_over_kB * mu) + call nyx_eos_T_given_Re(JH_vode, JHe_vode, T_out, ne_out, rho, e_out, a, species) + endif + !-----------------cut out end do ijk loops + print*, "fn_vode = ", fn_vode + print*, "NR_vode = ", NR_vode +! end do +! end do + call N_VDestroy_Serial(sunvec_y) + call FCVodeFree(cvmem) + + deallocate(yvec) + +! call amrex_finalize() + +end program main + diff --git a/Util/VODE_test/fmain_vode.f90 b/Util/VODE_test/fmain_vode.f90 new file mode 100644 index 00000000..42c72d39 --- /dev/null +++ b/Util/VODE_test/fmain_vode.f90 @@ -0,0 +1,217 @@ + +program main + + use constants_module, only : rt => type_real, M_PI + use meth_params_module, only : NVAR, URHO, UEDEN, UEINT, & + NDIAG, TEMP_COMP, NE_COMP, ZHI_COMP, & + gamma_minus_1 + use eos_params_module +! use network + use eos_module, only: nyx_eos_T_given_Re, nyx_eos_given_RT, fort_setup_eos_params + use fundamental_constants_module + use comoving_module, only: comoving_h, comoving_OmB + use comoving_nd_module, only: fort_integrate_comoving_a + use atomic_rates_module, only: YHELIUM, fort_tabulate_rates, fort_interp_to_this_z + use vode_aux_module , only: JH_vode, JHe_vode, z_vode, i_vode, j_vode, k_vode, z_vode, fn_vode, NR_vode + use reion_aux_module , only: zhi_flash, zheii_flash, flash_h, flash_he, & + T_zhi, T_zheii, inhomogeneous_on + use cvode_interface + use fnvector_serial + use fcvode_extras + use, intrinsic :: iso_c_binding + + implicit none + + real(rt) :: a, half_dt + integer :: i, j, k + real(rt) :: z, z_end, a_end, rho, H_reion_z, He_reion_z + real(rt) :: T_orig, ne_orig, e_orig + real(rt) :: T_out , ne_out , e_out, mu, mean_rhob, T_H, T_He + real(rt) :: species(5) + + integer(c_int) :: ierr ! error flag from C functions + real(c_double) :: tstart ! initial time + real(c_double) :: atol, rtol + type(c_ptr) :: sunvec_y ! sundials vector + type(c_ptr) :: CVmem ! CVODE memory + integer(c_long), parameter :: neq = 1 + integer :: fn_out = 0 +! call amrex_init() + + real(c_double), pointer :: yvec(:) + + real(c_double) :: vode_atol_scaled_in, vode_rtol_in, xacc_in + CHARACTER(LEN=80) :: FMT, arg + CHARACTER(LEN=6) :: string + integer :: STRANG_COMP +! integer :: i_loop, j_loop + + DO i = 1, iargc() + CALL getarg(i, arg) + WRITE (*,*) arg + END DO + + print*,"Created data" + + print*,"Read table" + call fort_tabulate_rates() + vode_atol_scaled_in = 1e-4 + vode_rtol_in = 1e-4 + xacc_in = 1e-6 + gamma_minus_1 = 2.d0/3.d0 + call fort_setup_eos_params(xacc_in, vode_rtol_in, vode_atol_scaled_in) + + print*,"Finished reading table" + + allocate(yvec(neq)) + + fn_vode = 0 + NR_vode = 0 + print*,"Read parameters" + + FMT="(A6,I1,/,ES21.15,/,ES21.15E2,/,ES21.15,/,ES21.15,/,ES21.15,/,ES21.15,/,ES21.15)" + + open(1,FILE=arg) + read(1,FMT) string, STRANG_COMP, a, half_dt, rho, T_orig, ne_orig, e_orig + close(1) + + yvec(1) = e_orig + + print*,"Finished reading parameters:" + print(FMT), string,STRANG_COMP, a, half_dt, rho, T_orig, ne_orig, e_orig + + z = 1.d0/a - 1.d0 + call fort_integrate_comoving_a(a, a_end, half_dt) + z_end = 1.0d0/a_end - 1.0d0 + call fort_interp_to_this_z(z) + z_vode = z + + mean_rhob = comoving_OmB * 3.d0*(comoving_h*100.d0)**2 / (8.d0*M_PI*Gconst) + + ! Flash reionization? + if ((flash_h .eqv. .true.) .and. (z .gt. zhi_flash)) then + JH_vode = 0 + else + JH_vode = 1 + endif + if ((flash_he .eqv. .true.) .and. (z .gt. zheii_flash)) then + JHe_vode = 0 + else + JHe_vode = 1 + endif + + if (flash_h ) H_reion_z = zhi_flash + if (flash_he) He_reion_z = zheii_flash + + ! Note that (lo,hi) define the region of the box containing the grow cells + ! Do *not* assume this is just the valid region + ! apply heating-cooling to UEDEN and UEINT + +! sunvec_y = N_VMake_Serial(NEQ, yvec) +! if (.not. c_associated(sunvec_y)) then +! call amrex_abort('integrate_state_fcvode: sunvec = NULL') +! end if + +! CVmem = FCVodeCreate(CV_BDF, CV_NEWTON) +! if (.not. c_associated(CVmem)) then +! call amrex_abort('integrate_state_fcvode: CVmem = NULL') +! end if + + tstart = 0.0 + ! CVodeMalloc allocates variables and initialize the solver. We can initialize the solver with junk because once we enter the + ! (i,j,k) loop we will immediately call fcvreinit which reuses the same memory allocated from CVodeMalloc but sets up new + ! initial conditions. +! ierr = FCVodeInit(CVmem, c_funloc(RhsFn), tstart, sunvec_y) +! if (ierr /= 0) then +! call amrex_abort('integrate_state_fcvode: FCVodeInit() failed') +! end if + + ! Set dummy tolerances. These will be overwritten as soon as we enter the loop and reinitialize the solver. + rtol = 1.0d-5 + atol = 1.0d-10 +! ierr = FCVodeSStolerances(CVmem, rtol, atol) +! if (ierr /= 0) then +! call amrex_abort('integrate_state_fcvode: FCVodeSStolerances() failed') +! end if + +! ierr = FCVDense(CVmem, neq) +! if (ierr /= 0) then +! call amrex_abort('integrate_state_fcvode: FCVDense() failed') +! end if + + !-----------------cut out do ijk loops + ! Original values + rho = rho !state(i,j,k,URHO) + e_orig = e_orig !state(i,j,k,UEINT) / rho + T_orig = T_orig!diag_eos(i,j,k,TEMP_COMP) + ne_orig = ne_orig!diag_eos(i,j,k, NE_COMP) + + if (inhomogeneous_on) then + H_reion_z = 1*H_reion_z!diag_eos(i,j,k,ZHI_COMP) + if (z .gt. H_reion_z) then + JH_vode = 0 + else + JH_vode = 1 + endif + endif + + if (e_orig .lt. 0.d0) then + !$OMP CRITICAL + print *,'negative e entering strang integration ',z, i,j,k, rho/mean_rhob, e_orig +! call bl_abort('bad e in strang') + !$OMP END CRITICAL + end if + + i_vode = i + j_vode = j + k_vode = k + + call vode_wrapper(half_dt,rho,T_orig,ne_orig,e_orig, & + T_out ,ne_out ,e_out, fn_out) + + if (e_out .lt. 0.d0) then + !$OMP CRITICAL + print *,'negative e exiting strang integration ',z, i,j,k, rho/mean_rhob, e_out + call flush(6) + !$OMP END CRITICAL + T_out = 10.0 + ne_out = 0.0 + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne_out) + e_out = T_out / (gamma_minus_1 * mp_over_kB * mu) +! call bl_abort('bad e out of strang') + end if + + ! Update T and ne (do not use stuff computed in f_rhs, per vode manual) + call nyx_eos_T_given_Re(JH_vode, JHe_vode, T_out, ne_out, rho, e_out, a, species) + + ! Instanteneous heating from reionization: + T_H = 0.0d0 + if (inhomogeneous_on .or. flash_h) then + if ((H_reion_z .lt. z) .and. (H_reion_z .ge. z_end)) T_H = (1.0d0 - species(2))*max((T_zhi-T_out), 0.0d0) + endif + + T_He = 0.0d0 + if (flash_he) then + if ((He_reion_z .lt. z) .and. (He_reion_z .ge. z_end)) T_He = (1.0d0 - species(5))*max((T_zheii-T_out), 0.0d0) + endif + + if ((T_H .gt. 0.0d0) .or. (T_He .gt. 0.0d0)) then + T_out = T_out + T_H + T_He ! For simplicity, we assume + ne_out = 1.0d0 + YHELIUM ! completely ionized medium at + if (T_He .gt. 0.0d0) ne_out = ne_out + YHELIUM ! this point. It's a very minor + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne_out) ! detail compared to the overall approximation. + e_out = T_out / (gamma_minus_1 * mp_over_kB * mu) + call nyx_eos_T_given_Re(JH_vode, JHe_vode, T_out, ne_out, rho, e_out, a, species) + endif + !-----------------cut out end do ijk loops + print*, "fn_vode = ", fn_vode + print*, "NR_vode = ", NR_vode +! call N_VDestroy_Serial(sunvec_y) +! call FCVodeFree(cvmem) + + deallocate(yvec) + +! call amrex_finalize() + +end program main + diff --git a/Util/VODE_test/fnvector_serial.f90 b/Util/VODE_test/fnvector_serial.f90 new file mode 100644 index 00000000..49efb31c --- /dev/null +++ b/Util/VODE_test/fnvector_serial.f90 @@ -0,0 +1,607 @@ +! ----------------------------------------------------------------- +! $Revision$ +! $Date$ +! ----------------------------------------------------------------- +! Programmer(s): David J. Gardner @ LLNL +! Daniel R. Reynolds @ SMU +! ----------------------------------------------------------------- +! LLNS Copyright Start +! Copyright (c) 2014, Lawrence Livermore National Security +! This work was performed under the auspices of the U.S. Department +! of Energy by Lawrence Livermore National Laboratory in part under +! Contract W-7405-Eng-48 and in part under Contract DE-AC52-07NA27344. +! Produced at the Lawrence Livermore National Laboratory. +! All rights reserved. +! For details, see the LICENSE file. +! LLNS Copyright End +! ----------------------------------------------------------------- +! This module implements the Fortran 2003 interface to the SUNDIALS +! serial NVECTOR structure. +! ----------------------------------------------------------------- + +module fnvector_serial + + !======= Interfaces ========= + interface + + ! ----------------------------------------------------------------- + ! Function : N_VNew_Serial + ! ----------------------------------------------------------------- + ! This function creates and allocates memory for a serial vector. + ! ----------------------------------------------------------------- + + type(c_ptr) function N_VNew_Serial(vec_length) & + bind(C,name='N_VNewSerial') + use, intrinsic :: iso_c_binding + implicit none + integer(c_long), value :: vec_length + end function N_VNew_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VNewEmpty_Serial + ! ----------------------------------------------------------------- + ! This function creates a new serial N_Vector with an empty (NULL) + ! data array. + ! ----------------------------------------------------------------- + + type(c_ptr) function N_VNewEmpty_Serial(vec_length) & + bind(C,name='N_VNewEmpty_Serial') + use, intrinsic :: iso_c_binding + implicit none + integer(c_long), value :: vec_length + end function N_VNewEmpty_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VMake_Serial + ! ----------------------------------------------------------------- + ! This function creates and allocates memory for a serial vector + ! with a user-supplied data array. + ! ----------------------------------------------------------------- + + type(c_ptr) function N_VMake_Serial(length, v_data) & + bind(C,name='N_VMake_Serial') + use, intrinsic :: iso_c_binding + implicit none + integer(c_long), value :: length + real(c_double) :: v_data(length) + end function N_VMake_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VCloneVectorArray_Serial + ! ----------------------------------------------------------------- + ! This function creates an array of 'count' SERIAL vectors by + ! cloning a given vector w. + ! ----------------------------------------------------------------- + + type(c_ptr) function N_VCloneVectorArray_Serial(count, w) & + bind(C,name='N_VCloneVectorArray_Serial') + use, intrinsic :: iso_c_binding + implicit none + integer(c_int), value :: count + type(c_ptr), value :: w + end function N_VCloneVectorArray_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VCloneVectorArrayEmpty_Serial + ! ----------------------------------------------------------------- + ! This function creates an array of 'count' SERIAL vectors each + ! with an empty (NULL) data array by cloning w. + ! ----------------------------------------------------------------- + + type(c_ptr) function N_VCloneVectorArrayEmpty_Serial(count, w) & + bind(C,name='N_VCloneVectorArrayEmpty_Serial') + use, intrinsic :: iso_c_binding + implicit none + integer(c_int), value :: count + type(c_ptr), value :: w + end function N_VCloneVectorArrayEmpty_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VDestroyVectorArray_Serial + ! ----------------------------------------------------------------- + ! This function frees an array of SERIAL vectors created with + ! N_VCloneVectorArray_Serial or N_VCloneVectorArrayEmpty_Serial. + ! ----------------------------------------------------------------- + + subroutine N_VDestroyVectorArray_Serial(vs, count) & + bind(C,name='N_VDestroyVectorArray_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr) :: vs + integer(c_int) :: count + end subroutine N_VDestroyVectorArray_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VGetLength_Serial + ! ----------------------------------------------------------------- + ! This function returns number of vector elements. + ! ----------------------------------------------------------------- + + integer(c_long) function N_VGetLength_Serial(v) & + bind(C,name='N_VGetLength_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: v + end function N_VGetLength_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VPrint_Serial + ! ----------------------------------------------------------------- + ! This function prints the content of a serial vector to stdout. + ! ----------------------------------------------------------------- + + subroutine N_VPrint_Serial(v) & + bind(C,name='N_VPrint_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: v + end subroutine N_VPrint_Serial + + ! ================================================================= + ! serial implementations of various useful vector operations + ! ================================================================= + + ! ----------------------------------------------------------------- + ! Function : N_VGetVectorID + ! ----------------------------------------------------------------- + ! Returns an identifier for the vector type from enumeration + ! N_Vector_ID. + ! ----------------------------------------------------------------- + + ! integer(c_int) function N_VGetVectorID_Serial(v) & + ! bind(C,name'N_VGetVectorID_Serial') + ! use, intrinsic :: iso_c_binding + ! implicit none + ! type(c_ptr), value :: vec + ! end function N_VGetVectorID_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VCloneEmpty_Serial + ! ----------------------------------------------------------------- + ! Creates a new vector of the same type as an existing vector, + ! but does not allocate storage. + ! ----------------------------------------------------------------- + + type(c_ptr) function N_VCloneEmpty_Serial(w) & + bind(C,name='N_VCloneEmpty_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: w + end function N_VCloneEmpty_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VClone_Serial + ! ----------------------------------------------------------------- + ! Creates a new vector of the same type as an existing vector. + ! It does not copy the vector, but rather allocates storage for + ! the new vector. + ! ----------------------------------------------------------------- + + type(c_ptr) function N_VClone_Serial(w) & + bind(C,name='N_VClone_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: w + end function N_VClone_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VDestroy_Serial + ! ----------------------------------------------------------------- + ! Destroys a vector created with N_VClone_Serial + ! ----------------------------------------------------------------- + + subroutine N_VDestroy_Serial(v) & + bind(C,name='N_VDestroy_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: v + end subroutine N_VDestroy_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VSpace_Serial + ! ----------------------------------------------------------------- + ! Returns space requirements for one N_Vector (type 'realtype' in + ! lrw and type 'long int' in liw). + ! ----------------------------------------------------------------- + + subroutine N_VSpace_Serial(v, lrw, liw) & + bind(C,name='N_VSpace_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: v + integer(c_long) :: lrw + integer(c_long) :: liw + end subroutine N_VSpace_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VGetArrayPointer_Serial + ! ----------------------------------------------------------------- + ! Returns a pointer to the data component of the given N_Vector. + ! + ! NOTE: This function assumes that the internal data is stored + ! as a contiguous 'realtype' array. This routine is only used in + ! the solver-specific interfaces to the dense and banded linear + ! solvers, as well as the interfaces to the banded preconditioners + ! distributed with SUNDIALS. + ! ----------------------------------------------------------------- + + type(c_ptr) function N_VGetArrayPointer_Serial(vec) & + bind(C,name='N_VGetArrayPointer_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: vec + end function N_VGetArrayPointer_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VSetArrayPointer_Serial + ! ----------------------------------------------------------------- + ! Overwrites the data field in the given N_Vector with a user-supplied + ! array of type 'realtype'. + ! + ! NOTE: This function assumes that the internal data is stored + ! as a contiguous 'realtype' array. This routine is only used in + ! the interfaces to the dense linear solver. + ! ----------------------------------------------------------------- + + subroutine N_VSetArrayPointer_Serial(v_data, v) & + bind(C,name='N_VSetArrayPointer_Serial') + use, intrinsic :: iso_c_binding + implicit none + real(c_double) :: v_data + type(c_ptr), value :: v + end subroutine N_VSetArrayPointer_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VLinearSum_Serial + ! ----------------------------------------------------------------- + ! Performs the operation z = a*x + b*y + ! ----------------------------------------------------------------- + + subroutine N_VLinearSum_Serial(a, x, b, y, z) & + bind(C,name='N_VLinearSum_Serial') + use, intrinsic :: iso_c_binding + implicit none + real(c_double), value :: a + type(c_ptr), value :: x + real(c_double), value :: b + type(c_ptr), value :: y + type(c_ptr), value :: z + end subroutine N_VLinearSum_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VConst_Serial + ! ----------------------------------------------------------------- + ! Performs the operation z[i] = c for i = 0, 1, ..., N-1 + ! ----------------------------------------------------------------- + + subroutine N_VConst_Serial(c, z) & + bind(C,name='N_VConst_Serial') + use, intrinsic :: iso_c_binding + implicit none + real(c_double), value :: c + type(c_ptr), value :: z + end subroutine N_VConst_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VProd_Serial + ! ----------------------------------------------------------------- + ! Performs the operation z[i] = x[i]*y[i] for i = 0, 1, ..., N-1 + ! ----------------------------------------------------------------- + + subroutine N_VProd_Serial(x, y, z) & + bind(C,name='N_VProd_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + type(c_ptr), value :: y + type(c_ptr), value :: z + end subroutine N_VProd_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VDiv_Serial + ! ----------------------------------------------------------------- + ! Performs the operation z[i] = x[i]/y[i] for i = 0, 1, ..., N-1 + ! ----------------------------------------------------------------- + + subroutine N_VDiv_Serial(x, y, z) & + bind(C,name='N_VDiv_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + type(c_ptr), value :: y + type(c_ptr), value :: z + end subroutine N_VDiv_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VScale_Serial + ! ----------------------------------------------------------------- + ! Performs the operation z = c*x + ! ----------------------------------------------------------------- + + subroutine N_VScale_Serial(c, x, z) & + bind(C,name='N_VScale_Serial') + use, intrinsic :: iso_c_binding + implicit none + real(c_double), value :: c + type(c_ptr), value :: x + type(c_ptr), value :: z + end subroutine N_VScale_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VAbs_Serial + ! ----------------------------------------------------------------- + ! Performs the operation z[i] = |x[i]| for i = 0, 1, ..., N-1 + ! ----------------------------------------------------------------- + + subroutine N_VAbs_Serial(x, z) & + bind(C,name='N_VAbs_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + type(c_ptr), value :: z + end subroutine N_VAbs_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VInv_Serial + ! ----------------------------------------------------------------- + ! Performs the operation z[i] = 1/x[i] for i = 0, 1, ..., N-1 + ! + ! This routine does not check for division by 0. It should be + ! called only with an N_Vector x which is guaranteed to have + ! all non-zero components. + ! ----------------------------------------------------------------- + + subroutine N_VInv_Serial(x, z) & + bind(C,name='N_VInv_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + type(c_ptr), value :: z + end subroutine N_VInv_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VAddConst + ! ----------------------------------------------------------------- + ! Performs the operation z[i] = x[i] + b for i = 0, 1, ..., N-1 + ! ----------------------------------------------------------------- + + subroutine N_VAddConst_Serial(x, b, z) & + bind(C,name='N_VAddConst_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + real(c_double), value :: b + type(c_ptr), value :: z + end subroutine N_VAddConst_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VDotProd_Serial + ! ----------------------------------------------------------------- + ! Returns the dot product of two vectors: + ! sum (i = 0 to N-1) {x[i]*y[i]} + ! ----------------------------------------------------------------- + + real(c_double) function N_VDotProd_Serial(x, y) & + bind(C,name='N_VDotProd_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + type(c_ptr), value :: y + end function N_VDotProd_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VMaxNorm_Serial + ! ----------------------------------------------------------------- + ! Returns the maximum norm of x: + ! max (i = 0 to N-1) ABS(x[i]) + ! ----------------------------------------------------------------- + + real(c_double) function N_VMaxNorm_Serial(x) & + bind(C,name='N_VMaxNorm_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + end function N_VMaxNorm_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VWrmsNorm_Serial + ! ----------------------------------------------------------------- + ! Returns the weighted root mean square norm of x with weight + ! vector w: + ! sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})/N] + ! ----------------------------------------------------------------- + + real(c_double) function N_VWrmsNorm_Serial(x, w) & + bind(C,name='N_VWrmsNorm_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + type(c_ptr), value :: w + end function N_VWrmsNorm_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VWrmsNormMask_Serial + ! ----------------------------------------------------------------- + ! Returns the weighted root mean square norm of x with weight + ! vector w, masked by the elements of id: + ! sqrt [(sum (i = 0 to N-1) {(x[i]*w[i]*msk[i])^2})/N] + ! where msk[i] = 1.0 if id[i] > 0 and + ! msk[i] = 0.0 if id[i] < 0 + ! ----------------------------------------------------------------- + + real(c_double) function N_VWrmsNormMask_Serial(x, w, id) & + bind(C,name='N_VWrmsNormMask_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + type(c_ptr), value :: w + type(c_ptr), value :: id + end function N_VWrmsNormMask_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VMin_Serial + ! ----------------------------------------------------------------- + ! Returns the smallest element of x: + ! min (i = 0 to N-1) x[i] + ! ----------------------------------------------------------------- + + real(c_double) function N_VMin_Serial(x) & + bind(C,name='N_VMin_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + end function N_VMin_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VWL2Norm_Serial + ! ----------------------------------------------------------------- + ! Returns the weighted Euclidean L2 norm of x with weight + ! vector w: + ! sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})] + ! ----------------------------------------------------------------- + + real(c_double) function N_VWL2Norm_Serial(x, w) & + bind(C,name='N_VWL2Norm_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + type(c_ptr), value :: w + end function N_VWL2Norm_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VL1Norm_Serial + ! ----------------------------------------------------------------- + ! Returns the L1 norm of x: + ! sum (i = 0 to N-1) {ABS(x[i])} + ! ----------------------------------------------------------------- + + real(c_double) function N_VL1Norm_Serial(x) & + bind(C,name='N_VL1Norm_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + end function N_VL1Norm_Serial + + ! ----------------------------------------------------------------- + ! Subroutine : N_VCompare_Serial + ! ----------------------------------------------------------------- + ! Performs the operation + ! z[i] = 1.0 if ABS(x[i]) >= c i = 0, 1, ..., N-1 + ! 0.0 otherwise + ! ----------------------------------------------------------------- + + subroutine N_VCompare_Serial(c, x, z) & + bind(C,name='N_VCompare_Serial') + use, intrinsic :: iso_c_binding + implicit none + real(c_double), value :: c + type(c_ptr), value :: x + type(c_ptr), value :: z + end subroutine N_VCompare_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VInvTest_Serial + ! ----------------------------------------------------------------- + ! Performs the operation z[i] = 1/x[i] with a test for + ! x[i] == 0.0 before inverting x[i]. + ! + ! This routine returns TRUE if all components of x are non-zero + ! (successful inversion) and returns FALSE otherwise. + ! ----------------------------------------------------------------- + + integer(c_int) function N_VInvTest_Serial(x, z) & + bind(C,name='N_VInvTest_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: x + type(c_ptr), value :: z + end function N_VInvTest_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VConstrMask_Serial + ! ----------------------------------------------------------------- + ! Performs the operation : + ! m[i] = 1.0 if constraint test fails for x[i] + ! m[i] = 0.0 if constraint test passes for x[i] + ! where the constraint tests are as follows: + ! If c[i] = +2.0, then x[i] must be > 0.0. + ! If c[i] = +1.0, then x[i] must be >= 0.0. + ! If c[i] = -1.0, then x[i] must be <= 0.0. + ! If c[i] = -2.0, then x[i] must be < 0.0. + ! This routine returns a boolean FALSE if any element failed + ! the constraint test, TRUE if all passed. It also sets a + ! mask vector m, with elements equal to 1.0 where the + ! corresponding constraint test failed, and equal to 0.0 + ! where the constraint test passed. + ! + ! This routine is specialized in that it is used only for + ! constraint checking. + ! ----------------------------------------------------------------- + + integer(c_int) function N_VConstrMask_Serial(c, x, m) & + bind(C,name='N_VConstrMask_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: c + type(c_ptr), value :: x + type(c_ptr), value :: m + end function N_VConstrMask_Serial + + ! ----------------------------------------------------------------- + ! Function : N_VMinQuotient_Serial + ! ----------------------------------------------------------------- + ! Performs the operation : + ! minq = min ( num[i]/denom[i]) over all i such that + ! denom[i] != 0. + ! This routine returns the minimum of the quotients obtained + ! by term-wise dividing num[i] by denom[i]. A zero element + ! in denom will be skipped. If no such quotients are found, + ! then the large value BIG_REAL is returned. + ! ----------------------------------------------------------------- + + real(c_double) function N_VMinQuotient_Serial(num, denom) & + bind(C,name='N_VMinQuotient_Serial') + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: num + type(c_ptr), value :: denom + end function N_VMinQuotient_Serial + + end interface + +contains + + ! ================================================================ + ! Helpful N_Vector_Serial Functions / Subroutines + ! ================================================================ + + subroutine N_VGetData_Serial(SUNVec, length, f_array) + ! ---------------------------------------------------------------- + ! Description: Extracts data array from serial SUNDIALS N_Vector + ! ---------------------------------------------------------------- + + !======= Inclusions =========== + use, intrinsic :: iso_c_binding + + !======= Declarations ========= + implicit none + + ! calling variables + type(c_ptr) :: SUNVec + integer(c_long) :: length + real(c_double), pointer :: f_array(:) + + ! C pointer for N_Vector interal data array + type(c_ptr) :: c_array + + !======= Internals ============ + + ! get data pointer from N_Vector + c_array = N_VGetArrayPointer_Serial(SUNVec) + + ! convert c pointer to f pointer + call c_f_pointer(c_array, f_array, (/length/)) + + end subroutine N_VGetData_Serial + +end module fnvector_serial diff --git a/Util/VODE_test/inputs_atomic b/Util/VODE_test/inputs_atomic new file mode 100644 index 00000000..ee166903 --- /dev/null +++ b/Util/VODE_test/inputs_atomic @@ -0,0 +1,8 @@ +inhomo_reion = 0 +file_in = "TREECOOL_middle" +uvb_density_A = 1.0 +uvb_density_B = 0.0 +zHI_flash = -1.0 +zHeII_flash = -1.0 +T_zHI = 2.0e4 +T_zHeII = 1.5e4 diff --git a/Util/VODE_test/inputs_hc b/Util/VODE_test/inputs_hc new file mode 100644 index 00000000..06365656 --- /dev/null +++ b/Util/VODE_test/inputs_hc @@ -0,0 +1,8 @@ +IntSta1 +1.635780036449432E-01 +8.839029760565609E-06 +2.119999946752000E+12 +3.255559960937500E+04 +1.076699972152710E+00 +6.226414794921875E+02 + diff --git a/Util/VODE_test/integrate_state_vode_3d.f90 b/Util/VODE_test/integrate_state_vode_3d.f90 new file mode 100644 index 00000000..04e6803d --- /dev/null +++ b/Util/VODE_test/integrate_state_vode_3d.f90 @@ -0,0 +1,342 @@ +subroutine integrate_state_vode(lo, hi, & + state , s_l1, s_l2, s_l3, s_h1, s_h2, s_h3, & + diag_eos, d_l1, d_l2, d_l3, d_h1, d_h2, d_h3, & + a, half_dt, min_iter, max_iter, s_comp) +! +! Calculates the sources to be added later on. +! +! Parameters +! ---------- +! lo : double array (3) +! The low corner of the current box. +! hi : double array (3) +! The high corner of the current box. +! state_* : double arrays +! The state vars +! diag_eos_* : double arrays +! Temp and Ne +! src_* : doubles arrays +! The source terms to be added to state (iterative approx.) +! double array (3) +! The low corner of the entire domain +! a : double +! The current a +! half_dt : double +! time step size, in Mpc km^-1 s ~ 10^12 yr. +! +! Returns +! ------- +! state : double array (dims) @todo +! The state vars +! + use constants_module, only : rt => type_real, M_PI + use meth_params_module, only : NVAR, URHO, UEDEN, UEINT, & + NDIAG, TEMP_COMP, NE_COMP, ZHI_COMP, & + SFNR_COMP, SSNR_COMP, DIAG1_COMP, STRANG_COMP, gamma_minus_1 + use eos_params_module + use eos_module, only: nyx_eos_T_given_Re, nyx_eos_given_RT + use fundamental_constants_module + use comoving_module, only: comoving_h, comoving_OmB + use comoving_nd_module, only: fort_integrate_comoving_a + use atomic_rates_module, only: YHELIUM + use vode_aux_module , only: JH_vode, JHe_vode, z_vode, i_vode, j_vode, k_vode + use reion_aux_module , only: zhi_flash, zheii_flash, flash_h, flash_he, & + T_zhi, T_zheii, inhomogeneous_on + + implicit none + + integer , intent(in) :: lo(3), hi(3) + integer , intent(in) :: s_l1, s_l2, s_l3, s_h1, s_h2, s_h3 + integer , intent(in) :: d_l1, d_l2, d_l3, d_h1, d_h2, d_h3 + real(rt), intent(inout) :: state(s_l1:s_h1, s_l2:s_h2,s_l3:s_h3, NVAR) + real(rt), intent(inout) :: diag_eos(d_l1:d_h1, d_l2:d_h2,d_l3:d_h3, NDIAG) + real(rt), intent(in) :: a, half_dt + integer , intent(inout) :: max_iter, min_iter + integer , intent(in ) :: s_comp + + integer :: i, j, k + real(rt) :: z, z_end, a_end, rho, H_reion_z, He_reion_z + real(rt) :: T_orig, ne_orig, e_orig + real(rt) :: T_out , ne_out , e_out, mu, mean_rhob, T_H, T_He + integer :: fn_out + real(rt) :: species(5) + +! STRANG_COMP=SFNR_COMP + + +! STRANG_COMP=SFNR_COMP+s_comp + +!!!!! Writing to first componenet spot first automatically, to keep o +! only the second strang info +! integer :: track_diag_energy; +! track_diag_energy=0; +! if(track_diag_energy) then +! STRANG_COMP=SFNR_COMP +! else + STRANG_COMP=SFNR_COMP+s_comp +! end if + + ! more robustly as an if statement: +! if (s_comp.eq.0) then +! STRANG_COMP=SFNR_COMP +! print *, 'write to first' +! else +! STRANG_COMP=SSNR_COMP +! print *, 'write to second' +! end if + + z = 1.d0/a - 1.d0 + call fort_integrate_comoving_a(a, a_end, half_dt) + z_end = 1.0d0/a_end - 1.0d0 + + mean_rhob = comoving_OmB * 3.d0*(comoving_h*100.d0)**2 / (8.d0*M_PI*Gconst) + + ! Flash reionization? + if ((flash_h .eqv. .true.) .and. (z .gt. zhi_flash)) then + JH_vode = 0 + else + JH_vode = 1 + endif + if ((flash_he .eqv. .true.) .and. (z .gt. zheii_flash)) then + JHe_vode = 0 + else + JHe_vode = 1 + endif + + if (flash_h ) H_reion_z = zhi_flash + if (flash_he) He_reion_z = zheii_flash + + ! Note that (lo,hi) define the region of the box containing the grow cells + ! Do *not* assume this is just the valid region + ! apply heating-cooling to UEDEN and UEINT + + do k = lo(3),hi(3) + do j = lo(2),hi(2) + do i = lo(1),hi(1) + + ! Original values + rho = state(i,j,k,URHO) + e_orig = state(i,j,k,UEINT) / rho + T_orig = diag_eos(i,j,k,TEMP_COMP) + ne_orig = diag_eos(i,j,k, NE_COMP) + + if (inhomogeneous_on) then + H_reion_z = diag_eos(i,j,k,ZHI_COMP) + if (z .gt. H_reion_z) then + JH_vode = 0 + else + JH_vode = 1 + endif + endif + + if (e_orig .lt. 0.d0) then + !$OMP CRITICAL + print *,'negative e entering strang integration ', z, i,j,k, rho/mean_rhob, e_orig +! call bl_abort('bad e in strang') + !$OMP END CRITICAL + end if + + i_vode = i + j_vode = j + k_vode = k + + call vode_wrapper(half_dt,rho,T_orig,ne_orig,e_orig, & + T_out ,ne_out ,e_out, fn_out) + + if (e_out .lt. 0.d0) then + !$OMP CRITICAL + print *,'negative e exiting strang integration ', z, i,j,k, rho/mean_rhob, e_out + call flush(6) + !$OMP END CRITICAL + T_out = 10.0 + ne_out = 0.0 + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne_out) + e_out = T_out / (gamma_minus_1 * mp_over_kB * mu) + !call bl_abort('bad e out of strang') + end if + + ! Update T and ne (do not use stuff computed in f_rhs, per vode manual) + call nyx_eos_T_given_Re(JH_vode, JHe_vode, T_out, ne_out, rho, e_out, a, species) + + ! Instanteneous heating from reionization: + T_H = 0.0d0 + if (inhomogeneous_on .or. flash_h) then + if ((H_reion_z .lt. z) .and. (H_reion_z .ge. z_end)) T_H = (1.0d0 - species(2))*max((T_zhi-T_out), 0.0d0) + endif + + T_He = 0.0d0 + if (flash_he) then + if ((He_reion_z .lt. z) .and. (He_reion_z .ge. z_end)) T_He = (1.0d0 - species(5))*max((T_zheii-T_out), 0.0d0) + endif + + if ((T_H .gt. 0.0d0) .or. (T_He .gt. 0.0d0)) then + T_out = T_out + T_H + T_He ! For simplicity, we assume + ne_out = 1.0d0 + YHELIUM ! completely ionized medium at + if (T_He .gt. 0.0d0) ne_out = ne_out + YHELIUM ! this point. It's a very minor + mu = (1.0d0+4.0d0*YHELIUM) / (1.0d0+YHELIUM+ne_out) ! detail compared to the overall approximation. + e_out = T_out / (gamma_minus_1 * mp_over_kB * mu) + call nyx_eos_T_given_Re(JH_vode, JHe_vode, T_out, ne_out, rho, e_out, a, species) + endif + + ! Update (rho e) and (rho E) + state(i,j,k,UEINT) = state(i,j,k,UEINT) + rho * (e_out-e_orig) + state(i,j,k,UEDEN) = state(i,j,k,UEDEN) + rho * (e_out-e_orig) + + ! Update T and ne + diag_eos(i,j,k,TEMP_COMP) = T_out + diag_eos(i,j,k, NE_COMP) = ne_out +! diag_eos(i,j,k, TMP_COMP) = i*10000+j*100+k + +! diag_eos(i,j,k, STRANG_COMP) = fn_out +! if(track_diag_energy) then +! diag_eos(i,j,k, STRANG_COMP) = e_out-e_orig +! else + diag_eos(i,j,k, STRANG_COMP) = fn_out + diag_eos(i,j,k, DIAG1_COMP) = e_out-e_orig +! endif + + + end do ! i + end do ! j + end do ! k + +end subroutine integrate_state_vode + + +subroutine vode_wrapper(dt, rho_in, T_in, ne_in, e_in, T_out, ne_out, e_out, fn_out) + + use constants_module, only : rt => type_real, M_PI + use vode_aux_module, only: rho_vode, T_vode, ne_vode, & + i_vode, j_vode, k_vode, fn_vode, NR_vode + use meth_params_module, only: STRANG_COMP + implicit none + + real(rt), intent(in ) :: dt + real(rt), intent(in ) :: rho_in, T_in, ne_in, e_in + real(rt), intent( out) :: T_out,ne_out,e_out + integer, intent( out) :: fn_out + + ! Set the number of independent variables -- this should be just "e" + integer, parameter :: NEQ = 1 + + ! Allocate storage for the input state + real(rt) :: y(NEQ) + + ! Our problem is stiff, tell ODEPACK that. 21 means stiff, jacobian + ! function is supplied, 22 means stiff, figure out my jacobian through + ! differencing + integer, parameter :: MF_ANALYTIC_JAC = 21, MF_NUMERICAL_JAC = 22 + + ! Tolerance parameters: + ! + ! itol specifies whether to use an single absolute tolerance for + ! all variables (1), or to pass an array of absolute tolerances, one + ! for each variable with a scalar relative tol (2), a scalar absolute + ! and array of relative tolerances (3), or arrays for both (4) + ! + ! The error is determined as e(i) = rtol*abs(y(i)) + atol, and must + ! be > 0. + ! + ! We will use arrays for both the absolute and relative tolerances, + ! since we want to be easier on the temperature than the species + + integer, parameter :: ITOL = 1 + real(rt) :: atol(NEQ), rtol(NEQ) + + ! We want to do a normal computation, and get the output values of y(t) + ! after stepping though dt + integer, PARAMETER :: ITASK = 1 + + ! istate determines the state of the calculation. A value of 1 meeans + ! this is the first call to the problem -- this is what we will want. + ! Note, istate is changed over the course of the calculation, so it + ! cannot be a parameter + integer :: istate + + ! we will override the maximum number of steps, so turn on the + ! optional arguments flag + integer, parameter :: IOPT = 1 + + ! declare a real work array of size 22 + 9*NEQ + 2*NEQ**2 and an + ! integer work array of since 30 + NEQ + + integer, parameter :: LRW = 22 + 9*NEQ + 2*NEQ**2 + real(rt) :: rwork(LRW) + real(rt) :: time + ! real(rt) :: dt4 + + integer, parameter :: LIW = 30 + NEQ + integer, dimension(LIW) :: iwork + + real(rt) :: rpar + integer :: ipar + integer :: print_radius + CHARACTER(LEN=80) :: FMT + + EXTERNAL jac, f_rhs + + logical, save :: firstCall = .true. + + T_vode = T_in + ne_vode = ne_in + rho_vode = rho_in + fn_vode = 0 + NR_vode = 0 + + ! We want VODE to re-initialize each time we call it + istate = 1 + + rwork(:) = 0.d0 + iwork(:) = 0 + + ! Set the maximum number of steps allowed (the VODE default is 500) + iwork(6) = 2000 + + ! Set the minimum hvalue allowed (the VODE default is 0.d0) +! rwork(7) = 1.d-5 + + ! Initialize the integration time + time = 0.d0 + + ! We will integrate "e" in time. + y(1) = e_in + + ! Set the tolerances. + atol(1) = 1.d-4 * e_in + rtol(1) = 1.d-4 + + !calling dvode + ! call the integration routine + call dvode(f_rhs, NEQ, y, time, dt, ITOL, rtol, atol, ITASK, & + istate, IOPT, rwork, LRW, iwork, LIW, jac, MF_NUMERICAL_JAC, & + rpar, ipar) + + e_out = y(1) + T_out = T_vode + ne_out = ne_vode + + fn_out = NR_vode + + if (istate < 0) then + print *, 'istate = ', istate, 'at (i,j,k) ',i_vode,j_vode,k_vode +! call bl_error("ERROR in vode_wrapper: integration failed") + endif + +! print *,'Calling vode with 1/4 the time step' +! dt4 = 0.25d0 * dt +! y(1) = e_in + +! do n = 1,4 +! call dvode(f_rhs, NEQ, y, time, dt4, ITOL, rtol, atol, ITASK, & +! istate, IOPT, rwork, LRW, iwork, LIW, jac, MF_NUMERICAL_JAC, & +! rpar, ipar) +! if (istate < 0) then +! print *, 'doing subiteration ',n +! print *, 'istate = ', istate, 'at (i,j,k) ',i,j,k +! call bl_error("ERROR in vode_wrapper: sub-integration failed") +! end if + +! end do +! endif + +end subroutine vode_wrapper diff --git a/Util/VODE_test/meth_params.f90 b/Util/VODE_test/meth_params.f90 new file mode 100644 index 00000000..686bf358 --- /dev/null +++ b/Util/VODE_test/meth_params.f90 @@ -0,0 +1,48 @@ + +! This module stores the runtime parameters. +! These parameter are initialized in set_method_params(). + +module meth_params_module + + use constants_module, only : rt => type_real, M_PI + + implicit none + + real(rt), save :: difmag ! used only in consup to weight the divu contributin + integer , save :: iorder ! used only in uslope and uflaten + + real(rt), save, public :: gamma_const, gamma_minus_1 + + integer, parameter :: NHYP = 4 + integer, parameter :: MAXADV = 5 + + ! NTHERM: number of thermodynamic variables + integer , save :: NTHERM, NVAR, NDIAG + integer , save :: URHO, UMX, UMY, UMZ, UEDEN, UEINT, UFA, UFS, UFX + integer , save :: TEMP_COMP, NE_COMP, ZHI_COMP, SFNR_COMP, SSNR_COMP, DIAG1_COMP, DIAG2_COMP, STRANG_COMP + + ! QTHERM: number of primitive variables + integer , save :: QTHERM, QVAR + integer , save :: QRHO, QU, QV, QW, QPRES, QREINT, QFA, QFS + + integer , save :: nadv + + real(rt) , save :: small_dens, small_temp, small_pres + + integer , save :: ppm_type + integer , save :: ppm_reference + integer , save :: ppm_flatten_before_integrals + integer , save :: use_colglaz + integer , save :: use_flattening + integer , save :: version_2 + integer , save :: corner_coupling + integer , save :: use_const_species + integer , save :: normalize_species + integer , save :: heat_cool_type + integer , save :: inhomo_reion + integer , save :: grav_source_type + + integer, save :: npassive + integer, save, allocatable :: qpass_map(:), upass_map(:) + +end module meth_params_module diff --git a/Util/VODE_test/misc_params.f90 b/Util/VODE_test/misc_params.f90 new file mode 100644 index 00000000..fdaac1d7 --- /dev/null +++ b/Util/VODE_test/misc_params.f90 @@ -0,0 +1,7 @@ +module misc_params + + implicit none + + integer :: simd_width + +end module misc_params diff --git a/Util/VODE_test/reion_aux_module.f90 b/Util/VODE_test/reion_aux_module.f90 new file mode 100644 index 00000000..44944343 --- /dev/null +++ b/Util/VODE_test/reion_aux_module.f90 @@ -0,0 +1,10 @@ +module reion_aux_module + + use constants_module, only : rt => type_real, M_PI + implicit none + + ! Global variables (re)set on inputs + real(rt), save :: zhi_flash=-1.0, zheii_flash=-1.0, T_zhi=0.0, T_zheii=0.0 + logical, save :: flash_h=.false., flash_he=.false., inhomogeneous_on=.false. + +end module reion_aux_module diff --git a/Util/VODE_test/vode_aux.f90 b/Util/VODE_test/vode_aux.f90 new file mode 100644 index 00000000..1aa8a7e1 --- /dev/null +++ b/Util/VODE_test/vode_aux.f90 @@ -0,0 +1,16 @@ + +! This module stores the extra parameters for the VODE calls. + +module vode_aux_module + + use constants_module, only : rt => type_real, M_PI + implicit none + + real(rt), save :: z_vode + real(rt), save :: rho_vode, T_vode, ne_vode + real(rt), dimension(:), allocatable, save :: rho_vode_vec, T_vode_vec, ne_vode_vec + integer , save :: JH_vode, JHe_vode, i_vode, j_vode, k_vode, fn_vode, NR_vode + logical, save :: firstcall + !$OMP THREADPRIVATE (rho_vode, rho_vode_vec, T_vode, T_vode_vec, ne_vode, ne_vode_vec, JH_vode, JHe_vode, i_vode, j_vode, k_vode, fn_vode, NR_vode, firstcall) + +end module vode_aux_module diff --git a/Util/zhi_converter/main.cpp b/Util/zhi_converter/main.cpp index 2b97f47a..6463cc6d 100644 --- a/Util/zhi_converter/main.cpp +++ b/Util/zhi_converter/main.cpp @@ -11,8 +11,8 @@ int main(int argc, char* argv[]) { amrex::Initialize(argc, argv); - int num_cells = 512; - int max_grid_size = 64; + uint64_t num_cells = 512; + int max_grid_size = 128; IntVect domain_lo(AMREX_D_DECL(0, 0, 0)); IntVect domain_hi(AMREX_D_DECL(num_cells - 1,