diff --git a/doc/manual/source/user_guide/RunningEnzo.rst b/doc/manual/source/user_guide/RunningEnzo.rst index dae46cdd0..14919e819 100644 --- a/doc/manual/source/user_guide/RunningEnzo.rst +++ b/doc/manual/source/user_guide/RunningEnzo.rst @@ -189,3 +189,57 @@ add more answer tests, especially for large production-type simulations, e.g. a 512\ :sup:`3` cosmology simulation. +Running with OpenMP and Hybrid Parallelism +------------------------------------------ + +Enzo can be run with OpenMP multi-threading enabled to take advantage of multi-core processors. This can be done as a single-process threaded run (1 MPI process with multiple threads) or as a hybrid OpenMP+MPI run (multiple MPI processes with multiple threads per process). + +1. Running a Threaded Simulation (1 MPI Process) +++++++++++++++++++++++++++++++++++++++++++++++++ + +To run a threaded simulation with 1 MPI process, set the ``OMP_NUM_THREADS`` environment variable to the desired number of threads before launching Enzo. For example, to run with 4 threads: + +.. code-block:: none + + ~ $ export OMP_NUM_THREADS=4 + ~ $ ./enzo.exe parameter_file + +Alternatively, you can run it via ``mpirun`` with a single rank: + +.. code-block:: none + + ~ $ export OMP_NUM_THREADS=4 + ~ $ mpirun -np 1 ./enzo.exe parameter_file + +2. Running a Hybrid OpenMP+MPI Simulation ++++++++++++++++++++++++++++++++++++++++++ + +To run Enzo in hybrid OpenMP+MPI mode, you combine MPI process launching (e.g., using ``mpirun`` or ``srun``) with the ``OMP_NUM_THREADS`` variable. + +.. important:: + Because command options and environment variable settings for CPU binding/affinity differ significantly between cluster schedulers (SLURM, PBS, LSF) and MPI implementations (OpenMPI, MPICH, Intel MPI), **users should consult their HPC machine's user guide/documentation** for specific guidance on running hybrid MPI+OpenMP jobs. + +As a general example, to run a simulation with 2 MPI processes and 6 threads per MPI process (using OpenMPI): + +.. code-block:: none + + ~ $ export OMP_NUM_THREADS=6 + ~ $ mpirun -np 2 --bind-to none ./enzo.exe parameter_file + +The flag ``--bind-to none`` (or equivalent for your MPI implementation) is critical to prevent the MPI launcher from binding each MPI process to a single CPU core, which would otherwise force all 6 threads of that process to compete for the same physical core. + +How and Where the Code Has Been Threaded +++++++++++++++++++++++++++++++++++++++++ + +OpenMP parallelization in Enzo is primarily implemented at the **grid level** inside the hierarchy solver (specifically, within the level evolution loop in ``EvolveLevel.C``). + +Key threaded areas of the code include: +- **Hydrodynamics / Gravity Solver:** Evolving independent grids in parallel on each refinement level. +- **Chemistry and Cooling:** Computing species/cooling rates (both native and Grackle-based) in parallel over grids. +- **Particle Mass Deposition & Particle Deletion:** Standard gravity routines operating on grids. +- **Adaptive Ray Tracing (Radiative Transfer):** Parallelized ray propagation and photon package transport on grids. +- **Fourier-Space Gravity Solver:** Element-wise complex multiplications in the root-grid FFT solver. + +Because parallelization is done by distributing grids across threads, simulations with many grids on refined levels will scale most efficiently. When running on a hybrid MPI+OpenMP system, grid loops containing MPI-based communications (such as boundary synchronization and gravity deposits in ``PrepareDensityField.C``) dynamically revert to sequential execution to ensure thread-safe access to the underlying MPI buffers and request queues. + + diff --git a/doc/manual/source/user_guide/building_enzo.rst b/doc/manual/source/user_guide/building_enzo.rst index dc8aebffd..f7fbc1731 100644 --- a/doc/manual/source/user_guide/building_enzo.rst +++ b/doc/manual/source/user_guide/building_enzo.rst @@ -293,5 +293,34 @@ what caused the problem. A common problem is that you forgot to include the current location of the HDF5 libraries in your machine-specific makefile. + +Compiling with OpenMP ++++++++++++++++++++++ + +Enzo supports multi-threading via OpenMP. To compile Enzo with OpenMP enabled: + +1. Enable OpenMP in the build configuration: + + .. code-block:: none + + ~/enzo/src/enzo $ make openmp-yes + +2. Ensure that your machine configuration file (``Make.mach.``) includes the appropriate OpenMP compiler flags (typically ``-fopenmp`` for GCC/Clang, or ``-mp`` or ``-qopenmp`` for Intel/PGI compilers) in ``MACH_FFLAGS``, ``MACH_CCFLAGS``, ``MACH_CXXFLAGS``, and ``MACH_LDFLAGS``. + +3. Compile as usual with ``make``. + +You can check whether OpenMP is enabled by running ``make show-config``; you should see: + +.. code-block:: none + + CONFIG_OPENMP [openmp-{yes,no}] : yes + +To disable OpenMP, run: + +.. code-block:: none + + ~/enzo/src/enzo $ make openmp-no + + Congratulations! You now have a working executable and continue on the next step of running a test calculation. diff --git a/src/enzo/CommunicationBufferedSend.C b/src/enzo/CommunicationBufferedSend.C index 81f5f2f5f..25407ecbd 100644 --- a/src/enzo/CommunicationBufferedSend.C +++ b/src/enzo/CommunicationBufferedSend.C @@ -35,7 +35,7 @@ static int CallCount = 0; /* The MPI Handle and buffer storage area. */ -#define MAX_NUMBER_OF_MPI_BUFFERS 40000 +#define MAX_NUMBER_OF_MPI_BUFFERS 200000 static MPI_Request RequestHandle[MAX_NUMBER_OF_MPI_BUFFERS]; static char *RequestBuffer[MAX_NUMBER_OF_MPI_BUFFERS]; diff --git a/src/enzo/CommunicationCollectParticles.C b/src/enzo/CommunicationCollectParticles.C index 4f262a1fd..763f1bdb4 100644 --- a/src/enzo/CommunicationCollectParticles.C +++ b/src/enzo/CommunicationCollectParticles.C @@ -20,6 +20,8 @@ #ifdef USE_MPI #include "mpi.h" #endif /* USE_MPI */ + +#include "omp.h" #include #include @@ -171,15 +173,15 @@ int CommunicationCollectParticles(LevelHierarchyEntry *LevelArray[], int ZeroOnAllProcs = (ParticlesAreLocal) ? FALSE : TRUE; /* Count number of particles to move first to allocate memory */ - +#pragma omp parallel for default(shared) private(Subgrid, ThisID) reduction(+:NumberToMove[:NumberOfProcessors], StarsToMove[:NumberOfProcessors], APNumberToMove[:NumberOfProcessors]) for (j = 0; j < NumberOfGrids; j++) if (GridHierarchyPointer[j]->NextGridNextLevel != NULL) { - + if (GridHierarchyPointer[j]->GridData->ReturnNumberOfParticles() == 0 && GridHierarchyPointer[j]->GridData->ReturnNumberOfStars() == 0 && GridHierarchyPointer[j]->GridData->ReturnNumberOfActiveParticles() == 0) continue; - + GridHierarchyPointer[j]->GridData-> ZeroSolutionUnderSubgrid(NULL, ZERO_UNDER_SUBGRID_FIELD, 1.0, ZeroOnAllProcs); @@ -188,8 +190,8 @@ int CommunicationCollectParticles(LevelHierarchyEntry *LevelArray[], Subgrid; Subgrid = Subgrid->NextGridThisLevel) { ThisID = Subgrid->GridData->GetGridID(); GridHierarchyPointer[j]->GridData->ZeroSolutionUnderSubgrid - (Subgrid->GridData, ZERO_UNDER_SUBGRID_FIELD, float(ThisID+1), - ZeroOnAllProcs); + (Subgrid->GridData, ZERO_UNDER_SUBGRID_FIELD, float(ThisID+1), + ZeroOnAllProcs); } if (MoveStars) @@ -210,9 +212,10 @@ int CommunicationCollectParticles(LevelHierarchyEntry *LevelArray[], SendList, KeepLocal, ParticlesAreLocal, COPY_OUT, FALSE, TRUE); } // ENDIF subgrids exist - +//end omp parallel for + /* Now allocate the memory once and store the particles to move */ - + TotalNumber = 0; TotalStars = 0; for (j = 0; j < NumberOfProcessors; j++) { @@ -225,7 +228,12 @@ int CommunicationCollectParticles(LevelHierarchyEntry *LevelArray[], } SendList = new particle_data[TotalNumber]; StarSendList = new star_data[TotalStars]; - + +int ParticleCounter = 0; +int StarCounter = 0; +int APCounter = 0; +//printf("Particle Counter reset 1\n"); +#pragma omp parallel for default(shared) reduction(+:NumberToMove[:NumberOfProcessors], StarsToMove[:NumberOfProcessors], APNumberToMove[:NumberOfProcessors]) for (j = 0; j < NumberOfGrids; j++) if (GridHierarchyPointer[j]->NextGridNextLevel != NULL) { @@ -236,18 +244,18 @@ int CommunicationCollectParticles(LevelHierarchyEntry *LevelArray[], GridHierarchyPointer[j]->GridData->TransferSubgridStars - (SubgridPointers, NumberOfSubgrids, StarsToMove, Zero, Zero, + (SubgridPointers, NumberOfSubgrids, StarsToMove, StarCounter, Zero, StarSendList, KeepLocal, ParticlesAreLocal, COPY_OUT, FALSE, FALSE); GridHierarchyPointer[j]->GridData->TransferSubgridActiveParticles - (SubgridPointers, NumberOfSubgrids, APNumberToMove, Zero, Zero, + (SubgridPointers, NumberOfSubgrids, APNumberToMove, APCounter, Zero, APSendList, KeepLocal, ParticlesAreLocal, COPY_OUT, FALSE, FALSE); GridHierarchyPointer[j]->GridData->TransferSubgridParticles - (SubgridPointers, NumberOfSubgrids, NumberToMove, Zero, Zero, + (SubgridPointers, NumberOfSubgrids, NumberToMove, ParticleCounter, Zero, Zero, SendList, KeepLocal, ParticlesAreLocal, COPY_OUT, FALSE, FALSE); - } // ENDIF subgrids exist +//end omp parallel for /* Now we have a list of particles to move to subgrids. If specified, we communicate them with all processors. If not, diff --git a/src/enzo/CommunicationInitialize.C b/src/enzo/CommunicationInitialize.C index 07e5f1a8a..e99389796 100644 --- a/src/enzo/CommunicationInitialize.C +++ b/src/enzo/CommunicationInitialize.C @@ -14,9 +14,14 @@ #include "mpi.h" #include #endif /* USE_MPI */ +#ifdef _OPENMP +#include "omp.h" +#endif /* _OPENMP */ #include #include +#include +#include #include "ErrorExceptions.h" #include "macros_and_parameters.h" @@ -38,6 +43,36 @@ void my_exit(int exit_status); void CommunicationErrorHandlerFn(MPI_Comm *comm, MPI_Arg *err, ...); #endif +#ifndef __APPLE__ +static char *cpuset_to_cstr(cpu_set_t *mask, char *str) +{ + char *ptr = str; + int i, j, entry_made = 0; + for (i = 0; i < CPU_SETSIZE; i++) { + if (CPU_ISSET(i, mask)) { + int run = 0; + entry_made = 1; + for (j = i + 1; j < CPU_SETSIZE; j++) { + if (CPU_ISSET(j, mask)) run++; + else break; + } + if (!run) + sprintf(ptr, "%d,", i); + else if (run == 1) { + sprintf(ptr, "%d,%d,", i, i + 1); + i++; + } else { + sprintf(ptr, "%d-%d,", i, i + run); + i += run; + } + while (*ptr != 0) ptr++; + } + } + ptr -= entry_made; + *ptr = 0; + return(str); +} +#endif /* __APPLE__ */ int CommunicationInitialize(Eint32 *argc, char **argv[]) { @@ -50,7 +85,24 @@ int CommunicationInitialize(Eint32 *argc, char **argv[]) MPI_Arg mpi_size; MPI_Comm comm = MPI_COMM_WORLD; - MPI_Init(argc, argv); +#ifdef _OPENMP + MPI_Arg desired = MPI_THREAD_FUNNELED; + MPI_Arg provided; + MPI_Arg thread; + MPI_Init_thread(argc, argv, desired, &provided); + if (desired != provided) { + thread = omp_get_thread_num(); + MPI_Comm_rank(MPI_COMM_WORLD, &mpi_rank); + if (mpi_rank == ROOT_PROCESSOR && thread == 0) { + fprintf(stderr, "desired = %d, provided = %d\n", desired, provided); + fprintf(stderr, "WARNING: Cannot get proper OpenMP/MPI setting MPI_THREAD_FUNNELED!\n" + "--> Hybrid MPI/OpenMPI mode may fail.\n" + "--> Set environment variable MPICH_MAX_THREAD_SAFETY to funneled.\n"); + } + } +#else + MPI_Init(argc, argv); +#endif MPI_Comm_rank(MPI_COMM_WORLD, &mpi_rank); MPI_Comm_size(MPI_COMM_WORLD, &mpi_size); MPI_Comm_create_errhandler(CommunicationErrorHandlerFn, &CommunicationErrorHandler); @@ -68,10 +120,49 @@ int CommunicationInitialize(Eint32 *argc, char **argv[]) NumberOfProcessors = 1; #endif /* USE_MPI */ + +#ifdef _OPENMP + int CoresPerProcessor; + int tid, cid; + MPI_Comm_rank(MPI_COMM_WORLD, &mpi_rank); +#pragma omp parallel default(shared) private(tid, cid) +{ + CoresPerProcessor = omp_get_num_threads(); + tid = omp_get_thread_num(); + cid = sched_getcpu(); + NumberOfCores = CoresPerProcessor * NumberOfProcessors; + printf("Hello from rank: %d, thread: %d, affinity: (core = %d) \n", mpi_rank, tid, cid); + if (MyProcessorNumber == ROOT_PROCESSOR) + printf("MPI_Init: NumberOfCores = %"ISYM"\n", NumberOfCores); +} +#else + NumberOfCores = NumberOfProcessors; +#endif CommunicationTime = 0; CommunicationDirection = COMMUNICATION_SEND_RECEIVE; + +#ifndef __APPLE__ +#ifdef _OPENMP + int rank, _thread; + cpu_set_t coremask; + char clbuf[7 * CPU_SETSIZE], hnbuf[64]; + + memset(clbuf, 0, sizeof(clbuf)); + memset(hnbuf, 0, sizeof(hnbuf)); + (void)gethostname(hnbuf, sizeof(hnbuf)); +#pragma omp parallel private(_thread, coremask, clbuf) + { + _thread = omp_get_thread_num(); + (void)sched_getaffinity(0, sizeof(coremask), &coremask); + cpuset_to_cstr(&coremask, clbuf); +//#pragma omp barrier + //printf("Hello from rank %d, thread %d, on %s. (core affinity = %s)\n", + // mpi_rank, _thread, hnbuf, clbuf); + } +#endif /* _OPENMP */ +#endif /* __APPLE__ */ return SUCCESS; } diff --git a/src/enzo/CommunicationLoadBalancePhotonGrids.C b/src/enzo/CommunicationLoadBalancePhotonGrids.C index 104a5056e..e19e2f062 100644 --- a/src/enzo/CommunicationLoadBalancePhotonGrids.C +++ b/src/enzo/CommunicationLoadBalancePhotonGrids.C @@ -183,6 +183,7 @@ int CommunicationLoadBalancePhotonGrids(HierarchyEntry **Grids[], int *NumberOfG /* Now we know where the grids are going, transfer them. */ index2 = 0; + if (Nonzero > 1) for (lvl = MIN_LEVEL; lvl < MAX_DEPTH_OF_HIERARCHY; lvl++) { GridsMoved = 0; diff --git a/src/enzo/CommunicationPartitionGrid.C b/src/enzo/CommunicationPartitionGrid.C index b60be5db6..140716630 100644 --- a/src/enzo/CommunicationPartitionGrid.C +++ b/src/enzo/CommunicationPartitionGrid.C @@ -35,10 +35,10 @@ // Function prototypes -int CommunicationBroadcastValue(int *Value, int BroadcastProcessor); int Enzo_Dims_create(int nnodes, int ndims, int *dims); int LoadBalanceHilbertCurve(grid *GridPointers[], int NumberOfGrids, int* &NewProcessorNumber); +int CommunicationSyncNumberOfParticles(grid *GridPointer[], int NumberOfGrids); #define USE_OLD_CPU_DISTRIBUTION @@ -56,7 +56,7 @@ bool FirstTimeCalled = true; int CommunicationPartitionGrid(HierarchyEntry *Grid, int gridnum) { - if (NumberOfProcessors*NumberOfRootGridTilesPerDimensionPerProcessor == 1) + if (NumberOfCores*NumberOfRootGridTilesPerDimensionPerProcessor == 1) return SUCCESS; // Declarations @@ -86,14 +86,12 @@ int CommunicationPartitionGrid(HierarchyEntry *Grid, int gridnum) for (dim = 0; dim < Rank; dim++) Dims[dim] -= 2*NumberOfGhostZones; - float Edge = POW(float(Dims[0]*Dims[1]*Dims[2])/float(NumberOfProcessors), + float Edge = POW(float(Dims[0]*Dims[1]*Dims[2])/float(NumberOfCores), 1/float(Rank)); /* If using MPI, use their routine to calculate layout. */ -#ifdef USE_MPI - int LayoutTemp[] = {0,0,0}; /* @@ -115,7 +113,8 @@ int CommunicationPartitionGrid(HierarchyEntry *Grid, int gridnum) } } else { - int Nnodes = NumberOfProcessors; + //int Nnodes = NumberOfProcessors; + int Nnodes = NumberOfCores; int Ndims = Rank; int LayoutDims[] = {0, 0, 0}; @@ -138,9 +137,6 @@ int CommunicationPartitionGrid(HierarchyEntry *Grid, int gridnum) if (MyProcessorNumber == ROOT_PROCESSOR) { fprintf(stderr, "ENZO_layout %"ISYM" x %"ISYM" x %"ISYM"\n", Layout[0], Layout[1], Layout[2]); } - -#endif /* USE_MPI */ - /* Generate arrays of grid dimensions and start positions. */ @@ -484,12 +480,13 @@ int CommunicationPartitionGrid(HierarchyEntry *Grid, int gridnum) Unigrid = 0; if (debug) printf("Re-set Unigrid = 0\n"); - /* Move Particles (while still on same processor). */ + /* Move Particles (while still on same processor) and sync number of + particles. */ - if (!ParallelRootGridIO) - if (OldGrid->MoveSubgridParticlesFast(gridcounter, SubGrids, TRUE) == FAIL) { - ENZO_FAIL("Error in grid->MoveSubgridParticlesFast."); - } + if (!ParallelRootGridIO) { + OldGrid->MoveSubgridParticlesFast(gridcounter, SubGrids, TRUE); + CommunicationSyncNumberOfParticles(SubGrids, gridcounter); + } int *PartitionProcessorNumbers = NULL; if (LoadBalancing == 4) @@ -514,23 +511,6 @@ int CommunicationPartitionGrid(HierarchyEntry *Grid, int gridnum) grid *NewGrid = ThisGrid->GridData; - /* Broadcast the number of particles to the other processors - (OldGrid is assumed to be on the root processor). */ - - if (NumberOfProcessors > 1) { - - int IntTemp = NewGrid->ReturnNumberOfParticles(); - -// printf("NewGrid->ReturnNumberOfParticles: %"ISYM"\n", IntTemp); - - CommunicationBroadcastValue(&IntTemp, ROOT_PROCESSOR); - - NewGrid->SetNumberOfParticles(IntTemp); - -// printf("NG particle number set to %"ISYM"\n", IntTemp); - - } - /* Transfer from Old to New (which is still also on root processor) */ FLOAT Zero[] = {0,0,0}; diff --git a/src/enzo/CommunicationReceiveHandler.C b/src/enzo/CommunicationReceiveHandler.C index d3323e745..47c5937b0 100644 --- a/src/enzo/CommunicationReceiveHandler.C +++ b/src/enzo/CommunicationReceiveHandler.C @@ -12,6 +12,7 @@ / (and a record of the arguments). / ************************************************************************/ +#define NO_DEBUG #ifdef USE_MPI #include "mpi.h" @@ -50,8 +51,10 @@ int CommunicationReceiveHandler(fluxes **SubgridFluxesEstimate[], CommunicationDirection = COMMUNICATION_RECEIVE; -// printf("P(%"ISYM") in CRH with %"ISYM" requests\n", MyProcessorNumber, -// CommunicationReceiveIndex); +#ifdef DEBUG + printf("P(%"ISYM") in CRH with %"ISYM" requests\n", MyProcessorNumber, + CommunicationReceiveIndex); +#endif MPI_Arg NumberOfCompleteRequests, TotalReceives; int ReceivesCompletedToDate = 0, index, index2, errcode, SUBling, level, @@ -79,9 +82,10 @@ int CommunicationReceiveHandler(fluxes **SubgridFluxesEstimate[], MPI_Waitsome(TotalReceives, CommunicationReceiveMPI_Request, &NumberOfCompleteRequests, ListOfIndices, ListOfStatuses); -// printf("MPI: %"ISYM" %"ISYM" %"ISYM"\n", TotalReceives, -// ReceivesCompletedToDate, NumberOfCompleteRequests); - +#ifdef DEBUG + printf("P(%"ISYM") MPI: %"ISYM" %"ISYM" %"ISYM"\n", MyProcessorNumber, + TotalReceives, ReceivesCompletedToDate, NumberOfCompleteRequests); +#endif CommunicationTime += ReturnWallTime() - time1; /* Error check */ @@ -168,6 +172,8 @@ int CommunicationReceiveHandler(fluxes **SubgridFluxesEstimate[], /* Handle the buffers received, calling the appropriate method. */ + START_LOAD_TIMER; + switch (CommunicationReceiveCallType[index]) { case 1: diff --git a/src/enzo/CommunicationSyncNumberOfParticles.C b/src/enzo/CommunicationSyncNumberOfParticles.C index 25cf82c62..ab92a6b41 100644 --- a/src/enzo/CommunicationSyncNumberOfParticles.C +++ b/src/enzo/CommunicationSyncNumberOfParticles.C @@ -80,3 +80,34 @@ int CommunicationSyncNumberOfParticles(HierarchyEntry *GridHierarchyPointer[], return SUCCESS; } +/************************************************************************/ + +int CommunicationSyncNumberOfParticles(grid *GridPointer[], int NumberOfGrids) +{ + + int i, idx; + int *buffer = new int[2*NumberOfGrids]; + + for (i = 0, idx = 0; i < NumberOfGrids; i++, idx += 2) + if (GridPointer[i]->ReturnProcessorNumber() == MyProcessorNumber) { + buffer[idx] = GridPointer[i]->ReturnNumberOfParticles(); + buffer[idx+1] = GridPointer[i]->ReturnNumberOfStars(); + } else { + buffer[idx] = 0; + buffer[idx+1] = 0; + } + +#ifdef USE_MPI + CommunicationAllReduceValues(buffer, 2*NumberOfGrids, MPI_SUM); +#endif + + for (i = 0, idx = 0; i < NumberOfGrids; i++, idx += 2) { + GridPointer[i]->SetNumberOfParticles(buffer[idx]); + GridPointer[i]->SetNumberOfStars(buffer[idx+1]); + } + + delete [] buffer; + + return SUCCESS; +} + diff --git a/src/enzo/CommunicationTransferSubgridParticles.C b/src/enzo/CommunicationTransferSubgridParticles.C index 6e71a7bb6..22ba0bf50 100644 --- a/src/enzo/CommunicationTransferSubgridParticles.C +++ b/src/enzo/CommunicationTransferSubgridParticles.C @@ -57,7 +57,7 @@ int CommunicationTransferSubgridParticles(LevelHierarchyEntry *LevelArray[], TopGridData *MetaData, int level) { - int proc, i, j, k, jstart, jend, TotalNumber, TotalStars, APTotalNumber; + int proc, i, j, k, TotalNumber, TotalStars, APTotalNumber; int particle_data_size, star_data_size; int Zero = 0; @@ -67,6 +67,11 @@ int CommunicationTransferSubgridParticles(LevelHierarchyEntry *LevelArray[], ChainingMeshStructure ChainingMesh; SiblingGridList SiblingList; + int *jstart = NULL; + int *jend = NULL; + int *kstart = NULL; + int *kend = NULL; + /* Star and particle lists for communication */ particle_data *SendList = NULL; @@ -116,6 +121,13 @@ int CommunicationTransferSubgridParticles(LevelHierarchyEntry *LevelArray[], sibling grids. In the next step, we will allocate the memory and transfer them. */ + int ParticleCounter1 = 0; + int ParticleCounter2 = 0; + int StarCounter = 0; + int APCounter = 0; +#pragma omp parallel +{ +#pragma omp for reduction(+:NumberToMove[:NumberOfProcessors], StarsToMove[:NumberOfProcessors], APNumberToMove[:NumberOfProcessors]) private(ID, grid2, SiblingList) for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { /* Get a list of possible siblings from the chaining mesh */ @@ -166,7 +178,7 @@ int CommunicationTransferSubgridParticles(LevelHierarchyEntry *LevelArray[], APSendList, KeepLocal, ParticlesAreLocal, COPY_OUT, TRUE, TRUE); Grids[grid1]->GridData->TransferSubgridParticles - (GridPointers, NumberOfGrids, NumberToMove, Zero, Zero, + (GridPointers, NumberOfGrids, NumberToMove, ParticleCounter1, Zero, Zero, SendList, KeepLocal, ParticlesAreLocal, COPY_OUT, TRUE, TRUE); delete [] SiblingList.GridList; @@ -175,6 +187,8 @@ int CommunicationTransferSubgridParticles(LevelHierarchyEntry *LevelArray[], /* Allocate the memory for the move list and transfer the particles */ +#pragma omp single +{ TotalNumber = 0; TotalStars = 0; APTotalNumber = 0; @@ -188,23 +202,30 @@ int CommunicationTransferSubgridParticles(LevelHierarchyEntry *LevelArray[], } SendList = new particle_data[TotalNumber]; StarSendList = new star_data[TotalStars]; + StarCounter = 0; + APCounter = 0; +}// end omp single + +#pragma omp for reduction(+:NumberToMove[:NumberOfProcessors], StarsToMove[:NumberOfProcessors], APNumberToMove[:NumberOfProcessors]) for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { Grids[grid1]->GridData->TransferSubgridStars - (GridPointers, NumberOfGrids, StarsToMove, Zero, Zero, + (GridPointers, NumberOfGrids, StarsToMove, StarCounter, Zero, StarSendList, KeepLocal, ParticlesAreLocal, COPY_OUT, TRUE, FALSE); Grids[grid1]->GridData->TransferSubgridActiveParticles - (GridPointers, NumberOfGrids, APNumberToMove, Zero, Zero, + (GridPointers, NumberOfGrids, APNumberToMove, APCounter, Zero, APSendList, KeepLocal, ParticlesAreLocal, COPY_OUT, TRUE, FALSE); Grids[grid1]->GridData->TransferSubgridParticles - (GridPointers, NumberOfGrids, NumberToMove, Zero, Zero, + (GridPointers, NumberOfGrids, NumberToMove, ParticleCounter2, Zero, Zero, SendList, KeepLocal, ParticlesAreLocal, COPY_OUT, TRUE, FALSE); } // ENDFOR grid1 +}// end omp parallel section + FastSiblingLocatorFinalize(&ChainingMesh); /* Now we have a list of particles to move to subgrids, so we @@ -234,79 +255,113 @@ int CommunicationTransferSubgridParticles(LevelHierarchyEntry *LevelArray[], /****************** Copy particles back to grids. ******************/ /*******************************************************************/ - jstart = 0; - jend = 0; + jstart = new int[NumberOfGrids+1]; + jend = new int[NumberOfGrids+1]; + memset(jstart, 0, sizeof(int)*(NumberOfGrids+1)); + memset(jend, 0, sizeof(int)*(NumberOfGrids+1)); + jstart[0] = 0; + jend[0] = 0; + int ParticleIterations = 0; // Copy shared particles to grids, if any + if (NumberOfReceives > 0) { + for (j = 0; j < NumberOfGrids && jend[j] < NumberOfReceives; j++) { + while (SharedList[jend[j]].grid <= j) { + jend[j]++; + if (jend[j] == NumberOfReceives) break; + } + ParticleIterations++; + jstart[j+1] = jend[j]; + } + } - if (NumberOfReceives > 0) - for (j = 0; j < NumberOfGrids && jend < NumberOfReceives; j++) { - while (SharedList[jend].grid <= j) { - jend++; - if (jend == NumberOfReceives) break; + kstart = new int[NumberOfGrids+1]; + kend = new int[NumberOfGrids+1]; + memset(kstart, 0, sizeof(int)*(NumberOfGrids+1)); + memset(kend, 0, sizeof(int)*(NumberOfGrids+1)); + kstart[0] = 0; + kend[0] = 0; + int StarParticleIterations = 0; + // Copy shared particles to grids, if any + if (StarNumberOfReceives > 0) { + for (k = 0; k < NumberOfGrids && kend[k] < StarNumberOfReceives; k++) { + while (StarSharedList[kend[k]].grid <= k) { + kend[k]++; + if (kend[k] == StarNumberOfReceives) break; } + StarParticleIterations++; + kstart[k+1] = kend[k]; + } + } + + // for(j = 0; jjstart[%d]= %d | jend[%d] = %d\n", j,jstart[j], j, jend[j]); + + ParticleCounter1 = 0; + ParticleCounter2 = 0; +#pragma omp parallel +{ +#pragma omp for reduction(+:NumberToMove[:NumberOfProcessors], StarsToMove[:NumberOfProcessors], APNumberToMove[:NumberOfProcessors]) + for (j = 0; j < ParticleIterations; j++) { - /* - printf("j =%d, jstart =%d, jend =%d, NumberOfGrids =%d, " + +/* printf("--> j =%d, ParticleIterations= %d, jstart =%d, jend =%d, NumberOfGrids =%d, " "NumberToMove[] =%d/%d, NumberOfReceives =%d\n", - j, jstart, jend, NumberOfGrids, - NumberToMove[0], NumberToMove[1], NumberOfReceives); - */ + j, ParticleIterations, jstart[j], jend[j], NumberOfGrids, + NumberToMove[0], NumberToMove[1], NumberOfReceives); */ + GridPointers[j]->TransferSubgridParticles - (GridPointers, NumberOfGrids, NumberToMove, jstart, jend, + (GridPointers, NumberOfGrids, NumberToMove, ParticleCounter1, jstart[j], jend[j], SharedList, KeepLocal, ParticlesAreLocal, COPY_IN, TRUE); - jstart = jend; + //jstart = jend; } // ENDFOR grids - + /*******************************************************************/ /******************** Copy stars back to grids. ********************/ /*******************************************************************/ - jstart = 0; - jend = 0; - // Copy shared stars to grids, if any +#pragma omp for reduction(+:NumberToMove[:NumberOfProcessors], StarsToMove[:NumberOfProcessors], APNumberToMove[:NumberOfProcessors]) + for (k = 0; k < StarParticleIterations; k++) { - if (StarNumberOfReceives > 0) - for (j = 0; j < NumberOfGrids && jend < StarNumberOfReceives; j++) { - while (StarSharedList[jend].grid <= j) { - jend++; - if (jend == StarNumberOfReceives) break; - } +/* printf("--> k =%d, StarParticleIterations= %d, kstart =%d, kend =%d, NumberOfGrids =%d, " + "NumberToMove[] =%d/%d, NumberOfReceives =%d\n", + k, StarParticleIterations, kstart[k], kend[k], NumberOfGrids, + StarsToMove[0], StarsToMove[1], StarNumberOfReceives); */ + - GridPointers[j]->TransferSubgridStars - (GridPointers, NumberOfGrids, StarsToMove, jstart, jend, + GridPointers[k]->TransferSubgridStars + (GridPointers, NumberOfGrids, StarsToMove, kstart[k], kend[k], StarSharedList, KeepLocal, ParticlesAreLocal, COPY_IN, TRUE); - jstart = jend; + //jstart = jend; } // ENDFOR grids +} // end omp parallel /*******************************************************************/ /************** Copy Active Particles back to grids. ***************/ /*******************************************************************/ - jstart = 0; - jend = 0; + jstart[0] = 0; + jend[0] = 0; // Copy shared stars to grids, if any if (APNumberOfReceives > 0) - for (j = 0; j < NumberOfGrids && jend < APNumberOfReceives; j++) { - while (APSharedList[jend]->ReturnGridID() <= j) { - jend++; - if (jend == APNumberOfReceives) break; + for (j = 0; j < NumberOfGrids && jend[0] < APNumberOfReceives; j++) { + while (APSharedList[jend[0]]->ReturnGridID() <= j) { + jend[0]++; + if (jend[0] == APNumberOfReceives) break; } GridPointers[j]->TransferSubgridActiveParticles - (GridPointers, NumberOfGrids, APNumberToMove, jstart, jend, + (GridPointers, NumberOfGrids, APNumberToMove, jstart[0], jend[0], APSharedList, KeepLocal, ParticlesAreLocal, COPY_IN, TRUE); - jstart = jend; + jstart[0] = jend[0]; } // ENDFOR grids - - /************************************************************************ Since the particles and stars are only on the grid's host processor, set number of particles so everybody agrees. diff --git a/src/enzo/CommunicationUtilities.C b/src/enzo/CommunicationUtilities.C index 22867b52b..0a6d78516 100644 --- a/src/enzo/CommunicationUtilities.C +++ b/src/enzo/CommunicationUtilities.C @@ -16,7 +16,8 @@ #include #include - + +#include "EnzoTiming.h" #include "ErrorExceptions.h" #include "macros_and_parameters.h" #include "typedefs.h" @@ -38,8 +39,8 @@ GlobalCommunication += endtime-starttime; \ CommunicationTime += endtime-starttime; #else -#define START_TIMING ; -#define END_TIMING ; +#define START_TIMING TIMER_START("Communication"); +#define END_TIMING TIMER_STOP("Communication"); #endif diff --git a/src/enzo/ComputePotentialFieldLevelZero.C b/src/enzo/ComputePotentialFieldLevelZero.C index 5f6bdbf1f..9b083e845 100644 --- a/src/enzo/ComputePotentialFieldLevelZero.C +++ b/src/enzo/ComputePotentialFieldLevelZero.C @@ -289,7 +289,9 @@ int ComputePotentialFieldLevelZeroPer(TopGridData *MetaData, /* In periodic case, the Greens function is purely real. */ if (MetaData->GravityBoundary == TopGridPeriodic) { - for (n = 0, j = 0; j < size; j += 2, n++) { +#pragma omp parallel for + for (j = 0; j < size; j += 2) { + int n = j / 2; OutRegion[i].Data[j ] *= coef*GreensRegion[i].Data[n]; OutRegion[i].Data[j+1] *= coef*GreensRegion[i].Data[n]; } @@ -301,6 +303,7 @@ int ComputePotentialFieldLevelZeroPer(TopGridData *MetaData, if (MetaData->GravityBoundary == TopGridIsolated) { float real_part, imag_part; +#pragma omp parallel for private(real_part, imag_part) for (j = 0; j < size; j += 2) { real_part = OutRegion[i].Data[j ]*GreensRegion[i].Data[j ] - OutRegion[i].Data[j+1]*GreensRegion[i].Data[j+1]; diff --git a/src/enzo/CopyZonesFromOldGrids.C b/src/enzo/CopyZonesFromOldGrids.C index 81fdeb34f..bb33c3c62 100644 --- a/src/enzo/CopyZonesFromOldGrids.C +++ b/src/enzo/CopyZonesFromOldGrids.C @@ -143,7 +143,6 @@ int CopyZonesFromOldGrids(LevelHierarchyEntry *OldGrids, if (CommunicationReceiveHandler() == FAIL) ENZO_FAIL("CommunicationReceiveHandler() failed!\n"); - /* Delete old grids and increase total grid count and then advance FirstGrid pointer */ diff --git a/src/enzo/CreateFluxes.C b/src/enzo/CreateFluxes.C index 11db915c2..8bde22c73 100644 --- a/src/enzo/CreateFluxes.C +++ b/src/enzo/CreateFluxes.C @@ -46,6 +46,7 @@ int CreateFluxes(HierarchyEntry *Grids[],fluxes **SubgridFluxesEstimate[], /* For each grid, compute the number of it's subgrids. */ +#pragma omp parallel for schedule(static) private(NextGrid, counter) for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { NextGrid = Grids[grid1]->NextGridNextLevel; counter = 0; @@ -59,6 +60,8 @@ int CreateFluxes(HierarchyEntry *Grids[],fluxes **SubgridFluxesEstimate[], } +#pragma omp parallel for schedule(static) \ + private(subgrid, counter, RefinementFactors, NextGrid) for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { /* Allocate the subgrid fluxes for this grid. */ diff --git a/src/enzo/CreateSourceClusteringTree.C b/src/enzo/CreateSourceClusteringTree.C index 13a60548a..33f446612 100644 --- a/src/enzo/CreateSourceClusteringTree.C +++ b/src/enzo/CreateSourceClusteringTree.C @@ -103,7 +103,7 @@ int CreateSourceClusteringTree(int nShine, SuperSourceData *SourceList, OldSourceClusteringTree = SourceClusteringTree; SourceClusteringTree = NULL; - } // ENDIF SourceList == NULL (first time) + } // ENDIF SourceList == NULL (first time) /* Calculate "center of light" first and assign it to the tree. */ @@ -213,8 +213,9 @@ int CreateSourceClusteringTree(int nShine, SuperSourceData *SourceList, nleft = (nShine+1)/2; nright = nShine-nleft; } + /* Divide into children if there are more than one source */ - + if (nShine > 2) { // Left leaf (copy to temp, make tree, copy back) diff --git a/src/enzo/DepositParticleMassField.C b/src/enzo/DepositParticleMassField.C index bf6d2f1e0..ffe3af767 100644 --- a/src/enzo/DepositParticleMassField.C +++ b/src/enzo/DepositParticleMassField.C @@ -9,6 +9,8 @@ / PURPOSE: / ************************************************************************/ + +#include "preincludes.h" #include #include "ErrorExceptions.h" @@ -30,6 +32,8 @@ int DepositParticleMassFieldChildren(HierarchyEntry *DepositGrid, int DepositParticleMassField(HierarchyEntry *Grid, FLOAT TimeMidStep) { + + START_LOAD_TIMER; /* Get the time and dt for this grid. Compute time+1/2 dt. */ @@ -69,6 +73,8 @@ int DepositParticleMassField(HierarchyEntry *Grid, FLOAT TimeMidStep) GRAVITATING_MASS_FIELD_PARTICLES) == FAIL) { ENZO_FAIL("Error in grid->DepositParticlePositions.\n"); } + + END_LOAD_TIMER(Grid->GridData,0); /* Recursively deposit particles in children (at TimeMidStep). */ @@ -90,12 +96,16 @@ int DepositParticleMassFieldChildren(HierarchyEntry *DepositGrid, { /* Deposit particles in Grid into DepositGrid at the given time. */ + + START_LOAD_TIMER; if (Grid->GridData->DepositParticlePositions(DepositGrid->GridData, DepositTime, GRAVITATING_MASS_FIELD_PARTICLES) == FAIL) { ENZO_FAIL("Error in grid->DepositParticlePositions.\n"); } + END_LOAD_TIMER(DepositGrid->GridData,0); + /* Next grid on this level. */ if (Grid->NextGridThisLevel != NULL) diff --git a/src/enzo/DetermineNumberOfNodes.C b/src/enzo/DetermineNumberOfNodes.C index ff29a672b..b1970a20c 100644 --- a/src/enzo/DetermineNumberOfNodes.C +++ b/src/enzo/DetermineNumberOfNodes.C @@ -90,7 +90,8 @@ int DetermineNumberOfNodes(void) CoresPerNode = NumberOfProcessors / NumberOfNodes; if (debug) - printf("DetermineNumberOfNodes: %"ISYM" nodes, %"ISYM" cores per node\n", + printf("DetermineNumberOfNodes: %"ISYM" nodes, " + "%"ISYM" MPI processes per node\n", NumberOfNodes, CoresPerNode); return NumberOfNodes; diff --git a/src/enzo/DetermineSubgridSizeExtrema.C b/src/enzo/DetermineSubgridSizeExtrema.C index 9c7c3e040..23c535f9e 100644 --- a/src/enzo/DetermineSubgridSizeExtrema.C +++ b/src/enzo/DetermineSubgridSizeExtrema.C @@ -32,7 +32,7 @@ #include "CommunicationUtilities.h" #define MINIMUM_EDGE 4 -#define MINIMUM_SIZE 2000 +#define MINIMUM_SIZE 512 int DetermineSubgridSizeExtrema(long_int NumberOfCells, int level, int MaximumStaticSubgridLevel) { @@ -45,10 +45,12 @@ int DetermineSubgridSizeExtrema(long_int NumberOfCells, int level, int MaximumSt int grids_per_proc = (level > MaximumStaticSubgridLevel) ? OptimalSubgridsPerProcessor : 8; - MaximumSubgridSize = NumberOfCells / - (NumberOfProcessors * grids_per_proc); + MaximumSubgridSize = NumberOfCells / (NumberOfCores * grids_per_proc); MaximumSubgridSize = max(MaximumSubgridSize, MINIMUM_SIZE); - MinimumSubgridEdge = nint(pow(MaximumSubgridSize, 0.33333) * 0.25); + if (level > MaximumStaticSubgridLevel) + MinimumSubgridEdge = nint(pow(MaximumSubgridSize, 0.33333) * 0.25); + else + MinimumSubgridEdge = nint(pow(MaximumSubgridSize, 0.33333) * 0.1); MinimumSubgridEdge += MinimumSubgridEdge % 2; MinimumSubgridEdge = max(MinimumSubgridEdge, MINIMUM_EDGE); diff --git a/src/enzo/EnzoTiming.h b/src/enzo/EnzoTiming.h index 04fb91967..d54ea99a0 100644 --- a/src/enzo/EnzoTiming.h +++ b/src/enzo/EnzoTiming.h @@ -332,10 +332,13 @@ namespace enzo_timing{ double total_cells = get_total_cells(); double cell_rate; + double mytime, thistime; // Print out info for each timer. for( SectionMap::iterator iter=timers.begin(); iter!=timers.end(); ++iter){ - current_time = iter->second->get_current_time(); - Reduce_Times(current_time, time_array); + thistime = 0.0; + mytime = iter->second->get_current_time(); + thistime = mytime; + Reduce_Times(thistime, time_array); cell_rate = 0.0; if (my_rank == 0){ this->analyze_times(time_array, nprocs, &mean_time, &stddev_time, &min_time, &max_time); @@ -389,25 +392,59 @@ namespace enzo_timing{ //int last_cycle; // The last cycle number that was written out. bool first_write; // Is this the first time we've written out? }; -} -#ifdef DEFINE_STORAGE -# define EXTERN -#else /* DEFINE_STORAGE */ -# define EXTERN extern + inline void start(enzo_timer *timer, char *name){ +#ifdef _OPENMP +#pragma omp masked #endif + timer->start(name); + }; + inline void stop(enzo_timer *timer, char *name){ +#ifdef _OPENMP +#pragma omp masked +#endif + timer->stop(name); + }; -EXTERN enzo_timing::enzo_timer *enzo_timer; // Add global timer + inline void write_out(enzo_timer *timer, int cycle){ +#ifdef _OPENMP +#pragma omp masked +#endif + timer->write_out(cycle); + }; + + inline void create(enzo_timer *timer, char *name){ +#ifdef _OPENMP +#pragma omp masked +#endif + timer->create(name); + }; + + inline void add_cells_to_level(enzo_timer *timer, int level, double cells){ +#ifdef _OPENMP +#pragma omp masked +#endif + timer->get_level(level)->add_cells(cells); + }; + + inline void add_grids_to_level(enzo_timer *timer, int level, long int grids){ +#ifdef _OPENMP +#pragma omp masked +#endif + timer->get_level(level)->set_ngrids(grids); + }; + +} // Macros to start, stop, and write timers. #ifdef ENZO_PERFORMANCE -#define TIMER_START(section_name) enzo_timer->start(section_name) -#define TIMER_STOP(section_name) enzo_timer->stop(section_name) -#define TIMER_WRITE(cycle_number) enzo_timer->write_out(cycle_number) -#define TIMER_REGISTER(name) enzo_timer->create(name) -#define TIMER_ADD_CELLS(level, cells) enzo_timer->get_level(level)->add_cells(cells) -#define TIMER_SET_NGRIDS(level, grids) enzo_timer->get_level(level)->set_ngrids(grids) +#define TIMER_START(section_name) enzo_timing::start(enzo_timer, section_name) +#define TIMER_STOP(section_name) enzo_timing::stop(enzo_timer, section_name) +#define TIMER_WRITE(cycle_number) enzo_timing::write_out(enzo_timer, cycle_number) +#define TIMER_REGISTER(name) enzo_timing::create(enzo_timer, name) +#define TIMER_ADD_CELLS(level, cells) enzo_timing::add_cells_to_level(enzo_timer, level, cells) +#define TIMER_SET_NGRIDS(level, grids) enzo_timing::add_grids_to_level(enzo_timer, level, grids) #else #define TIMER_START(section_name) #define TIMER_STOP(section_name) @@ -417,4 +454,13 @@ EXTERN enzo_timing::enzo_timer *enzo_timer; // Add global timer #define TIMER_SET_NGRIDS(level, grids) #endif +#ifdef DEFINE_STORAGE +# define EXTERN +#else /* DEFINE_STORAGE */ +# define EXTERN extern +#endif + +EXTERN enzo_timing::enzo_timer *enzo_timer; // Add global timer +//#pragma omp threadprivate(enzo_timer) + #endif //ENZO_TIMING diff --git a/src/enzo/EvolveHierarchy.C b/src/enzo/EvolveHierarchy.C index bbe06015f..0f53d16bc 100644 --- a/src/enzo/EvolveHierarchy.C +++ b/src/enzo/EvolveHierarchy.C @@ -525,7 +525,7 @@ int EvolveHierarchy(HierarchyEntry &TopGrid, TopGridData &MetaData, } */ #endif - + if (EvolveLevel(&MetaData, LevelArray, 0, dt, Exterior #ifdef TRANSFER , ImplicitSolver @@ -697,7 +697,7 @@ int EvolveHierarchy(HierarchyEntry &TopGrid, TopGridData &MetaData, if (MyProcessorNumber == ROOT_PROCESSOR) { evlog = fopen("Evtime", "a"); - fprintf(evlog, "%8"ISYM" %16.9e %16.9e %16.9e\n", MetaData.CycleNumber, tlev1-tlev0, treb1-treb0, tloop1-tloop0); + fprintf(evlog, "%8"ISYM" %16.9e %16.9e %16.9e %12d %12d\n", MetaData.CycleNumber, tlev1-tlev0, treb1-treb0, tloop1-tloop0, NumberOfProcessors, NumberOfCores); fclose(evlog); } @@ -716,7 +716,7 @@ int EvolveHierarchy(HierarchyEntry &TopGrid, TopGridData &MetaData, TIMER_STOP("Total"); if ((MetaData.CycleNumber-1) % TimingCycleSkip == 0) - TIMER_WRITE(MetaData.CycleNumber); + TIMER_WRITE(MetaData.CycleNumber); FirstLoop = false; diff --git a/src/enzo/EvolveLevel.C b/src/enzo/EvolveLevel.C index 7501e8c42..6ffe079f2 100644 --- a/src/enzo/EvolveLevel.C +++ b/src/enzo/EvolveLevel.C @@ -72,6 +72,10 @@ #ifdef USE_MPI #include "mpi.h" #endif /* USE_MPI */ + +#ifdef _OPENMP +#include "omp.h" +#endif #include #include @@ -290,6 +294,7 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], int dbx = 0; FLOAT When, GridTime; + double _mpi_time; //float dtThisLevelSoFar = 0.0, dtThisLevel, dtGrid, dtActual, dtLimit; //float dtThisLevelSoFar = 0.0, dtThisLevel; int cycle = 0, counter = 0, grid1, subgrid, grid2; @@ -300,11 +305,12 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], sprintf(level_name, "Level_%02"ISYM, level); // Update lcaperf "level" attribute + Eint32 lcaperf_level = level; #ifdef USE_LCAPERF lcaperf.attribute ("level",&lcaperf_level,LCAPERF_INT); #endif - + /* Create an array (Grids) of all the grids. */ typedef HierarchyEntry* HierarchyEntryPointer; @@ -316,6 +322,14 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], int *TotalStarParticleCountPrevious = new int[NumberOfGrids]; RunEventHooks("EvolveLevelTop", Grids, *MetaData); + bool thread_grid_loop = false; +#ifdef _OPENMP + if (HybridParallelRootGridSplit) + thread_grid_loop = true; + else + thread_grid_loop = (level > 0) && (NumberOfGrids > 1); +#endif + /* Create a SUBling list of the subgrids */ LevelHierarchyEntry **SUBlingList; @@ -362,6 +376,8 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], put them into the SubgridFluxesEstimate array. */ if(CheckpointRestart == TRUE) { + +#pragma omp parallel for if(thread_grid_loop) schedule(dynamic) for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { if (Grids[grid1]->GridData->FillFluxesFromStorage( &NumberOfSubgrids[grid1], @@ -371,10 +387,12 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], } } } else { - for (grid1 = 0; grid1 < NumberOfGrids; grid1++){ + +#pragma omp parallel for if(thread_grid_loop) schedule(dynamic) + for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { Grids[grid1]->GridData->ClearBoundaryFluxes(); if ( level > 0 ) - Grids[grid1]->GridData->ClearAvgElectricField(); + Grids[grid1]->GridData->ClearAvgElectricField(); } } @@ -397,6 +415,11 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], if(CheckpointRestart == FALSE) { TIMER_START(level_name); + /* Reset performance counter for load balancer */ + + for (grid1 = 0; grid1 < NumberOfGrids; grid1++) + Grids[grid1]->GridData->ResetCost(); + SetLevelTimeStep(Grids, NumberOfGrids, level, &dtThisLevelSoFar[level], &dtThisLevel[level], dtLevelAbove); @@ -506,7 +529,11 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], /* ------------------------------------------------------- */ /* Evolve all grids by timestep dtThisLevel. */ + #pragma omp parallel for if(thread_grid_loop) schedule(dynamic) private(_mpi_time) + for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { + + START_LOAD_TIMER; CallProblemSpecificRoutines(MetaData, Grids[grid1], grid1, &norm, TopGridTimeStep, level, LevelCycleCount); @@ -544,13 +571,19 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], } */ #ifdef SAB + + END_LOAD_TIMER(Grids[grid1]->GridData,0); + } // End of loop over grids //Ensure the consistency of the AccelerationField SetAccelerationBoundary(Grids, NumberOfGrids,SiblingList,level, MetaData, - Exterior, LevelArray[level], LevelCycleCount[level]); + Exterior, LevelArray[level], LevelCycleCount[level]); + + #pragma omp parallel for if(thread_grid_loop) schedule(dynamic) private(_mpi_time) for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { + START_LOAD_TIMER; #endif //SAB. /* Copy current fields (with their boundaries) to the old fields in preparation for the new step. */ @@ -667,7 +700,10 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], /* Solve the cooling and species rate equations. */ + int loop_status = SUCCESS; +#pragma omp parallel for if(thread_grid_loop) schedule(dynamic) for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { + if (loop_status == FAIL) continue; Grids[grid1]->GridData->MultiSpeciesHandler(); /* Update particle positions (if present). */ @@ -708,7 +744,9 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], /* Compute and apply thermal conduction. */ if(IsotropicConduction || AnisotropicConduction){ if(Grids[grid1]->GridData->ConductHeat() == FAIL){ - ENZO_FAIL("Error in grid->ConductHeat.\n"); + fprintf(stderr, "Error in grid->ConductHeat.\n"); +#pragma omp atomic write + loop_status = FAIL; } } @@ -717,19 +755,22 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], if(CRDiffusion == 1){ // isotropic diffusion if(Grids[grid1]->GridData->ComputeCRDiffusion() == FAIL){ fprintf(stderr, "Error in grid->ComputeExplicitIsotropicCRDiffusion.\n"); - return FAIL; +#pragma omp atomic write + loop_status = FAIL; } } else if(CRDiffusion == 2){ // anisotripic diffusion if(Grids[grid1]->GridData->ComputeAnisotropicCRDiffusion() == FAIL){ fprintf(stderr, "Error in grid->ComputeAnisotropicCRDiffusion .\n"); - return FAIL; +#pragma omp atomic write + loop_status = FAIL; } } if(CRStreaming){ // cosmic ray streaming if(Grids[grid1]->GridData->ComputeCRStreaming() == FAIL){ fprintf(stderr, "Error in grid->ComputeCRStreaming .\n"); - return FAIL; +#pragma omp atomic write + loop_status = FAIL; } } }// end CRModel if @@ -756,15 +797,22 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], if (ComovingCoordinates) Grids[grid1]->GridData->ComovingExpansionTerms(); + + END_LOAD_TIMER(Grids[grid1]->GridData,0); if (UseMagneticSupernovaFeedback) Grids[grid1]->GridData->MagneticSupernovaList.clear(); - } //end loop over grids - /* Finalize (accretion, feedback etc) for Active particles. */ + } //end loop over grids + + if (loop_status == FAIL) { + return FAIL; + } + ActiveParticleFinalize(Grids, MetaData, NumberOfGrids, LevelArray, level, NumberOfNewActiveParticles); /* Finalize (accretion, feedback, etc.) star particles */ + StarParticleFinalize(Grids, MetaData, NumberOfGrids, LevelArray, level, AllStars, TotalStarParticleCountPrevious, OutputNow); @@ -801,6 +849,8 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], /* For each grid, delete the GravitatingMassFieldParticles. */ + #pragma omp parallel for if(thread_grid_loop) schedule(static) + for (grid1 = 0; grid1 < NumberOfGrids; grid1++) Grids[grid1]->GridData->DeleteGravitatingMassFieldParticles(); @@ -818,6 +868,15 @@ int EvolveLevel(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], Grids[grid1]->GridData->SetTimeStep(dtThisLevel[level]); } +#ifdef UNUSED + float tot = 0; + for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { + if (MyProcessorNumber == Grids[grid1]->GridData->ReturnProcessorNumber()) + tot += Grids[grid1]->GridData->ReturnCost(); + } + printf("P%d: total time in grid loop = %g\n", MyProcessorNumber, tot); +#endif + if (LevelArray[level+1] != NULL) { if (EvolveLevel(MetaData, LevelArray, level+1, dtThisLevel[level], Exterior #ifdef TRANSFER diff --git a/src/enzo/EvolvePhotons.C b/src/enzo/EvolvePhotons.C index 7e54575bb..4a8374d15 100644 --- a/src/enzo/EvolvePhotons.C +++ b/src/enzo/EvolvePhotons.C @@ -210,6 +210,12 @@ int EvolvePhotons(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], } // ENDFOR RS + /* Clear ray tracing timers */ + + for (lvl = 0; lvl < MAX_DEPTH_OF_HIERARCHY; lvl++) + for (i = 0; i < nGrids[lvl]; i++) + Grids[lvl][i]->GridData->ResetCost(2); + /********************************************************************** MAIN RADIATION TRANSPORT LOOP **********************************************************************/ @@ -289,8 +295,9 @@ int EvolvePhotons(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], START_PERF(); for (lvl = MAX_DEPTH_OF_HIERARCHY-1; lvl >= 0 ; lvl--) - for (Temp = LevelArray[lvl]; Temp; Temp = Temp->NextGridThisLevel) - if (Temp->GridData->InitializeRadiativeTransferFields() == FAIL) { +#pragma omp parallel for schedule(static) + for (i = 0; i < nGrids[lvl]; i++) + if (Grids[lvl][i]->GridData->InitializeRadiativeTransferFields() == FAIL) { ENZO_FAIL("Error in InitializeRadiativeTransferFields.\n"); } END_PERF(0); @@ -299,8 +306,9 @@ int EvolvePhotons(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], if (RadiationXRayComptonHeating) for (lvl = MAX_DEPTH_OF_HIERARCHY-1; lvl >= 0 ; lvl--) - for (Temp = LevelArray[lvl]; Temp; Temp = Temp->NextGridThisLevel) - if (Temp->GridData->InitializeTemperatureFieldForComptonHeating() == FAIL) { +#pragma omp parallel for schedule(static) + for (i = 0; i < nGrids[lvl]; i++) + if (Grids[lvl][i]->GridData->InitializeTemperatureFieldForComptonHeating() == FAIL) { ENZO_FAIL("Error in InitializeTemperatureFieldForComptonHeating.\n"); } /* Initialize Temperature Field for H2 shielding approximation */ @@ -595,9 +603,10 @@ int EvolvePhotons(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], // number of particles (rho * dx^3) START_PERF(); for (lvl = 0; lvl < MAX_DEPTH_OF_HIERARCHY-1; lvl++) - for (Temp = LevelArray[lvl]; Temp; Temp = Temp->NextGridThisLevel) - if (Temp->GridData->RadiationPresent() == TRUE) - Temp->GridData->FinalizeRadiationFields(); +#pragma omp parallel for schedule(static) + for (i = 0; i < nGrids[lvl]; i++) + if (Grids[lvl][i]->GridData->RadiationPresent() == TRUE) + Grids[lvl][i]->GridData->FinalizeRadiationFields(); END_PERF(8); /* Set the optically-thin H2 dissociation rates */ @@ -636,8 +645,9 @@ int EvolvePhotons(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], if (RadiationXRayComptonHeating) for (lvl = 0; lvl < MAX_DEPTH_OF_HIERARCHY-1; lvl++) - for (Temp = LevelArray[lvl]; Temp; Temp = Temp->NextGridThisLevel) - if (Temp->GridData->FinalizeTemperatureFieldForComptonHeating() == FAIL) { +#pragma omp parallel for schedule(static) + for (i = 0; i < nGrids[lvl]; i++) + if (Grids[lvl][i]->GridData->FinalizeTemperatureFieldForComptonHeating() == FAIL) { ENZO_FAIL("Error in FinalizeTemperatureFieldForComptonHeating.\n"); } if (RadiativeTransferH2ShieldType == 1 || ProblemType == 50) @@ -683,6 +693,21 @@ int EvolvePhotons(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], FirstTime = false; +#ifdef UNUSED//REPORT_PERF + if (!FirstTime) { + if (debug) printf("EvolvePhotons: total time = %g\n", ReturnWallTime()-ep0); + for (int i = 0; i < 1; i++) { // Only report on ROOT, not all + CommunicationBarrier(); + if (MyProcessorNumber == i) { + + printf("P%d:", MyProcessorNumber); + fpcol(PerfCounter, 14, 14, stdout); + fflush(stdout); + } + } + } +#endif + } // ENDWHILE GridTime >= PhotonTime /* Cleanup photon memory pool if we're deleting all photons between diff --git a/src/enzo/FindSubgrids.C b/src/enzo/FindSubgrids.C index 9e17e7eec..b76ca13d9 100644 --- a/src/enzo/FindSubgrids.C +++ b/src/enzo/FindSubgrids.C @@ -12,6 +12,7 @@ #include #include +#include #include "ErrorExceptions.h" #include "macros_and_parameters.h" #include "typedefs.h" @@ -29,11 +30,8 @@ int IdentifyNewSubgridsBySignature(ProtoSubgrid *SubgridList[], int &NumberOfSubgrids); -static ProtoSubgrid *SubgridList[MAX_NUMBER_OF_SUBGRIDS]; - - -int FindSubgrids(HierarchyEntry *Grid, int level, int &TotalFlaggedCells, - int &FlaggedGrids) +int FindSubgrids(HierarchyEntry *Grid, + int level, int &TotalFlaggedCells, int &FlaggedGrids) { /* declarations */ @@ -111,6 +109,7 @@ int FindSubgrids(HierarchyEntry *Grid, int level, int &TotalFlaggedCells, /* Create the base ProtoSubgrid which contains the whole grid. */ + std::vector SubgridList(MAX_NUMBER_OF_SUBGRIDS); int NumberOfSubgrids = 1; SubgridList[0] = new ProtoSubgrid; @@ -125,9 +124,7 @@ int FindSubgrids(HierarchyEntry *Grid, int level, int &TotalFlaggedCells, /* Recursively break up this ProtoSubgrid and add new ones based on the flagged cells. */ - if (IdentifyNewSubgridsBySignature(SubgridList, NumberOfSubgrids) == FAIL){ - ENZO_FAIL("Error in IdentifyNewSubgridsBySignature."); - } + IdentifyNewSubgridsBySignature(SubgridList.data(), NumberOfSubgrids); /* For each subgrid, create a new grid based on the current grid (i.e. same parameters, etc.) */ diff --git a/src/enzo/GEMINI.md b/src/enzo/GEMINI.md new file mode 100644 index 000000000..96e4b481f --- /dev/null +++ b/src/enzo/GEMINI.md @@ -0,0 +1,29 @@ +# Project Context: Enzo OpenMP GPU Offloading & Asynchronous RT + +## Overview +This project extends Enzo's GPU compute capabilities using OpenMP target offloading and optimizes the Moray ray tracer. Key objectives include porting C++ hydro solvers to GPUs and restructuring the ray tracer for many-core efficiency and communication overlap. + +## Key Source Files +- `src/`: Core solvers. +- `src/Grid_TransportPhotonPackages.C`: Primary ray propagation logic (SoA Target). +- `src/EvolvePhotons.C`: High-level RT coordination and MPI logic. +- `src/Grid_SolvePPM_DE.C`: Reference for stencil parallelization. + +## Architecture Guidelines +- **Structure of Arrays (SoA):** Convert the photon package linked list into a flat SoA to enable coalesced memory access and SIMT parallelization [1, 2]. +- **Communication-Computation Overlap:** Utilize an asynchronous, six-step MPI handshake to hide latency when rays cross AMR grid boundaries [3, 4]. +- **Data Minimization:** Keep fields (Density, Energy, etc.) on-device during the RT step. Accumulate photo-ionization ($k_{ph}$) and heating ($\Gamma_{ph}$) rates in device-side buffers [5, 6]. + +## Development Rules +1. **SoA Layout:** Maintain the 11 essential fields: Flux, Type, Energy, Column Density, Pixel Num, Level (Single/Int) and TimeInterval, EmissionTime, CurrentTime, Radius, SourcePosition (Double/Precision-dependent) [7]. +2. **Pre-allocation:** Account for ray splitting (1 ray to 4 child rays) by pre-allocating device buffers with sufficient capacity to avoid mid-step reallocations [8, 9]. +3. **MPI Handshake:** + - Ranks must first exchange `Nmesg` (count of expected data packets) via non-blocking `MPI_Isend`/`MPI_Irecv` [4, 10]. + - Aggressively drain the message stack before checking data status [10]. +4. **Asynchronous Loop:** Use `MPI_Testsome` while local rays are available for tracing; fall back to `MPI_Waitsome` only when local work is exhausted [11]. +5. **Termination:** Ensure global termination checks include both empty local queues and zero outstanding MPI requests to prevent race conditions [12]. + +## Primary Targets +1. **PPM/ZEUS Offloading:** Port 1D sweep loops and staggered mesh updates to OpenMP target regions. +2. **Ray Tracer SoA:** Replace the `PhotonPackage` linked list in `Grid_TransportPhotonPackages.C` with the SoA model for GPU offloading. +3. **Non-blocking MPI:** Implement the 6-step asynchronous communication protocol in `EvolvePhotons.C` to eliminate blocking boundary synchronization. \ No newline at end of file diff --git a/src/enzo/Grid.h b/src/enzo/Grid.h index 0356aa9d5..18dad7d4b 100644 --- a/src/enzo/Grid.h +++ b/src/enzo/Grid.h @@ -218,6 +218,14 @@ class grid float **freefall_density; float **freefall_pressure; +// +// Performance counters for load balancing +// + float ParentCostPerCell[MAX_COMPUTE_TIMERS]; + float ParentEstimatedCostPerCell[MAX_COMPUTE_TIMERS]; + float ObservedCost[MAX_COMPUTE_TIMERS]; + float EstimatedCost[MAX_COMPUTE_TIMERS]; + // // Friends // @@ -1676,6 +1684,30 @@ int CreateParticleTypeGrouping(hid_t ptype_dset, return ProcessorNumber; } + /* Performance counter for load balancing */ + + void ResetCost(void) { + for (int i = 0; i < MAX_COMPUTE_TIMERS; i++) ObservedCost[i] = 0.0; }; + void ResetCost(int i) { ObservedCost[i] = 0.0; }; + float ReturnCost(int i) { return ObservedCost[i]; }; + float ReturnEstimatedCost(int i) { return EstimatedCost[i]; }; + void SetEstimatedCost(float a, int i) { EstimatedCost[i] = a; }; + void AddToCost(int i, double a) { + if (MyProcessorNumber == ProcessorNumber) + ObservedCost[i] += a; + }; + void SetParentCost(grid *Parent) { + if (MyProcessorNumber == ProcessorNumber) { + for (int i = 0; i < MAX_COMPUTE_TIMERS; i++) { + this->ParentCostPerCell[i] = Parent->ReturnCost(i) / Parent->GetGridSize(); + this->ParentEstimatedCostPerCell[i] = Parent->ReturnEstimatedCost(i) / + Parent->GetGridSize(); + this->ObservedCost[i] = this->ParentCostPerCell[i] * this->GetGridSize(); + this->EstimatedCost[i] = this->ParentEstimatedCostPerCell[i] * this->GetGridSize(); + } + } + }; + /* Send a region from a real grid to a 'fake' grid on another processor. */ int CommunicationSendRegion(grid *ToGrid, int ToProcessor, int SendField, @@ -1694,6 +1726,14 @@ int CreateParticleTypeGrouping(hid_t ptype_dset, int DeleteAllFields = TRUE, int MoveSubgridMarker = FALSE); +/* Move only the fields from the grids */ + + int CommunicationMoveGrid1(int ToProcessor); + +/* Move the stars, particles, and photons from the grids */ + + int CommunicationMoveGrid2(int ToProcessor, int MoveParticles = TRUE); + /* Send particles from one grid to another. */ int CommunicationSendParticles(grid *ToGrid, int ToProcessor, @@ -1735,6 +1775,14 @@ int CommunicationTransferActiveParticles(grid* Grids[], int NumberOfGrids, int AllLocal); int MoveSubgridActiveParticles(int NumberOfSubgrids, grid* ToGrids[], int AllLocal); + int TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, + int* &NumberToMove, int &ParticleCounter, int StartIndex, + int EndIndex, particle_data* &List, + bool KeepLocal, bool ParticlesAreLocal, + int CopyDirection, + int IncludeGhostZones = FALSE, + int CountOnly = FALSE); + int TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, int* &NumberToMove, int StartIndex, int EndIndex, particle_data* &List, @@ -1744,7 +1792,7 @@ int CommunicationTransferActiveParticles(grid* Grids[], int NumberOfGrids, int CountOnly = FALSE); int TransferSubgridStars(grid* Subgrids[], int NumberOfSubgrids, - int* &NumberToMove, int StartIndex, + int* &NumberToMove, int &Counter, int EndIndex, star_data* &List, bool KeepLocal, bool ParticlesAreLocal, int CopyDirection, @@ -1752,7 +1800,7 @@ int CommunicationTransferActiveParticles(grid* Grids[], int NumberOfGrids, int CountOnly = FALSE); int TransferSubgridActiveParticles(grid* Subgrids[], int NumberOfSubgrids, - int* &NumberToMove, int StartIndex, + int* &NumberToMove, int &Counter, int EndIndex, ActiveParticleList &List, bool KeepLocal, bool ParticlesAreLocal, int CopyDirection, @@ -1886,6 +1934,15 @@ int zEulerSweep(int j, int NumberOfSubgrids, fluxes *SubgridFluxes[], Elong_int GridGlobalStart[], float *CellWidthTemp[], int GravityOn, int NumberOfColours, int colnum[], float *pressure); +int inteuler(int idim, + float *dslice, float *pslice, int gravity, float *grslice, + float *geslice, float *uslice, float *vslice, float *wslice, + float *dxi, float *flatten, + float *dls, float *drs, float *pls, float *prs, float *gels, + float *gers, float *uls, float *urs, float *vls, float *vrs, + float *wls, float *wrs, int ncolors, float *colslice, + float *colls, float *colrs); + // AccelerationHack int AccelerationHack; diff --git a/src/enzo/Grid_AddOpticallyThinXrays.C b/src/enzo/Grid_AddOpticallyThinXrays.C new file mode 100644 index 000000000..572a03043 --- /dev/null +++ b/src/enzo/Grid_AddOpticallyThinXrays.C @@ -0,0 +1,46 @@ +/*********************************************************************** +/ +/ (WRAPPER) ADD X-RAY EMISSION FROM RADIATIVE PARTICLES +/ +/ written by: John Wise +/ date: March, 2012 +/ modified1: +/ +/ PURPOSE: +/ +************************************************************************/ +#include +#include +#include +#include "ErrorExceptions.h" +#include "macros_and_parameters.h" +#include "typedefs.h" +#include "global_data.h" +#include "Fluxes.h" +#include "GridList.h" +#include "ExternalBoundary.h" +#include "Grid.h" +#include "Hierarchy.h" +#include "CosmologyParameters.h" +#include "Star.h" + +int grid::AddOpticallyThinXrays(Star *AllStars, int NumberOfSources) +{ + + /* If we're merging rays, we already have a binary tree of the + sources. We can use that to speed up the calculation when we + have more than 10 sources. With smaller numbers, the overhead + makes the direct calculation faster. */ + +#ifdef UNUSED // Difficult with multiple X-ray energy bins + if (RadiativeTransferSourceClustering == TRUE && NumberOfSources >= 10) + this->AddXraysFromTree(); + else +#endif + this->AddXraysFromSources(AllStars); + + HasRadiation = TRUE; + + return SUCCESS; + +} diff --git a/src/enzo/Grid_AddXraysFromSources.C b/src/enzo/Grid_AddXraysFromSources.C new file mode 100644 index 000000000..b45f0b7d7 --- /dev/null +++ b/src/enzo/Grid_AddXraysFromSources.C @@ -0,0 +1,282 @@ +/*********************************************************************** +/ +/ ADD X-RAYS EMISSION FROM SHINING PARTICLES +/ +/ written by: John Wise +/ date: April, 2012 +/ modified1: +/ +/ PURPOSE: +/ +************************************************************************/ +#include +#include +#include +#include "ErrorExceptions.h" +#include "macros_and_parameters.h" +#include "typedefs.h" +#include "global_data.h" +#include "Fluxes.h" +#include "GridList.h" +#include "ExternalBoundary.h" +#include "Grid.h" +#include "Hierarchy.h" +#include "CosmologyParameters.h" +#include "Star.h" + +int GetUnits(float *DensityUnits, float *LengthUnits, + float *TemperatureUnits, float *TimeUnits, + float *VelocityUnits, FLOAT Time); +FLOAT FindCrossSection(int type, float energy); + +int grid::AddXraysFromSources(Star *AllStars) +{ + + const float EnergyThresholds[] = {13.6, 24.6, 54.4}; + const float PopulationFractions[] = {1.0, 0.25, 0.25}; + const float erg_eV = 1.602176e-12; + const double clight = 2.99792e10; + const double pc = 3.086e18; + + Star *cstar; + FLOAT DomainWidth[MAX_DIMENSION]; + FLOAT *ddr2[MAX_DIMENSION]; + double Luminosity[MAX_ENERGY_BINS]; + float energies[MAX_ENERGY_BINS], kph_r2, gamma_r2, dkph, dE; + int ipart, dim, a, i, j, k, bin, index, indixe, nbins; + int ActiveDims[MAX_DIMENSION]; + int DeNum, HINum, HIINum, HeINum, HeIINum, HeIIINum, HMNum, H2INum, H2IINum, + DINum, DIINum, HDINum; + double XrayLuminosity, LConv, CrossSectionConv; + + if (MyProcessorNumber != ProcessorNumber) + return SUCCESS; + + /* Exit if no star particles and not Photon Test */ + + if (AllStars == NULL && ProblemType != 50) + return SUCCESS; + + /* Find Multi-species fields. */ + + if (this->IdentifySpeciesFields(DeNum, HINum, HIINum, HeINum, HeIINum, + HeIIINum, HMNum, H2INum, H2IINum, DINum, + DIINum, HDINum) == FAIL) { + ENZO_FAIL("Error in grid->IdentifySpeciesFields.\n"); + } + + /* Get photo-ionization fields */ + + int kphHINum, kphHeINum, kphHeIINum, kdissH2INum, kphHMNum, kdissH2IINum; + int gammaNum; + IdentifyRadiativeTransferFields(kphHINum, gammaNum, kphHeINum, kphHeIINum, + kdissH2INum, kphHMNum, kdissH2IINum); + const int kphNum[] = {kphHINum, kphHeINum, kphHeIINum}; + + /* If using cosmology, get units. */ + + float TemperatureUnits, DensityUnits, LengthUnits, VelocityUnits, + TimeUnits, aUnits = 1; + + GetUnits(&DensityUnits, &LengthUnits, &TemperatureUnits, + &TimeUnits, &VelocityUnits, PhotonTime); + + // Absorb the unit conversions into the cross-section + CrossSectionConv = (double)TimeUnits / ((double)LengthUnits * (double)LengthUnits); + + // Convert from #/s to RT units + LConv = (double) TimeUnits / pow(LengthUnits,3); + + for (dim = 0; dim < GridRank; dim++) { + DomainWidth[dim] = DomainRightEdge[dim] - DomainLeftEdge[dim]; + ActiveDims[dim] = GridEndIndex[dim] - GridStartIndex[dim] + 1; + ddr2[dim] = new FLOAT[ActiveDims[dim]]; + } + + /* Loop over radiation sources or star particles in the grid */ + + FLOAT CrossSections[3]; // HI, HeI, HeII + float xx, heat_factor, ion2_factor[3]; + float nSecondaryHII = 1, nSecondaryHeII = 1; + double r2_inv; + + ion2_factor[2] = 1.0; + if (RadiationXRaySecondaryIon == FALSE) { + heat_factor = 1.0; + ion2_factor[0] = ion2_factor[1] = 1.0; + } + + if (ProblemType == 50) { + + RadiationSourceEntry *RS; + for (RS = GlobalRadiationSources->NextSource; RS; RS = RS->NextSource) { + + if (PhotonTime < RS->CreationTime && + PhotonTime > RS->CreationTime + RS->LifeTime) + continue; + + /* Loop over energy bins and consider X-rays to be E >= 100 eV */ + + for (bin = 0; bin < RS->EnergyBins; bin++) { + + if (RS->Energy[bin] < 100) continue; + + XrayLuminosity = RS->SED[bin] * RS->Luminosity / LConv; + for (i = 0; i < 3; i++) + CrossSections[i] = FindCrossSection(i, RS->Energy[bin]) * CrossSectionConv; + + if (RadiationXRaySecondaryIon == TRUE) { + nSecondaryHII = RS->Energy[bin] / 13.6; + nSecondaryHeII = RS->Energy[bin] / 24.6; + } + + /* Pre-calculate distances from cells to source */ + + for (dim = 0; dim < GridRank; dim++) + for (i = 0, index = GridStartIndex[dim]; i < ActiveDims[dim]; + i++, index++) { + + // Calculate dr_i first, then square it + ddr2[dim][i] = + fabs(CellLeftEdge[dim][index] + 0.5*CellWidth[dim][index] - + RS->Position[dim]); + ddr2[dim][i] = min(ddr2[dim][i], DomainWidth[dim]-ddr2[dim][i]); + ddr2[dim][i] = ddr2[dim][i] * ddr2[dim][i]; + } + + /* Loop over absorbers then cells */ + + double radius2_yz; + + for (k = 0; k < ActiveDims[2]; k++) { + for (j = 0; j < ActiveDims[1]; j++) { + radius2_yz = ddr2[1][j] + ddr2[2][k]; + index = GRIDINDEX(0, j, k); + for (i = 0; i < ActiveDims[0]; i++, index++) { + r2_inv = 1.0 / (radius2_yz + ddr2[0][i]); + if (RadiationXRaySecondaryIon == TRUE) { + xx = max(BaryonField[HIINum][index] / + (BaryonField[HINum][index] + BaryonField[HIINum][index]), + 1e-4); + heat_factor = 0.9971 * (1.0 - powf(1.0 - powf(xx, 0.2663f), 1.3163)); + ion2_factor[0] = 0.3908 * nSecondaryHII * + powf(1 - powf(xx, 0.4092f), 1.7592f); + ion2_factor[1] = 0.0554 * nSecondaryHeII * + powf(1 - powf(xx, 0.4614f), 1.6660f); + } + for (a = 0; a < 3; a++) { + dkph = (float) (XrayLuminosity * CrossSections[a] / (4.0 * M_PI)) * r2_inv; + dE = (RS->Energy[bin] - EnergyThresholds[a]); + BaryonField[kphNum[a]][index] += dkph * ion2_factor[a]; + BaryonField[gammaNum][index] += dkph * dE * heat_factor; + } // END: absorbers (a) + } // END: i-direction + } // END: j-direction + } // END: k-direction + + } // ENDFOR bin + + } // ENDFOR sources + + } // ENDIF ProblemType == 50 + + else { + + for (cstar = AllStars; cstar; cstar = cstar->NextStar) { + + // Skip if not 'living' + if (!(cstar->FeedbackFlag == NO_FEEDBACK || + cstar->FeedbackFlag == CONT_SUPERNOVA)) + continue; + + /* Get energy bins and SED */ + + if (cstar->ComputePhotonRates(TimeUnits, nbins, energies, Luminosity) == FAIL) { + ENZO_FAIL("Error in ComputePhotonRates.\n"); + } + + /* Pre-calculate distances from cells to source */ + + for (dim = 0; dim < GridRank; dim++) + for (i = 0, index = GridStartIndex[dim]; i < ActiveDims[dim]; + i++, index++) { + + // Calculate dr_i first, then square it + ddr2[dim][i] = + fabs(CellLeftEdge[dim][index] + 0.5*CellWidth[dim][index] - + cstar->pos[dim]); + ddr2[dim][i] = min(ddr2[dim][i], DomainWidth[dim]-ddr2[dim][i]); + ddr2[dim][i] = ddr2[dim][i] * ddr2[dim][i]; + } + + /* Loop over energy bins and consider X-rays to be E >= 100 eV */ + + for (bin = 0; bin < nbins; bin++) { + + if (energies[bin] < 100) continue; + + XrayLuminosity = Luminosity[bin] / LConv; + for (i = 0; i < 3; i++) + CrossSections[i] = FindCrossSection(i, energies[bin]) * CrossSectionConv; + + if (RadiationXRaySecondaryIon == TRUE) { + nSecondaryHII = energies[bin] / 13.6; + nSecondaryHeII = energies[bin] / 24.6; + } + + /* Pre-calculate distances from cells to source */ + + for (dim = 0; dim < GridRank; dim++) + for (i = 0, index = GridStartIndex[dim]; i < ActiveDims[dim]; + i++, index++) { + + // Calculate dr_i first, then square it + ddr2[dim][i] = + fabs(CellLeftEdge[dim][index] + 0.5*CellWidth[dim][index] - + cstar->pos[dim]); + ddr2[dim][i] = min(ddr2[dim][i], DomainWidth[dim]-ddr2[dim][i]); + ddr2[dim][i] = ddr2[dim][i] * ddr2[dim][i]; + } + + /* Loop over absorbers then cells */ + + double radius2_yz; + + for (k = 0; k < ActiveDims[2]; k++) { + for (j = 0; j < ActiveDims[1]; j++) { + radius2_yz = ddr2[1][j] + ddr2[2][k]; + index = GRIDINDEX(0, j, k); + for (i = 0; i < ActiveDims[0]; i++, index++) { + r2_inv = 1.0 / (radius2_yz + ddr2[0][i]); + if (RadiationXRaySecondaryIon == TRUE) { + xx = max(BaryonField[HIINum][index] / + (BaryonField[HINum][index] + BaryonField[HIINum][index]), + 1e-4); + heat_factor = 0.9971 * (1.0 - powf(1.0 - powf(xx, 0.2663f), 1.3163)); + ion2_factor[0] = 0.3908 * nSecondaryHII * + powf(1 - powf(xx, 0.4092f), 1.7592f); + ion2_factor[1] = 0.0554 * nSecondaryHeII * + powf(1 - powf(xx, 0.4614f), 1.6660f); + } + for (a = 0; a < 3; a++) { + dkph = (float) (XrayLuminosity * CrossSections[a] / (4.0 * M_PI)) * r2_inv; + dE = (energies[bin] - EnergyThresholds[a]); + BaryonField[kphNum[a]][index] += dkph * ion2_factor[a]; + BaryonField[gammaNum][index] += dkph * dE * heat_factor; + } // END: absorbers (a) + } // END: i-direction + } // END: j-direction + } // END: k-direction + + } // ENDFOR bin + + } // ENDFOR stars + + } // ENDELSE ProblemType == 50 + + for (dim = 0; dim < GridRank; dim++) + delete [] ddr2[dim]; + + return SUCCESS; + +} diff --git a/src/enzo/Grid_AddXraysFromTree.C b/src/enzo/Grid_AddXraysFromTree.C new file mode 100644 index 000000000..b4a150d87 --- /dev/null +++ b/src/enzo/Grid_AddXraysFromTree.C @@ -0,0 +1,125 @@ +/*********************************************************************** +/ +/ ADD X-RAY EMISSION FROM STAR PARTICLES FROM A TREE +/ +/ written by: John Wise +/ date: April, 2012 +/ modified1: +/ +/ PURPOSE: +/ +************************************************************************/ +#include +#include +#include +#include "ErrorExceptions.h" +#include "macros_and_parameters.h" +#include "typedefs.h" +#include "global_data.h" +#include "Fluxes.h" +#include "GridList.h" +#include "ExternalBoundary.h" +#include "Grid.h" +#include "Hierarchy.h" +#include "CosmologyParameters.h" +#include "Star.h" + +#define MIN_OPENING_ANGLE 0.2 // 0.2 = arctan(11.3 deg) + +float CalculateLWFromTree(const FLOAT pos[], const float angle, + const SuperSourceEntry *Leaf, const float min_radius, + float result0); +int FindSuperSourceByPosition(FLOAT *pos, SuperSourceEntry **result, + int DEBUG); +int GetUnits(float *DensityUnits, float *LengthUnits, + float *TemperatureUnits, float *TimeUnits, + float *VelocityUnits, FLOAT Time); + +int grid::AddXraysFromTree(void) +{ + +#ifdef UNUSED + const double pc = 3.086e18, clight = 3e10; + + int i, j, k, index, dim, ci; + FLOAT pos[MAX_DIMENSION]; + FLOAT radius2; + FLOAT innerFront, outerFront, innerFront2, outerFront2; + double Luminosity[MAX_ENERGY_BINS]; + float energies[MAX_ENERGY_BINS], kdiss_r2; + double H2Luminosity, H2ISigma = 3.71e-18; + + if (MyProcessorNumber != ProcessorNumber) + return SUCCESS; + + /* Exit if there are no sources */ + + if (SourceClusteringTree == NULL) + return SUCCESS; + + this->DebugCheck((char*) "Grid_AddH2Dissociation"); + + /* Get photo-ionization fields */ + + int kphHINum, kphHeINum, kphHeIINum, kdissH2INum; + int gammaNum; + IdentifyRadiativeTransferFields(kphHINum, gammaNum, kphHeINum, kphHeIINum, + kdissH2INum); + + /* If using cosmology, get units. */ + + float TemperatureUnits, DensityUnits, LengthUnits, VelocityUnits, + TimeUnits, aUnits = 1; + + GetUnits(&DensityUnits, &LengthUnits, &TemperatureUnits, + &TimeUnits, &VelocityUnits, PhotonTime); + + // Absorb the unit conversions into the cross-section + H2ISigma *= (double)TimeUnits / ((double)LengthUnits * (double)LengthUnits); + + // Dilution factor (prevent breaking in the rate solver near the star) + float dilutionRadius = 10.0 * pc / (double) LengthUnits; + float dilRadius2 = dilutionRadius * dilutionRadius; + + // Convert from #/s to RT units + double LConv = (double) TimeUnits / pow(LengthUnits,3); + double LConv_inv = 1.0 / LConv; + + /* Find sources in the tree that contribute to the cells */ + + SuperSourceEntry *Leaf; + float factor = LConv_inv * H2ISigma / (4.0 * M_PI); + float angle; + + Leaf = SourceClusteringTree; + + // We want to use the source separation instead of the merging + // radius. The leaves store the merging radius (ClusteringRadius), + // so we multiply the angle by merge radius. + angle = MIN_OPENING_ANGLE * RadiativeTransferPhotonMergeRadius; + + for (k = GridStartIndex[2]; k <= GridEndIndex[2]; k++) { + pos[2] = CellLeftEdge[2][k] + 0.5*CellWidth[2][k]; + for (j = GridStartIndex[1]; j <= GridEndIndex[1]; j++) { + pos[1] = CellLeftEdge[1][j] + 0.5*CellWidth[1][j]; + index = GRIDINDEX_NOGHOST(GridStartIndex[0], j, k); + for (i = GridStartIndex[0]; i <= GridEndIndex[0]; i++, index++) { + pos[0] = CellLeftEdge[0][i] + 0.5*CellWidth[0][i]; + + /* Find the leaves that have an opening angle smaller than + the specified minimum and only include those in the + calculation */ + + H2Luminosity = CalculateLWFromTree(pos, angle, Leaf, dilRadius2, 0); + BaryonField[kdissH2INum][index] = H2Luminosity * factor; + + } // ENDFOR i + } // ENDFOR j + } // ENDFOR k +#else + ENZO_FAIL("Optically thin X-rays calculation not implemented with tree acceleration."); +#endif /* UNUSED */ + + return SUCCESS; + +} diff --git a/src/enzo/Grid_CheckForOverlap.C b/src/enzo/Grid_CheckForOverlap.C index 84607dd21..9906765d8 100644 --- a/src/enzo/Grid_CheckForOverlap.C +++ b/src/enzo/Grid_CheckForOverlap.C @@ -15,7 +15,9 @@ // This routine checks the other grid for any overlapping zones (including // periodic boundary conditions). If any are found, CopyZonesFromGrid // is called. - + +#include "preincludes.h" + #include #include #include "ErrorExceptions.h" @@ -39,6 +41,8 @@ int grid::CheckForOverlap(grid *OtherGrid, if (this->CommunicationMethodShouldExit(OtherGrid)) return SUCCESS; + + START_GRID_TIMER; int i, j, k, dim; FLOAT EdgeOffset[MAX_DIMENSION] = {0.0,0.0,0.0}; @@ -212,11 +216,7 @@ int grid::CheckForOverlap(grid *OtherGrid, } // end: loop of k + END_GRID_TIMER(0); return SUCCESS; } - - - - - diff --git a/src/enzo/Grid_CollectParticles.C b/src/enzo/Grid_CollectParticles.C index 3620b69f9..63d750839 100644 --- a/src/enzo/Grid_CollectParticles.C +++ b/src/enzo/Grid_CollectParticles.C @@ -55,9 +55,11 @@ int grid::CollectParticles(int GridNum, int* &NumberToMove, /* Move and delete particles */ - n1 = StartIndex; + //n1 = StartIndex; +#pragma omp parallel for schedule(static) private(n1,dim,j) for (i = 0; i < NumberOfParticles; i++) { + n1 = StartIndex + i; for (dim = 0; dim < GridRank; dim++) { List[n1].pos[dim] = ParticlePosition[dim][i]; List[n1].vel[dim] = ParticleVelocity[dim][i]; @@ -70,10 +72,10 @@ int grid::CollectParticles(int GridNum, int* &NumberToMove, List[n1].grid = GridNum; List[n1].proc = ProcessorNumber; //ParticleMass[i] = FLOAT_UNDEFINED; - n1++; + //n1++; } // ENDFOR particles - StartIndex = n1; + StartIndex += NumberOfParticles; this->DeleteParticles(); } // end: if (COPY_OUT) @@ -124,6 +126,9 @@ int grid::CollectParticles(int GridNum, int* &NumberToMove, int n; +#pragma omp parallel private(dim,j) + { +#pragma omp for schedule(static) for (i = 0; i < NumberOfParticles; i++) { Mass[i] = ParticleMass[i]; Number[i] = ParticleNumber[i]; @@ -131,41 +136,44 @@ int grid::CollectParticles(int GridNum, int* &NumberToMove, } for (dim = 0; dim < GridRank; dim++) +#pragma omp for schedule(static) for (i = 0; i < NumberOfParticles; i++) { Position[dim][i] = ParticlePosition[dim][i]; Velocity[dim][i] = ParticleVelocity[dim][i]; } for (j = 0; j < NumberOfParticleAttributes; j++) +#pragma omp for schedule(static) for (i = 0; i < NumberOfParticles; i++) Attribute[j][i] = ParticleAttribute[j][i]; /* Copy new particles */ - n = NumberOfParticles; +#pragma omp for schedule(static) private(n) for (i = StartIndex; i < EndIndex; i++) { + n = NumberOfParticles + i - StartIndex; Mass[n] = List[i].mass; Number[n] = List[i].id; Type[n] = List[i].type; - n++; } for (dim = 0; dim < GridRank; dim++) { - n = NumberOfParticles; +#pragma omp for schedule(static) private(n) for (i = StartIndex; i < EndIndex; i++) { + n = NumberOfParticles + i - StartIndex; Position[dim][n] = List[i].pos[dim]; Velocity[dim][n] = List[i].vel[dim]; - n++; } } for (j = 0; j < NumberOfParticleAttributes; j++) { - n = NumberOfParticles; +#pragma omp for schedule(static) private(n) for (i = StartIndex; i < EndIndex; i++) { + n = NumberOfParticles + i - StartIndex; Attribute[j][n] = List[i].attribute[j]; - n++; } } + } // ENDIF pragma omp parallel } // ENDIF TotalNumberOfParticles > 0 diff --git a/src/enzo/Grid_CommunicationMoveGrid1.C b/src/enzo/Grid_CommunicationMoveGrid1.C new file mode 100644 index 000000000..5bb49824c --- /dev/null +++ b/src/enzo/Grid_CommunicationMoveGrid1.C @@ -0,0 +1,84 @@ +/*********************************************************************** +/ +/ GRID CLASS (MOVE A GRID FROM ONE PROCESSOR TO ANOTHER) +/ +/ written by: Greg Bryan +/ date: December, 1997 +/ modified1: January, 2012 (John Wise) move fields and particles+ +/ separately +/ +/ PURPOSE: +/ +/ INPUTS: +/ +************************************************************************/ + +#ifdef USE_MPI +#include "mpi.h" +#endif + +#include +#include +#include +#include "ErrorExceptions.h" +#include "macros_and_parameters.h" +#include "typedefs.h" +#include "global_data.h" +#include "Fluxes.h" +#include "GridList.h" +#include "ExternalBoundary.h" +#include "Grid.h" +#include "communication.h" + +/* function prototypes */ + + + +int grid::CommunicationMoveGrid1(int ToProcessor) +{ + + int dim; + int Zero[] = {0, 0, 0}; + FLOAT FZero[] = {0.0, 0.0, 0.0}; + + //CommunicationDirection = COMMUNICATION_SEND_RECEIVE; + + if ((MyProcessorNumber == ProcessorNumber || + MyProcessorNumber == ToProcessor) && + ProcessorNumber != ToProcessor) { + + /* Copy baryons. */ + + if (NumberOfBaryonFields > 0) { +#ifdef USE_MPI + if (CommunicationDirection == COMMUNICATION_POST_RECEIVE) { + CommunicationReceiveGridOne[CommunicationReceiveIndex] = this; + CommunicationReceiveGridTwo[CommunicationReceiveIndex] = this; + CommunicationReceiveCallType[CommunicationReceiveIndex] = 16; + for (dim = 0; dim < MAX_DIMENSION; dim++) + CommunicationReceiveArgumentInt[dim][CommunicationReceiveIndex] = + GridDimension[dim]; + } +#endif + this->CommunicationSendRegion(this, ToProcessor, ALL_FIELDS, + NEW_ONLY, Zero, GridDimension); + } + + /* Delete fields on old grid. */ + + if (MyProcessorNumber == ProcessorNumber && ProcessorNumber != ToProcessor && + (CommunicationDirection == COMMUNICATION_SEND || + CommunicationDirection == COMMUNICATION_SEND_RECEIVE)) { + this->DeleteAllButParticles(); + } + + } // ENDIF right processor + + /* Update processor number. */ + +// if (CommunicationDirection == COMMUNICATION_SEND_RECEIVE) +// ProcessorNumber = ToProcessor; + + return SUCCESS; +} + diff --git a/src/enzo/Grid_CommunicationMoveGrid2.C b/src/enzo/Grid_CommunicationMoveGrid2.C new file mode 100644 index 000000000..0e1997411 --- /dev/null +++ b/src/enzo/Grid_CommunicationMoveGrid2.C @@ -0,0 +1,88 @@ +/*********************************************************************** +/ +/ GRID CLASS (MOVE A GRID FROM ONE PROCESSOR TO ANOTHER) +/ +/ written by: Greg Bryan +/ date: December, 1997 +/ modified1: January, 2012 (John Wise) move fields and particles+ +/ separately +/ +/ PURPOSE: +/ +/ INPUTS: +/ +************************************************************************/ + +#ifdef USE_MPI +#include "mpi.h" +#endif + +#include +#include +#include +#include "ErrorExceptions.h" +#include "macros_and_parameters.h" +#include "typedefs.h" +#include "global_data.h" +#include "Fluxes.h" +#include "GridList.h" +#include "ExternalBoundary.h" +#include "Grid.h" +#include "communication.h" + +/* function prototypes */ + + + +int grid::CommunicationMoveGrid2(int ToProcessor, int MoveParticles) +{ + + int dim; + int Zero[] = {0, 0, 0}; + FLOAT FZero[] = {0.0, 0.0, 0.0}; + + //CommunicationDirection = COMMUNICATION_SEND_RECEIVE; + + if ((MyProcessorNumber == ProcessorNumber || + MyProcessorNumber == ToProcessor) && + ProcessorNumber != ToProcessor) { + + /* Copy particles. */ + + if (NumberOfParticles > 0 && MoveParticles == TRUE) + this->CommunicationSendParticles(this, ToProcessor, 0, + NumberOfParticles, 0); + + /* Copy stars */ + + if (NumberOfStars > 0 && MoveParticles == TRUE) + this->CommunicationSendStars(this, ToProcessor); + + /* Copy photon packages */ + +#ifdef TRANSFER + PhotonPackageEntry *PP = PhotonPackages->NextPackage; + if (PP != NULL) + this->CommunicationSendPhotonPackages(this, ToProcessor, + NumberOfPhotonPackages, + NumberOfPhotonPackages, &PP); +#endif /* TRANSFER */ + + /* Delete fields on old grid. */ + + if (MyProcessorNumber == ProcessorNumber && ProcessorNumber != ToProcessor && + (CommunicationDirection == COMMUNICATION_SEND || + CommunicationDirection == COMMUNICATION_SEND_RECEIVE)) { + if (MoveParticles) this->DeleteParticles(); + } + + } // ENDIF right processor + + /* Update processor number. */ + + if (CommunicationDirection == COMMUNICATION_SEND_RECEIVE) + ProcessorNumber = ToProcessor; + + return SUCCESS; +} + diff --git a/src/enzo/Grid_CommunicationSendParticles.C b/src/enzo/Grid_CommunicationSendParticles.C index 4270181ab..8165c6dce 100644 --- a/src/enzo/Grid_CommunicationSendParticles.C +++ b/src/enzo/Grid_CommunicationSendParticles.C @@ -86,27 +86,19 @@ int grid::CommunicationSendParticles(grid *ToGrid, int ToProcessor, if (MyProcessorNumber == ProcessorNumber) { int FromEnd = FromStart + FromNumber; - - for (dim = 0; dim < GridRank; dim++) { - index = 0; - for (i = FromStart; i < FromEnd; i++, index++) { + #pragma omp parallel for schedule(static) private(index, dim, j) + for (i = FromStart; i < FromEnd; i++) { + index = i - FromStart; + for (dim = 0; dim < GridRank; dim++) { buffer[index].pos[dim] = ParticlePosition[dim][i]; buffer[index].vel[dim] = ParticleVelocity[dim][i]; } - } - - index = 0; - for (i = FromStart; i < FromEnd; i++, index++) { buffer[index].mass = ParticleMass[i]; buffer[index].id = ParticleNumber[i]; buffer[index].type = ParticleType[i]; - } // ENDFOR particles - - for (j = 0; j < NumberOfParticleAttributes; j++) { - index = 0; - for (i = FromStart; i < FromEnd; i++, index++) + for (j = 0; j < NumberOfParticleAttributes; j++) buffer[index].attribute[j] = ParticleAttribute[j][i]; - } + } // ENDFOR particles } // end: if (MyProcessorNumber) @@ -150,19 +142,29 @@ int grid::CommunicationSendParticles(grid *ToGrid, int ToProcessor, /* If adding to end, then copy and delete old fields. */ if (ToStart == -1) { + + #pragma omp parallel private(dim,j) + { + #pragma omp for schedule(static) for (i = 0; i < ToGrid->NumberOfParticles; i++) { ToGrid->ParticleNumber[i] = TempNumber[i]; ToGrid->ParticleMass[i] = TempMass[i]; ToGrid->ParticleType[i] = TempType[i]; } + for (dim = 0; dim < GridRank; dim++) + #pragma omp for schedule(static) for (i = 0; i < ToGrid->NumberOfParticles; i++) { ToGrid->ParticlePosition[dim][i] = TempPos[dim][i]; ToGrid->ParticleVelocity[dim][i] = TempVel[dim][i]; } + for (j = 0; j < NumberOfParticleAttributes; j++) + #pragma omp for schedule(static) for (i = 0; i < ToGrid->NumberOfParticles; i++) ToGrid->ParticleAttribute[j][i] = TempAttribute[j][i]; + + } // END parallel delete [] TempNumber; delete [] TempMass; @@ -257,27 +259,35 @@ int grid::CommunicationSendParticles(grid *ToGrid, int ToProcessor, CommunicationDirection == COMMUNICATION_RECEIVE)) { int ToEnd = ToStart + FromNumber; - - index = 0; - for (i = ToStart; i < ToEnd; i++, index++) { + +#pragma omp parallel private(dim,j) + { + +#pragma omp for schedule(static) private(index) + for (i = ToStart; i < ToEnd; i++) { + index = i-ToStart; ToGrid->ParticleMass[i] = buffer[index].mass; ToGrid->ParticleType[i] = buffer[index].type; ToGrid->ParticleNumber[i] = buffer[index].id; } for (dim = 0; dim < GridRank; dim++) { - index = 0; - for (i = ToStart; i < ToEnd; i++, index++) { +#pragma omp for schedule(static) private(index) + for (i = ToStart; i < ToEnd; i++) { + index = i-ToStart; ToGrid->ParticlePosition[dim][i] = buffer[index].pos[dim]; ToGrid->ParticleVelocity[dim][i] = buffer[index].vel[dim]; } } for (j = 0; j < NumberOfParticleAttributes; j++) { - index = 0; - for (i = ToStart; i < ToEnd; i++, index++) +#pragma omp for schedule(static) private(index) + for (i = ToStart; i < ToEnd; i++) { + index = i-ToStart; ToGrid->ParticleAttribute[j][i] = buffer[index].attribute[j]; + } } + } // END parallel /* Only delete the buffer if we're in receive mode (in send mode it will be deleted by CommunicationBufferedSend and if we're in diff --git a/src/enzo/Grid_CommunicationSendRegion.C b/src/enzo/Grid_CommunicationSendRegion.C index 563a3139e..6d103a8bc 100644 --- a/src/enzo/Grid_CommunicationSendRegion.C +++ b/src/enzo/Grid_CommunicationSendRegion.C @@ -64,7 +64,7 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, // MyProcessorNumber != ToProcessor) // return SUCCESS; - int index, field, dim, Zero[] = {0, 0, 0}; + int i, index, field, dim, Zero[] = {0, 0, 0}; // Compute size of region to transfer @@ -76,6 +76,10 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, int RegionSize = RegionDim[0]*RegionDim[1]*RegionDim[2]; int TransferSize = RegionSize * NumberOfFields; + + // add for the observed performance cost + if (SendField == ALL_FIELDS, NewOrOld == NEW_ONLY) + TransferSize += 2*MAX_COMPUTE_TIMERS; /* MHD Dimension stuff */ @@ -118,7 +122,7 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, index = 0; - if (NewOrOld == NEW_AND_OLD || NewOrOld == NEW_ONLY) + if (NewOrOld == NEW_AND_OLD || NewOrOld == NEW_ONLY) { for (field = 0; field < max(NumberOfBaryonFields, SendField+1); field++) if (field == SendField || SendField == ALL_FIELDS) { FORTRAN_NAME(copy3d)(BaryonField[field], &buffer[index], @@ -128,6 +132,15 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, RegionStart, RegionStart+1, RegionStart+2); index += RegionSize; } + + // Send the observed cost for load balancing + if (NewOrOld == NEW_ONLY && SendField == ALL_FIELDS) { + for (i = 0; i < MAX_COMPUTE_TIMERS; i++) { + buffer[index++] = this->ObservedCost[i]; + buffer[index++] = this->EstimatedCost[i]; + } + } + } if (NewOrOld == NEW_AND_OLD || NewOrOld == OLD_ONLY) for (field = 0; field < max(NumberOfBaryonFields, SendField+1); field++) @@ -298,10 +311,10 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, index = 0; - if (NewOrOld == NEW_AND_OLD || NewOrOld == NEW_ONLY) + if (NewOrOld == NEW_AND_OLD || NewOrOld == NEW_ONLY) { for (field = 0; field < max(NumberOfBaryonFields, SendField+1); field++) if (field == SendField || SendField == ALL_FIELDS) { - delete ToGrid->BaryonField[field]; + delete[] ToGrid->BaryonField[field]; ToGrid->BaryonField[field] = new float[RegionSize]; FORTRAN_NAME(copy3d)(&buffer[index], ToGrid->BaryonField[field], RegionDim, RegionDim+1, RegionDim+2, @@ -310,11 +323,19 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, Zero, Zero+1, Zero+2); index += RegionSize; } + + if (NewOrOld == NEW_ONLY && SendField == ALL_FIELDS) { + for (i = 0; i < MAX_COMPUTE_TIMERS; i++) { + this->ObservedCost[i] = buffer[index++]; + this->EstimatedCost[i] = buffer[index++]; + } + } + } if (NewOrOld == NEW_AND_OLD || NewOrOld == OLD_ONLY) for (field = 0; field < max(NumberOfBaryonFields, SendField+1); field++) if (field == SendField || SendField == ALL_FIELDS) { - delete ToGrid->OldBaryonField[field]; + delete[] ToGrid->OldBaryonField[field]; ToGrid->OldBaryonField[field] = new float[RegionSize]; FORTRAN_NAME(copy3d)(&buffer[index], ToGrid->OldBaryonField[field], RegionDim, RegionDim+1, RegionDim+2, @@ -365,7 +386,7 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, } // if( UseMHDCT && SendField == ALL_FIELDS ) if (SendField == GRAVITATING_MASS_FIELD_PARTICLES) { - delete ToGrid->GravitatingMassFieldParticles; + delete[] ToGrid->GravitatingMassFieldParticles; ToGrid->GravitatingMassFieldParticles = new float[RegionSize]; FORTRAN_NAME(copy3d)(buffer, ToGrid->GravitatingMassFieldParticles, RegionDim, RegionDim+1, RegionDim+2, @@ -375,7 +396,7 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, } if (SendField == GRAVITATING_MASS_FIELD) { - delete ToGrid->GravitatingMassField; + delete[] ToGrid->GravitatingMassField; ToGrid->GravitatingMassField = new float[RegionSize]; FORTRAN_NAME(copy3d)(buffer, ToGrid->GravitatingMassField, RegionDim, RegionDim+1, RegionDim+2, @@ -385,7 +406,7 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, } if (SendField == POTENTIAL_FIELD) { - delete ToGrid->PotentialField; + delete[] ToGrid->PotentialField; ToGrid->PotentialField = new float[RegionSize]; FORTRAN_NAME(copy3d)(buffer, ToGrid->PotentialField, RegionDim, RegionDim+1, RegionDim+2, @@ -396,7 +417,7 @@ int grid::CommunicationSendRegion(grid *ToGrid, int ToProcessor,int SendField, if (SendField == ACCELERATION_FIELDS) for (dim = 0; dim < GridRank; dim++) { - delete ToGrid->AccelerationField[dim]; + delete[] ToGrid->AccelerationField[dim]; ToGrid->AccelerationField[dim] = new float[RegionSize]; FORTRAN_NAME(copy3d)(&buffer[index], ToGrid->AccelerationField[dim], RegionDim, RegionDim+1, RegionDim+2, diff --git a/src/enzo/Grid_ComputeDomainBoundaryMassFlux.C b/src/enzo/Grid_ComputeDomainBoundaryMassFlux.C index 60fa348a5..1e678b818 100644 --- a/src/enzo/Grid_ComputeDomainBoundaryMassFlux.C +++ b/src/enzo/Grid_ComputeDomainBoundaryMassFlux.C @@ -18,7 +18,6 @@ #include #include #include "ErrorExceptions.h" -#include "phys_constants.h" #include "macros_and_parameters.h" #include "typedefs.h" #include "global_data.h" @@ -26,6 +25,7 @@ #include "GridList.h" #include "ExternalBoundary.h" #include "Grid.h" +#include "phys_constants.h" int GetUnits(float *DensityUnits, float *LengthUnits, float *TemperatureUnits, float *TimeUnits, diff --git a/src/enzo/Grid_ConvertToNumpy.C b/src/enzo/Grid_ConvertToNumpy.C index 0c639b0e2..3108f50b9 100644 --- a/src/enzo/Grid_ConvertToNumpy.C +++ b/src/enzo/Grid_ConvertToNumpy.C @@ -111,7 +111,7 @@ void grid::ConvertToNumpy(int GridID, PyArrayObject *container[], int ParentID, } dataset = (PyArrayObject *) PyArray_SimpleNewFromData( 3, dims, ENPY_BFLOAT, YT_TemperatureField); - PyArray_ENABLEFLAGS(dataset, NPY_OWNDATA); + dataset->flags |= NPY_OWNDATA; PyDict_SetItemString(grid_data, "Temperature", (PyObject*) dataset); Py_DECREF(dataset); diff --git a/src/enzo/Grid_CopyZonesFromGrid.C b/src/enzo/Grid_CopyZonesFromGrid.C index e0b92e2c8..a019d6ba6 100644 --- a/src/enzo/Grid_CopyZonesFromGrid.C +++ b/src/enzo/Grid_CopyZonesFromGrid.C @@ -285,8 +285,6 @@ int grid::CopyZonesFromGrid(grid *OtherGrid, FLOAT EdgeOffset[MAX_DIMENSION]) /* Copy zones */ - - int addDim[3] = {1, OtherDim[0], OtherDim[0]*OtherDim[1]}; int velocityTypes[3]={Velocity1, Velocity2, Velocity3}; diff --git a/src/enzo/Grid_DepositBaryons.C b/src/enzo/Grid_DepositBaryons.C index 114921571..60daa6e6d 100644 --- a/src/enzo/Grid_DepositBaryons.C +++ b/src/enzo/Grid_DepositBaryons.C @@ -39,7 +39,7 @@ int CommunicationBufferedSend(void *buffer, int size, MPI_Datatype Type, int Tar #endif /* USE_MPI */ extern "C" void FORTRAN_NAME(dep_grid_cic)( - float *source, float *dest, float *temp, + float *source, float *dest, float *velx, float *vely, float *velz, float *dt, float *rfield, int *ndim, hydro_method *ihydro, @@ -208,7 +208,7 @@ int grid::DepositBaryons(grid *TargetGrid, FLOAT DepositTime) /* Allocate a density and velocity mesh for this grid. */ float *vel_field = new float[size*4]; - + /* Generate the density field advanced by dt using smoothed velocity field. */ @@ -264,7 +264,7 @@ int grid::DepositBaryons(grid *TargetGrid, FLOAT DepositTime) // printf("DepositBaryons, %i\n", RK2SecondStepBaryonDeposit); if (DepositGridCIC == TRUE) - FORTRAN_NAME(dep_grid_cic)(input_density, dens_field, vel_field, + FORTRAN_NAME(dep_grid_cic)(input_density, dens_field, input_velx, input_vely, input_velz, &dt, BaryonField[NumberOfBaryonFields], &GridRank, @@ -277,7 +277,8 @@ int grid::DepositBaryons(grid *TargetGrid, FLOAT DepositTime) RegionDim, RegionDim+1, RegionDim+2, Refinement, Refinement+1, Refinement+2); else - FORTRAN_NAME(dep_grid_ngp)(input_density, dens_field, vel_field, + FORTRAN_NAME(dep_grid_ngp)(input_density, dens_field, + vel_field, input_velx, input_vely, input_velz, &dt, BaryonField[NumberOfBaryonFields], &GridRank, @@ -375,7 +376,9 @@ int grid::DepositBaryons(grid *TargetGrid, FLOAT DepositTime) /* Add dens_field to GravitatingMassField in target grid. */ index = 0; - for (k = 0; k < RegionDim[2]; k++) +//#pragma omp parallel for schedule(static) private(j,gmindex,i,index) + for (k = 0; k < RegionDim[2]; k++) { + index = k*RegionDim[1]*RegionDim[0]; for (j = 0; j < RegionDim[1]; j++) { gmindex = (j+GridOffset[1] + (k+GridOffset[2])*TargetGrid->GravitatingMassFieldDimension[1])* @@ -383,6 +386,7 @@ int grid::DepositBaryons(grid *TargetGrid, FLOAT DepositTime) for (i = 0; i < RegionDim[0]; i++, gmindex++, index++) TargetGrid->GravitatingMassField[gmindex] += dens_field[index]; } + } /* Clean up */ diff --git a/src/enzo/Grid_GrackleWrapper.C b/src/enzo/Grid_GrackleWrapper.C index d65998264..20dcbe368 100644 --- a/src/enzo/Grid_GrackleWrapper.C +++ b/src/enzo/Grid_GrackleWrapper.C @@ -171,6 +171,10 @@ int grid::GrackleWrapper() */ if (MetalPointer != NULL) { for (i = 0; i < size; i++) { + if (MetalPointer[i] > BaryonField[DensNum][i]) { + ENZO_VFAIL("Metal density (%e) exceeds total density (%e) at cell %d!\n", + MetalPointer[i], BaryonField[DensNum][i], i); + } MetalPointer[i] = min(MetalPointer[i], 0.9 * BaryonField[DensNum][i]); } } @@ -287,6 +291,14 @@ int grid::GrackleWrapper() return FAIL; } + /* Check for NaN in fields returned by Grackle */ + for (i = 0; i < size; i++) { + if (BaryonField[DensNum][i] != BaryonField[DensNum][i] || + thermal_energy[i] != thermal_energy[i]) { + ENZO_FAIL("NaN detected in baryon fields (density or energy) after Grackle solve_chemistry!"); + } + } + if (HydroMethod != Zeus_Hydro) { for (i = 0; i < size; i++) { BaryonField[TENum][i] = thermal_energy[i] + diff --git a/src/enzo/Grid_InterpolateBoundaryFromParent.C b/src/enzo/Grid_InterpolateBoundaryFromParent.C index 88245cdae..48be93121 100644 --- a/src/enzo/Grid_InterpolateBoundaryFromParent.C +++ b/src/enzo/Grid_InterpolateBoundaryFromParent.C @@ -129,7 +129,7 @@ int grid::InterpolateBoundaryFromParent(grid *ParentGrid) int SecondOrderBFlag[MAX_NUMBER_OF_BARYON_FIELDS]; - for (int i=0; i ParentGrid->GridDimension[dim]) { - ENZO_VFAIL("Parent grid not big enough for interpolation! ParentStartIndex[%"ISYM"] = %"ISYM" ParentTempDim = %"ISYM"\n", dim, ParentStartIndex[dim], ParentTempDim[dim]) + ENZO_VFAIL("Parent grid not big enough for interpolation! ParentStartIndex[%"ISYM"] = %"ISYM" ParentTempDim = %"ISYM"\n" "GridDimension[%"ISYM"] = %"ISYM"", dim, ParentStartIndex[dim], ParentTempDim[dim], dim, ParentGrid->GridDimension[dim]) } /* Compute the dimensions of the current grid temporary field. */ diff --git a/src/enzo/Grid_MergePausedPhotonPackages.C b/src/enzo/Grid_MergePausedPhotonPackages.C index f40c6a951..a5d64fd95 100644 --- a/src/enzo/Grid_MergePausedPhotonPackages.C +++ b/src/enzo/Grid_MergePausedPhotonPackages.C @@ -221,8 +221,8 @@ int grid::MergePausedPhotonPackages() { delete [] TempPP; if (DEBUG) - printf("P%d: MergePausedPhotonPackages: %"ISYM" => %"ISYM" photons\n", - MyProcessorNumber, nphotons, merges); + printf("P%d: MergePausedPhotonPackages (Grid %d): %"ISYM" => %"ISYM" photons\n", + MyProcessorNumber, this->ID, nphotons, merges); return merges; } diff --git a/src/enzo/Grid_MoveAllParticles.C b/src/enzo/Grid_MoveAllParticles.C index ce2100c51..1c7742a1c 100644 --- a/src/enzo/Grid_MoveAllParticles.C +++ b/src/enzo/Grid_MoveAllParticles.C @@ -95,20 +95,27 @@ int grid::MoveAllParticles(int NumberOfGrids, grid* FromGrid[]) MassDecrease = 1.0/MassDecrease; /* Copy this grid's particles to the new space. */ + +#pragma omp parallel private(dim,j) + { +#pragma omp for schedule(static) for (i = 0; i < NumberOfParticles; i++) { Mass[i] = ParticleMass[i]; Number[i] = ParticleNumber[i]; Type[i] = ParticleType[i]; } for (dim = 0; dim < GridRank; dim++) +#pragma omp for schedule(static) for (i = 0; i < NumberOfParticles; i++) { Position[dim][i] = ParticlePosition[dim][i]; Velocity[dim][i] = ParticleVelocity[dim][i]; } for (j = 0; j < NumberOfParticleAttributes; j++) +#pragma omp for schedule(static) for (i = 0; i < NumberOfParticles; i++) Attribute[j][i] = ParticleAttribute[j][i]; + } // END omp parallel /* Delete this grid's particles (now copied). */ @@ -124,6 +131,9 @@ int grid::MoveAllParticles(int NumberOfGrids, grid* FromGrid[]) int Index = NumberOfParticles; for (grid = 0; grid < NumberOfGrids; grid++) { +#pragma omp parallel private(dim,j) + { +#pragma omp for schedule(static) for (i = 0; i < FromGrid[grid]->NumberOfParticles; i++) { Mass[Index+i] = FromGrid[grid]->ParticleMass[i] * MassDecrease; Number[Index+i] = FromGrid[grid]->ParticleNumber[i]; @@ -131,14 +141,17 @@ int grid::MoveAllParticles(int NumberOfGrids, grid* FromGrid[]) } for (dim = 0; dim < GridRank; dim++) +#pragma omp for schedule(static) for (i = 0; i < FromGrid[grid]->NumberOfParticles; i++) { Position[dim][Index+i] = FromGrid[grid]->ParticlePosition[dim][i]; Velocity[dim][Index+i] = FromGrid[grid]->ParticleVelocity[dim][i]; } for (j = 0; j < NumberOfParticleAttributes; j++) +#pragma omp for schedule(static) for (i = 0; i < FromGrid[grid]->NumberOfParticles; i++) Attribute[j][Index+i] = FromGrid[grid]->ParticleAttribute[j][i]; + } // END omp parallel Index += FromGrid[grid]->NumberOfParticles; @@ -149,7 +162,8 @@ int grid::MoveAllParticles(int NumberOfGrids, grid* FromGrid[]) NumberOfParticles = TotalNumberOfParticles; /* Delete FromGrid's particles (and set number of particles to zero). */ - + +#pragma omp parallel for schedule(static) for (grid = 0; grid < NumberOfGrids; grid++) { FromGrid[grid]->NumberOfParticles = 0; FromGrid[grid]->DeleteParticles(); diff --git a/src/enzo/Grid_SetSubgridMarkerIsolatedBoundaries.C b/src/enzo/Grid_SetSubgridMarkerIsolatedBoundaries.C new file mode 100644 index 000000000..f0de69983 --- /dev/null +++ b/src/enzo/Grid_SetSubgridMarkerIsolatedBoundaries.C @@ -0,0 +1,117 @@ +/*********************************************************************** +/ +/ GRID CLASS (MARK SUBGRID FOR ISOLATED BOUNDARIES) +/ +/ written by: John Wise +/ date: April, 2012 +/ modified1: +/ +/ PURPOSE: +/ +/ +************************************************************************/ + +#include +#include +#include "ErrorExceptions.h" +#include "macros_and_parameters.h" +#include "typedefs.h" +#include "global_data.h" +#include "Fluxes.h" +#include "GridList.h" +#include "ExternalBoundary.h" +#include "Grid.h" + +/* function prototypes */ + +int grid::SetSubgridMarkerIsolatedBoundaries(void) +{ + + /* Return if this grid is not on this processor. */ + + if (MyProcessorNumber != ProcessorNumber) + return SUCCESS; + + /* declarations */ + + int i, j, k, n, dim, field, index; + int SubgridStart[MAX_DIMENSION], SubgridEnd[MAX_DIMENSION]; + + /* Check if the outer cells lie outside the domain */ + + bool inside = true; + for (dim = 0; dim < MAX_DIMENSION; dim++) + inside &= CellLeftEdge[dim][0] > DomainLeftEdge[dim] && + CellLeftEdge[dim][GridDimension[dim]-1] < DomainRightEdge[dim]; + if (inside) return SUCCESS; + + for (dim = 0; dim < MAX_DIMENSION; dim++) { + SubgridStart[dim] = 0; + SubgridEnd[dim] = 0; + } + + /* Compute start and stop indices of the domain within this grid + (and check to make sure subgrid is within this grid). */ + + for (dim = 0; dim < GridRank; dim++) { + + SubgridStart[dim] = nint( + (DomainLeftEdge[dim] - GridLeftEdge[dim])/CellWidth[dim][0]) + + GridStartIndex[dim]; + SubgridEnd[dim] = nint( + (DomainRightEdge[dim] - GridLeftEdge[dim])/CellWidth[dim][0] + ) + GridStartIndex[dim] - 1; + + SubgridStart[dim] = max(SubgridStart[dim], 0); + SubgridEnd[dim] = min(SubgridEnd[dim], GridDimension[dim]-1); + + } + + /* Now that there is overlap mark this grid with a NULL pointer. */ + + int xdim, ydim, din; + for (dim = 0; dim < MAX_DIMENSION; dim++) { + xdim = (dim+1) % MAX_DIMENSION; + ydim = (dim+2) % MAX_DIMENSION; + + // minus face + for (k = 0; k < SubgridStart[dim]; k++) + for (j = 0; j < GridDimension[ydim]; j++) + for (i = 0; i < GridDimension[xdim]; i++) { + switch (dim) { + case 0: + index = GRIDINDEX_NOGHOST(k,i,j); + break; + case 1: + index = GRIDINDEX_NOGHOST(j,k,i); + break; + case 2: + index = GRIDINDEX_NOGHOST(i,j,k); + break; + } + SubgridMarker[index] = NULL; + } // ENDFOR i + + // plus face + for (k = SubgridEnd[dim]+1; k < GridDimension[dim]; k++) + for (j = 0; j < GridDimension[ydim]; j++) + for (i = 0; i < GridDimension[xdim]; i++) { + switch (dim) { + case 0: + index = GRIDINDEX_NOGHOST(k,i,j); + break; + case 1: + index = GRIDINDEX_NOGHOST(j,k,i); + break; + case 2: + index = GRIDINDEX_NOGHOST(i,j,k); + break; + } + SubgridMarker[index] = NULL; + } // ENDFOR i + + } // ENDFOR dim + + return SUCCESS; + +} diff --git a/src/enzo/Grid_Shine.C b/src/enzo/Grid_Shine.C index 2f7341f77..85aa5f93b 100644 --- a/src/enzo/Grid_Shine.C +++ b/src/enzo/Grid_Shine.C @@ -48,14 +48,17 @@ int grid::Shine(RadiationSourceEntry *RadiationSource) double vec[3]; long long BasePackages = 0, NumberOfNewPhotonPackages = 0; int dim = 0; + int ipix, base_ipix, mod_ipix; int64_t ray = 0; int count = 0; int min_level = RadiativeTransferInitialHEALPixLevel; + int NumberOfThreads = NumberOfCores / NumberOfProcessors; /* base number of rays to star with: for min_level=2 this is 192 photon packages per source */ BasePackages = 12*(int)pow(4,min_level); + int PackagesPerThread = nint(ceil(float(BasePackages) / NumberOfThreads)); /* If using a beamed source, calculate the minimum z-component of the ray normal (always beamed in the polar coordinate). */ @@ -106,7 +109,7 @@ int grid::Shine(RadiationSourceEntry *RadiationSource) if (RS->Type == Episodic) { const float sigma_inv = 4.0; float t = PhotonTime - RS->CreationTime + dtPhoton; - float frac = 2.0 * fabs(t - round(t/RS->RampTime) * RS->RampTime) / + float frac = 2.0 * fabs(t - nint(t/RS->RampTime) * RS->RampTime) / RS->RampTime; RampPercent = exp((frac-1)*sigma_inv); } // ENDIF episodic @@ -195,6 +198,13 @@ int grid::Shine(RadiationSourceEntry *RadiationSource) /* Loop over each Ray */ for (ray=0; rayType == Beamed) { pix2vec_nest64((int64_t) (1 << min_level), (int64_t) ray, vec); // Dot product of the source orientation (already normalized diff --git a/src/enzo/Grid_SolveForPotential.C b/src/enzo/Grid_SolveForPotential.C index af31e5604..384e351d7 100644 --- a/src/enzo/Grid_SolveForPotential.C +++ b/src/enzo/Grid_SolveForPotential.C @@ -11,6 +11,8 @@ / NOTE: / ************************************************************************/ + +#include "preincludes.h" #include #include @@ -48,6 +50,7 @@ int grid::SolveForPotential(int level, FLOAT PotentialTime) return SUCCESS; LCAPERF_START("grid_SolveForPotential"); + START_GRID_TIMER; /* declarations */ @@ -163,6 +166,7 @@ int grid::SolveForPotential(int level, FLOAT PotentialTime) #endif LCAPERF_STOP("grid_SolveForPotential"); + END_GRID_TIMER(0); return SUCCESS; } diff --git a/src/enzo/Grid_SolveHydroEquations.C b/src/enzo/Grid_SolveHydroEquations.C index 825e6855b..116481492 100644 --- a/src/enzo/Grid_SolveHydroEquations.C +++ b/src/enzo/Grid_SolveHydroEquations.C @@ -626,7 +626,6 @@ int grid::SolveHydroEquations(int CycleNumber, int NumberOfSubgrids, } // end: if (NumberOfBaryonFields > 0) - this->DebugCheck("SolveHydroEquations (after)"); TIMER_STOP("SolveHydroEquations"); diff --git a/src/enzo/Grid_SolvePPM_DE.C b/src/enzo/Grid_SolvePPM_DE.C index ff97b24c4..fb86563df 100644 --- a/src/enzo/Grid_SolvePPM_DE.C +++ b/src/enzo/Grid_SolvePPM_DE.C @@ -87,15 +87,19 @@ int grid::SolvePPM_DE(int CycleNumber, int NumberOfSubgrids, // Update in x-direction if ((n % GridRank == 0) && nxz > 1) { - if (UseCUDA == 0) - for (k = 0; k < GridDimension[2]; k++) { - if (this->xEulerSweep(k, NumberOfSubgrids, SubgridFluxes, - GridGlobalStart, CellWidthTemp, GravityOn, - NumberOfColours, colnum, Pressure) == FAIL) { - ENZO_VFAIL("Error in xEulerSweep. k = %d\n", k) - } - } // ENDFOR k - else { + if (UseCUDA == 0) { +#pragma omp parallel for shared(NumberOfSubgrids, SubgridFluxes, GridGlobalStart, \ + CellWidthTemp, GravityOn, NumberOfColours, \ + colnum, Pressure) default(none) schedule(static) \ + private(current_error) + for (k = 0; k < GridDimension[2]; k++) { + if (this->xEulerSweep(k, NumberOfSubgrids, SubgridFluxes, + GridGlobalStart, CellWidthTemp, GravityOn, + NumberOfColours, colnum, Pressure) == FAIL) { + ENZO_VFAIL("Error in xEulerSweep. k = %d\n", k) + } + } // ENDFOR k + } else { #ifdef ECUDA cuPPMSweep(PPMData, PPMPara, dtFixed, 0); cuPPMSaveSubgridFluxes(SubgridFluxes, NumberOfSubgrids, @@ -106,15 +110,20 @@ int grid::SolvePPM_DE(int CycleNumber, int NumberOfSubgrids, // Update in y-direction if ((n % GridRank == 1) && nyz > 1) { - if (UseCUDA == 0) - for (i = 0; i < GridDimension[0]; i++) { - if (this->yEulerSweep(i, NumberOfSubgrids, SubgridFluxes, - GridGlobalStart, CellWidthTemp, GravityOn, - NumberOfColours, colnum, Pressure) == FAIL) { - ENZO_VFAIL("Error in yEulerSweep. i = %d\n", i) - } - } // ENDFOR i - else { + if (UseCUDA == 0) { +#pragma omp parallel for shared(NumberOfSubgrids, SubgridFluxes, GridGlobalStart, \ + CellWidthTemp, GravityOn, NumberOfColours, \ + colnum, Pressure) default(none) \ + private(current_error) + + for (i = 0; i < GridDimension[0]; i++) { + if (this->yEulerSweep(i, NumberOfSubgrids, SubgridFluxes, + GridGlobalStart, CellWidthTemp, GravityOn, + NumberOfColours, colnum, Pressure) == FAIL) { + ENZO_VFAIL("Error in yEulerSweep. i = %d\n", i) + } + } // ENDFOR i + } else { #ifdef ECUDA cuPPMSweep(PPMData, PPMPara, dtFixed, 1); cuPPMSaveSubgridFluxes(SubgridFluxes, NumberOfSubgrids, @@ -123,17 +132,21 @@ int grid::SolvePPM_DE(int CycleNumber, int NumberOfSubgrids, } } // ENDIF y-direction - // Update in z-direction + // Update in z-direction if ((n % GridRank == 2) && nzz > 1) { if (UseCUDA == 0) - for (j = 0; j < GridDimension[1]; j++) { - if (this->zEulerSweep(j, NumberOfSubgrids, SubgridFluxes, - GridGlobalStart, CellWidthTemp, GravityOn, - NumberOfColours, colnum, Pressure) == FAIL) { - ENZO_VFAIL("Error in zEulerSweep. j = %d\n", j) - - } - } // ENDFOR j +#pragma omp parallel for shared(NumberOfSubgrids, SubgridFluxes, GridGlobalStart, \ + CellWidthTemp, GravityOn, NumberOfColours, \ + colnum, Pressure) default(none) \ + private(current_error) + + for (j = 0; j < GridDimension[1]; j++) { + if (this->zEulerSweep(j, NumberOfSubgrids, SubgridFluxes, + GridGlobalStart, CellWidthTemp, GravityOn, + NumberOfColours, colnum, Pressure) == FAIL) { + ENZO_VFAIL("Error in zEulerSweep. j = %d\n", j); + } + } // ENDFOR j else { #ifdef ECUDA cuPPMSweep(PPMData, PPMPara, dtFixed, 2); diff --git a/src/enzo/Grid_SolveRadiativeCooling.C b/src/enzo/Grid_SolveRadiativeCooling.C index 9bb3f6d6f..89d1a0f79 100644 --- a/src/enzo/Grid_SolveRadiativeCooling.C +++ b/src/enzo/Grid_SolveRadiativeCooling.C @@ -119,8 +119,9 @@ int grid::SolveRadiativeCooling() /* Compute size (in floats) of the current grid. */ int i, dim, size = 1; - for (dim = 0; dim < GridRank; dim++) + for (dim = 0; dim < GridRank; dim++) { size *= GridDimension[dim]; + } /* Find fields: density, total energy, velocity1-3. */ diff --git a/src/enzo/Grid_SolveRateAndCoolEquations.C b/src/enzo/Grid_SolveRateAndCoolEquations.C index 92bc301fa..bc84016f5 100644 --- a/src/enzo/Grid_SolveRateAndCoolEquations.C +++ b/src/enzo/Grid_SolveRateAndCoolEquations.C @@ -47,7 +47,7 @@ extern "C" void FORTRAN_NAME(solve_rate_cool)( int *in, int *jn, int *kn, int *nratec, int *iexpand, hydro_method *imethod, int *idual, int *ispecies, int *imetal, int *imcool, int *idust, int *idim, - int *is, int *js, int *ks, int *ie, int *je, int *ke, int *ih2co, + int *is, int *js, int *ks, int *ie, int *je, int *ke, int *imax, int *ih2co, int *ipiht, int *igammah, FLOAT *dx, float *dt, float *aye, float *redshift, float *temstart, float *temend, float *utem, float *uxyz, float *uaye, float *urho, float *utim, @@ -135,8 +135,9 @@ int grid::SolveRateAndCoolEquations(int RTCoupledSolverIntermediateStep) /* Compute size of the current grid. */ - int i, dim, size = 1; + int i, dim, MaxDimension = 0, size = 1; for (dim = 0; dim < GridRank; dim++) { + MaxDimension = max(MaxDimension, GridDimension[dim]); size *= GridDimension[dim]; } @@ -264,7 +265,7 @@ int grid::SolveRateAndCoolEquations(int RTCoupledSolverIntermediateStep) &DualEnergyFormalism, &MultiSpecies, &MetalFieldPresent, &MetalCooling, &H2FormationOnDust, &GridRank, GridStartIndex, GridStartIndex+1, GridStartIndex+2, - GridEndIndex, GridEndIndex+1, GridEndIndex+2, + GridEndIndex, GridEndIndex+1, GridEndIndex+2, &MaxDimension, &CoolData.ih2co, &CoolData.ipiht, &PhotoelectricHeating, CellWidth[0], &dtCool, &afloat, &RadiationFieldRedshift, &CoolData.TemperatureStart, &CoolData.TemperatureEnd, diff --git a/src/enzo/Grid_SolveRateEquations.C b/src/enzo/Grid_SolveRateEquations.C index 074e741b7..20f3a71d3 100644 --- a/src/enzo/Grid_SolveRateEquations.C +++ b/src/enzo/Grid_SolveRateEquations.C @@ -157,9 +157,8 @@ int grid::SolveRateEquations() float *temperature = new float[size]; if (this->ComputeTemperatureField(temperature) == FAIL) { ENZO_FAIL("Error in grid->ComputeTemperatureField.\n"); - } - + /* Call the fortran routine to solve cooling equations. */ int addRT = (RadiativeTransfer) || (RadiativeTransferFLD); diff --git a/src/enzo/Grid_StarParticleHandler.C b/src/enzo/Grid_StarParticleHandler.C index 88904c837..6c5d56024 100644 --- a/src/enzo/Grid_StarParticleHandler.C +++ b/src/enzo/Grid_StarParticleHandler.C @@ -29,6 +29,7 @@ #include "Grid.h" #include "fortran.def" #include "CosmologyParameters.h" +#include "phys_constants.h" #include "phys_constants.h" @@ -751,6 +752,17 @@ int grid::StarParticleHandler(HierarchyEntry* SubgridPointer, int level, } else OverDensityThreshold = PopIIIOverDensityThreshold; + + /* Piggyback on the PopIIIOverDensityThreshold formalism (directly above): + If StarMakerUsePhysicalDensityThreshold is set to true, convert from proper + hydrogen number density (which is the input parameter) to actual physical units, + and then convert into code density units. + */ + if(StarMakerUsePhysicalDensityThreshold == TRUE){ + OverDensityThreshold = StarMakerOverDensityThreshold * 1.22 * mh / DensityUnits; + } else { + OverDensityThreshold = StarMakerOverDensityThreshold; + } float CellWidthTemp = float(CellWidth[0][0]); float PopIIIMass = (PopIIIInitialMassFunction == TRUE) ? @@ -874,7 +886,7 @@ int grid::StarParticleHandler(HierarchyEntry* SubgridPointer, int level, &MaximumNumberOfNewParticles, CellLeftEdge[0], CellLeftEdge[1], CellLeftEdge[2], &GhostZones, &MetallicityField, &HydroMethod, &StarMakerMinimumDynamicalTime, - &StarMakerOverDensityThreshold, &StarMakerMassEfficiency, + &OverDensityThreshold, &StarMakerMassEfficiency, &StarMakerMinimumMass, &level, &NumberOfNewParticles, tg->ParticlePosition[0], tg->ParticlePosition[1], tg->ParticlePosition[2], diff --git a/src/enzo/Grid_TransferSubgridActiveParticles.C b/src/enzo/Grid_TransferSubgridActiveParticles.C index 5ba69d67e..d109cb98c 100644 --- a/src/enzo/Grid_TransferSubgridActiveParticles.C +++ b/src/enzo/Grid_TransferSubgridActiveParticles.C @@ -28,7 +28,7 @@ #include "ActiveParticle.h" int grid::TransferSubgridActiveParticles -(grid* Subgrids[], int NumberOfSubgrids, int* &NumberToMove, int StartIndex, +(grid* Subgrids[], int NumberOfSubgrids, int* &NumberToMove, int &Counter, int EndIndex, ActiveParticleList &List, bool KeepLocal, bool ParticlesAreLocal, int CopyDirection, int IncludeGhostZones, int CountOnly) @@ -145,7 +145,9 @@ int grid::TransferSubgridActiveParticles /* Move particles from grid array to a separate list. */ - n1 = PreviousTotalToMove; +#pragma omp critical +{ + n1 = Counter; for (i = 0; i < NumberOfActiveParticles; i++) { if (subgrid[i] >= 0) { @@ -166,6 +168,8 @@ int grid::TransferSubgridActiveParticles ActiveParticles.delete_marked_particles(); NumberOfActiveParticles = ParticlesLeft; + Counter = n1; +} // END omp critical } // ENDIF stars to move @@ -180,7 +184,7 @@ int grid::TransferSubgridActiveParticles /* Count up total number. */ - int NumberOfNewActiveParticles = EndIndex - StartIndex; + int NumberOfNewActiveParticles = EndIndex - Counter; /* Copy stars from buffer into linked list */ @@ -188,10 +192,10 @@ int grid::TransferSubgridActiveParticles // Increase the level if moving to a subgrid // if (IncludeGhostZones == FALSE) -// for (i = StartIndex; i < EndIndex; i++) { +// for (i = Counter; i < EndIndex; i++) { // } - this->AddActiveParticles(List, StartIndex, EndIndex); + this->AddActiveParticles(List, Counter, EndIndex); } // ENDIF new particles diff --git a/src/enzo/Grid_TransferSubgridParticles.C b/src/enzo/Grid_TransferSubgridParticles.C index 540989606..d9589cb48 100644 --- a/src/enzo/Grid_TransferSubgridParticles.C +++ b/src/enzo/Grid_TransferSubgridParticles.C @@ -11,9 +11,14 @@ / PURPOSE: / ************************************************************************/ + +#ifdef _OPENMP +#include +#endif #include #include +#include #include "ErrorExceptions.h" #include "macros_and_parameters.h" @@ -24,7 +29,9 @@ #include "ExternalBoundary.h" #include "Grid.h" #include "Hierarchy.h" - + +#define MAX_THREADS 128 + int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, int* &NumberToMove, int StartIndex, int EndIndex, particle_data* &List, @@ -32,9 +39,27 @@ int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, int CopyDirection, int IncludeGhostZones, int CountOnly) { + int ParticleCounter=0; +// printf("ParticleCounter reset 2\n"); + return this->TransferSubgridParticles(Subgrids, NumberOfSubgrids, + NumberToMove, ParticleCounter, StartIndex, EndIndex, List, KeepLocal, ParticlesAreLocal, + CopyDirection, IncludeGhostZones, CountOnly); +} +int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, + int* &NumberToMove, int &ParticleCounter, int StartIndex, + int EndIndex, particle_data* &List, + bool KeepLocal, bool ParticlesAreLocal, + int CopyDirection, int IncludeGhostZones, + int CountOnly) +{ /* Declarations. */ +// #ifdef _OPENMP +// static int ThreadStart[MAX_THREADS]; +// static int ThreadCount[MAX_THREADS]; +// #endif + int i, j, index, dim, n1, grid, proc; int i0, j0, k0; @@ -46,9 +71,9 @@ int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, /* If particles aren't distributed over several processors, exit if this isn't the host processor. */ - if (ParticlesAreLocal && MyProcessorNumber != ProcessorNumber) + if (ParticlesAreLocal && MyProcessorNumber != ProcessorNumber){ return SUCCESS; - + } /* If there are no particles to move, we're done. */ if (NumberOfParticles == 0) { @@ -107,6 +132,14 @@ int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, count. */ subgrid[i] = nint(BaryonField[NumberOfBaryonFields][index])-1; + if (subgrid[i] < -1 || subgrid[i] > NumberOfSubgrids-1) { + ENZO_VFAIL("particle subgrid (%"ISYM"/%"ISYM") out of range\n", + subgrid[i], NumberOfSubgrids) + } + + } // ENDFOR particles + + for (i = 0; i < NumberOfParticles; i++) if (subgrid[i] >= 0) { if (KeepLocal) proc = MyProcessorNumber; @@ -114,16 +147,10 @@ int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, proc = Subgrids[subgrid[i]]->ReturnProcessorNumber(); NumberToMove[proc]++; } - if (subgrid[i] < -1 || subgrid[i] > NumberOfSubgrids-1) { - ENZO_VFAIL("particle subgrid (%"ISYM"/%"ISYM") out of range\n", - subgrid[i], NumberOfSubgrids) - } - - } // ENDFOR particles if (CountOnly == TRUE) { delete [] subgrid; - return SUCCESS; + return SUCCESS; } int TotalToMove = 0; @@ -154,30 +181,108 @@ int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, /* Move particles (mark those moved by setting mass = FLOAT_UNDEFINED). */ - n1 = PreviousTotalToMove; - for (i = 0; i < NumberOfParticles; i++) { - if (subgrid[i] >= 0) { - if (KeepLocal) - proc = MyProcessorNumber; - else - proc = Subgrids[subgrid[i]]->ReturnProcessorNumber(); - for (dim = 0; dim < GridRank; dim++) { - List[n1].pos[dim] = ParticlePosition[dim][i]; - List[n1].vel[dim] = ParticleVelocity[dim][i]; - } - List[n1].mass = ParticleMass[i] * MassIncrease; - List[n1].id = ParticleNumber[i]; - List[n1].type = ParticleType[i]; - for (j = 0; j < NumberOfParticleAttributes; j++) - List[n1].attribute[j] = ParticleAttribute[j][i]; - List[n1].grid = subgrid[i]; - List[n1].proc = proc; - ParticleMass[i] = FLOAT_UNDEFINED; - n1++; - } // ENDIF move to subgrid - } // ENDFOR particles + int nn, move_per_thread; + int nmove = TotalToMove - PreviousTotalToMove; + int CoresPerProcess = NumberOfCores / NumberOfProcessors; + int ThreadNum = 0; + bool SingleThread = (CoresPerProcess == 1 || nmove/50 < CoresPerProcess); +/** Since parallelization is done over grids, it is no longer necessary to have + a multi-threaded version of this routine. +**/ +#pragma omp critical +{ +// printf("Thread %d enters critical section :: ParticleCounter @ %d \n ", omp_get_thread_num(), ParticleCounter); + for (i = 0; i < NumberOfParticles; i++) { + if (subgrid[i] >= 0) { + if (KeepLocal) + proc = MyProcessorNumber; + else + proc = Subgrids[subgrid[i]]->ReturnProcessorNumber(); + + n1 = ParticleCounter; + for (dim = 0; dim < GridRank; dim++) { + List[n1].pos[dim] = ParticlePosition[dim][i]; + List[n1].vel[dim] = ParticleVelocity[dim][i]; +// if( abs(List[n1].pos[dim]) > 1 || abs(List[n1].vel[dim] > 1)) +// printf("n1=%d, ParticleCounter=%d\n", n1, ParticleCounter); + + } + + List[n1].mass = ParticleMass[i] * MassIncrease; + List[n1].id = ParticleNumber[i]; + List[n1].type = ParticleType[i]; + for (j = 0; j < NumberOfParticleAttributes; j++) + List[n1].attribute[j] = ParticleAttribute[j][i]; + List[n1].grid = subgrid[i]; + List[n1].proc = proc; + ParticleMass[i] = FLOAT_UNDEFINED; + ParticleCounter++; + } // ENDIF move to subgrid + } // ENDFOR particles +// printf("Thread %d leaves critical section :: ParticleCounter @ %d \n ", omp_get_thread_num(), ParticleCounter); +}//omp end critical + +// } // END omp single +// } // ENDIF SingleThread + + // Threaded version +// else { + + /* Find out how many particles are being moved per thread + block, so we know where to start inserting them in the move + list. */ + +/** +#ifdef _OPENMP + move_per_thread = nmove / CoresPerProcess; + for (i = 0; i < CoresPerProcess+1; i++) + ThreadCount[i] = 0; + + nn = -1; + ThreadStart[0] = 0; + for (i = 0; i < NumberOfParticles; i++) + if (subgrid[i] >= 0) { + if (nn == -1) + ThreadStart[++nn] = i; + ThreadCount[nn]++; + if (ThreadCount[nn] == move_per_thread && + nn+1 < CoresPerProcess) + ThreadStart[++nn] = i+1; + } + ThreadStart[CoresPerProcess] = NumberOfParticles; + + n1 = PreviousTotalToMove; + for (i = 0; i < ThreadNum; i++) n1 += ThreadCount[i]; + + if (ThreadCount[ThreadNum] > 0) + for (i = ThreadStart[ThreadNum]; i < ThreadStart[ThreadNum+1]; i++) { + if (subgrid[i] >= 0) { + if (KeepLocal) + proc = MyProcessorNumber; + else + proc = Subgrids[subgrid[i]]->ReturnProcessorNumber(); + for (dim = 0; dim < GridRank; dim++) { + List[n1].pos[dim] = ParticlePosition[dim][i]; + List[n1].vel[dim] = ParticleVelocity[dim][i]; + } + List[n1].mass = ParticleMass[i] * MassIncrease; + List[n1].id = ParticleNumber[i]; + List[n1].type = ParticleType[i]; + for (j = 0; j < NumberOfParticleAttributes; j++) + List[n1].attribute[j] = ParticleAttribute[j][i]; + List[n1].grid = subgrid[i]; + List[n1].proc = proc; + ParticleMass[i] = FLOAT_UNDEFINED; + n1++; + } // ENDIF move to subgrid + } // ENDFOR particles +#endif // _OPENMP + } // ENDELSE SingleThread + + } // END parallel +*/ if (TotalToMove != PreviousTotalToMove) this->CleanUpMovedParticles(); @@ -197,8 +302,9 @@ int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, /* If particles aren't distributed over several processors, exit if this isn't the host processor. */ - if (ParticlesAreLocal && MyProcessorNumber != ProcessorNumber) - return SUCCESS; + if (ParticlesAreLocal && MyProcessorNumber != ProcessorNumber){ + return SUCCESS; + } /* Count up total number. */ @@ -234,6 +340,9 @@ int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, /* Copy this grid's particles to the new space. */ +//#pragma omp parallel private(dim,j) +// { +//#pragma omp for nowait schedule(static) for (i = 0; i < NumberOfParticles; i++) { Mass[i] = ParticleMass[i]; Number[i] = ParticleNumber[i]; @@ -241,42 +350,50 @@ int grid::TransferSubgridParticles(grid* Subgrids[], int NumberOfSubgrids, } for (dim = 0; dim < GridRank; dim++) +//#pragma omp for nowait schedule(static) for (i = 0; i < NumberOfParticles; i++) { Position[dim][i] = ParticlePosition[dim][i]; Velocity[dim][i] = ParticleVelocity[dim][i]; } for (j = 0; j < NumberOfParticleAttributes; j++) +//#pragma omp for nowait schedule(static) for (i = 0; i < NumberOfParticles; i++) Attribute[j][i] = ParticleAttribute[j][i]; /* Copy new particles */ - int n = NumberOfParticles; + int n; +//#pragma omp for nowait schedule(static) private(n) for (i = StartIndex; i < EndIndex; i++) { + n = NumberOfParticles + i - StartIndex; Mass[n] = List[i].mass; Number[n] = List[i].id; Type[n] = List[i].type; - n++; } for (dim = 0; dim < GridRank; dim++) { - n = NumberOfParticles; +//#pragma omp for nowait schedule(static) private(n) for (i = StartIndex; i < EndIndex; i++) { + n = NumberOfParticles + i - StartIndex; Position[dim][n] = List[i].pos[dim]; Velocity[dim][n] = List[i].vel[dim]; - n++; + if( fabs(Velocity[dim][n]) > 1 ) + printf("FINDME: Velocity is too high!\n"); + if( fabs(Position[dim][n]) > 2 ) + printf("FINDME: Position is too high!\n"); } } for (j = 0; j < NumberOfParticleAttributes; j++) { - n = NumberOfParticles; +//#pragma omp for nowait schedule(static) private(n) for (i = StartIndex; i < EndIndex; i++) { + n = NumberOfParticles + i - StartIndex; Attribute[j][n] = List[i].attribute[j]; - n++; } } + // } // ENDIF #pragma parallel } // ENDIF TotalNumberOfParticles > 0 diff --git a/src/enzo/Grid_TransferSubgridStars.C b/src/enzo/Grid_TransferSubgridStars.C index 0c4a5e8c7..bb5122096 100644 --- a/src/enzo/Grid_TransferSubgridStars.C +++ b/src/enzo/Grid_TransferSubgridStars.C @@ -31,7 +31,7 @@ Star* StarBufferToList(StarBuffer buffer); void InsertStarAfter(Star * &Node, Star * &NewNode); int grid::TransferSubgridStars(grid* Subgrids[], int NumberOfSubgrids, - int* &NumberToMove, int StartIndex, + int* &NumberToMove, int &Counter, int EndIndex, star_data* &List, bool KeepLocal, bool ParticlesAreLocal, int CopyDirection, int IncludeGhostZones, @@ -135,7 +135,9 @@ int grid::TransferSubgridStars(grid* Subgrids[], int NumberOfSubgrids, /* Move stars */ - n1 = PreviousTotalToMove; +#pragma omp critical +{ + n1 = Counter; NumberOfStars = 0; cstar = Stars; Stars = NULL; @@ -163,6 +165,8 @@ int grid::TransferSubgridStars(grid* Subgrids[], int NumberOfSubgrids, i++; } // ENDWHILE stars + Counter = n1; +} // END omp critical } // ENDIF stars to move @@ -178,14 +182,14 @@ int grid::TransferSubgridStars(grid* Subgrids[], int NumberOfSubgrids, /* Count up total number. */ int TotalNumberOfStars; - int NumberOfNewStars = EndIndex - StartIndex; + int NumberOfNewStars = EndIndex - Counter; TotalNumberOfStars = NumberOfStars + NumberOfNewStars; /* Copy stars from buffer into linked list */ if (NumberOfNewStars > 0) - for (i = StartIndex; i < EndIndex; i++) { + for (i = Counter; i < EndIndex; i++) { MoveStar = StarBufferToList(List[i].data); MoveStar->GridID = List[i].grid; MoveStar->CurrentGrid = this; diff --git a/src/enzo/Grid_TransportPhotonPackages.C b/src/enzo/Grid_TransportPhotonPackages.C index a8a45d502..69a3a5794 100644 --- a/src/enzo/Grid_TransportPhotonPackages.C +++ b/src/enzo/Grid_TransportPhotonPackages.C @@ -17,10 +17,17 @@ / RETURNS: FAIL or SUCCESS / ************************************************************************/ +#ifdef _OPENMP +#include +#endif /* _OPENMP */ +#ifdef USE_MPI +#include "mpi.h" +#endif /* USE_MPI */ #include #include #include #include "ErrorExceptions.h" +#include "EnzoTiming.h" #include "macros_and_parameters.h" #include "typedefs.h" #include "global_data.h" @@ -31,6 +38,9 @@ #include "phys_constants.h" void InsertPhotonAfter(PhotonPackageEntry * &Node, PhotonPackageEntry * &NewNode); +void MergePhotonLists(PhotonPackageEntry * &Node1, PhotonPackageEntry * &Node2); +void MergePhotonMoveLists(ListOfPhotonsToMove * &Node1, + ListOfPhotonsToMove * &Node2); PhotonPackageEntry *PopPhoton(PhotonPackageEntry * &Node); PhotonPackageEntry *DeletePhotonPackage(PhotonPackageEntry *PP); int FindField(int field, int farray[], int numfields); @@ -45,7 +55,6 @@ int grid::TransportPhotonPackages(int level, int finest_level, { int i,j,k, dim, index, count; - grid *MoveToGrid; if (MyProcessorNumber != ProcessorNumber) return SUCCESS; @@ -60,8 +69,14 @@ int grid::TransportPhotonPackages(int level, int finest_level, ENZO_FAIL("Transfer in less than 3D is not implemented!\n"); } - if (PhotonPackages->NextPackage == NULL) + TIMER_START("TransportPhotons"); + + if (PhotonPackages->NextPackage == NULL) { + TIMER_STOP("TransportPhotons"); return SUCCESS; + } + + START_GRID_TIMER; /* Get units. */ double MassUnits, RT_Units; @@ -139,10 +154,87 @@ int grid::TransportPhotonPackages(int level, int finest_level, } count = 0; + while (PP->NextPackage != NULL) { + count++; + PP = PP->NextPackage; + } + if (DEBUG) { + fprintf(stdout, "TransportPhotonPackage: done initializing.\n"); + fprintf(stdout, "counted %"ISYM" packages\n", count); + } + +#pragma omp parallel private(PP, FPP, PausedPP, SavedPP) + { + grid *MoveToGrid; + ListOfPhotonsToMove *ThreadedMoveList = new ListOfPhotonsToMove; + ThreadedMoveList->NextPackageToMove = NULL; + ThreadedMoveList->PhotonPackage = NULL; + ThreadedMoveList->FromGrid = NULL; + ThreadedMoveList->ToGrid = NULL; + + int ii, pstart, pend, photons_per_thread; + int CoresPerProcess = NumberOfCores / NumberOfProcessors; + int ThreadNum = 0; + bool SingleThread = (CoresPerProcess == 1 || count < CoresPerProcess); +#ifdef _OPENMP + ThreadNum = omp_get_thread_num(); +#endif + + /* Manually split linked list of photons into separate links for + each thread */ + + PhotonPackageEntry *HeadPointer = new PhotonPackageEntry; PP = PhotonPackages->NextPackage; - FPP = this->FinishedPhotonPackages; - PausedPP = this->PausedPhotonPackages; - + + if (SingleThread) { + FPP = this->FinishedPhotonPackages; + PausedPP = this->PausedPhotonPackages; + if (ThreadNum > 0) PP = NULL; // Other cores are idle if not enough work + } else { + PhotonPackageEntry *TempPP; + FPP = new PhotonPackageEntry; + PausedPP = new PhotonPackageEntry; + photons_per_thread = count / CoresPerProcess; + pstart = photons_per_thread * ThreadNum; + pend = min(count, photons_per_thread * (ThreadNum+1))-1; + if (DEBUG) + printf("PP threading: thread %d, %d/%d photons, %d -> %d\n", + ThreadNum, photons_per_thread, count, pstart, pend); + for (ii = 0; ii < pstart; ii++) + PP = PP->NextPackage; + + // Save the first photon pointer + MergePhotonLists(HeadPointer, PP); + + // Set NextPackage of the last photon in the list to NULL to + // terminate the list. + TempPP = PP; + for (ii = pstart; ii < pend; ii++) + TempPP = TempPP->NextPackage; + + // Need the barrier, so we don't break the list before all of the + // threads have their own list from the main list. +#pragma omp barrier + TempPP->NextPackage = NULL; + + // The first photon package to calculate the one linked by + // HeadPointer + PP = HeadPointer->NextPackage; + + /* Detach linked lists from the grid pointers. Only one thread + needs to do this because the grid data are shared. */ + +#pragma omp single + { + this->PhotonPackages->NextPackage = NULL; +#ifdef UNUSED + this->FinishedPhotonPackages->NextPackage = NULL; + this->PausedPhotonPackages->NextPackage = NULL; +#endif + } + + } + int dcount = 0; int tcount = 0; int pcount = 0; @@ -230,8 +322,8 @@ int grid::TransportPhotonPackages(int level, int finest_level, PP->NextPackage, PhotonPackages); } ListOfPhotonsToMove *NewEntry = new ListOfPhotonsToMove; - NewEntry->NextPackageToMove = (*PhotonsToMove)->NextPackageToMove; - (*PhotonsToMove)->NextPackageToMove = NewEntry; + NewEntry->NextPackageToMove = ThreadedMoveList->NextPackageToMove; + ThreadedMoveList->NextPackageToMove = NewEntry; NewEntry->PhotonPackage = PP; NewEntry->FromGrid = CurrentGrid; NewEntry->ToGrid = MoveToGrid; @@ -267,6 +359,45 @@ int grid::TransportPhotonPackages(int level, int finest_level, this->ID, tcount, dcount, pcount, trcount); NumberOfPhotonPackages -= dcount; + /* All of the work is finished. Now we merge the linked lists, + including the photon move list, on each thread together again. + This section is critical because we'll be modifying the grid + pointers. */ + + ListOfPhotonsToMove *PM = ThreadedMoveList->NextPackageToMove; + +#pragma omp critical + { + if (!SingleThread) { + if (HeadPointer->NextPackage != NULL) + MergePhotonLists(this->PhotonPackages, HeadPointer->NextPackage); + if (FPP->NextPackage != NULL) + MergePhotonLists(this->FinishedPhotonPackages, FPP->NextPackage); + if (PausedPP->NextPackage != NULL) + MergePhotonLists(this->PausedPhotonPackages, PausedPP->NextPackage); + } // ENDIF multicore + + if (PM != NULL) + MergePhotonMoveLists(*PhotonsToMove, PM); + + this->NumberOfPhotonPackages -= dcount; + + } // END critical + + /* Cleanup */ + + delete ThreadedMoveList; + delete HeadPointer; + if (!SingleThread) { + delete FPP; + delete PausedPP; + } + + } // END parallel + + END_GRID_TIMER(2); + + TIMER_STOP("TransportPhotons"); #ifdef UNUSED for (k = GridStartIndex[2]; k <= GridEndIndex[2]; k++) { if (HasRadiation == TRUE) break; diff --git a/src/enzo/Grid_inteuler.C b/src/enzo/Grid_inteuler.C new file mode 100644 index 000000000..46bab246d --- /dev/null +++ b/src/enzo/Grid_inteuler.C @@ -0,0 +1,428 @@ +//======================================================================= +///////////////////////// SUBROUTINE INTEULER \\\\\\\\\\\\\\\\\\\\\\\\\ +// +// subroutine inteuler( +// & dslice, pslice, gravity, grslice, geslice, +// & uslice, vslice, wslice, dxi, flatten, +// & idim, jdim, i1, i2, j1, j2, idual, eta1, eta2, +// & isteep, iflatten, dt, gamma, ipresfree, +// & dls, drs, pls, prs, gels, gers, +// & uls, urs, vls, vrs, wls, wrs, +// & ncolor, colslice, colls, colrs +// & ) +// +// COMPUTES LEFT AND RIGHT EULERIAN INTERFACE VALUES FOR RIEMANN SOLVER +// +// written by: Jim Stone +// date: January,1991 +// modified1: June, 1993 by Greg Bryan (changed to eulerian) +// modified2: July, 1994 by Greg Bryan (changed to slicewise) +// modified3: April, 1995 by GB (added gravity) +// modified4: January, 2010 by JHW (translated to C++) +// +// PURPOSE: Uses piecewise parabolic interpolation to compute left- +// and right interface values to be fed into Riemann solver during a +// one dimensional sweeps. This version computes the Eulerian corrections +// to the left and right states described in section three of Colella & +// Woodward (1984), JCP. The routine works on one two dimensional +// slice at a time. +// +// INPUT: +// dslice - extracted 2d slice of the density, d +// dt - timestep in problem time +// dxi - distance between Eulerian zone edges in sweep direction +// eta1 - (dual) selection parameter for gas energy (typically ~0.001) +// flatten - ammount of flattening (calculated in calcdiss) +// gamma - ideal gas law constant +// gravity - gravity flag (0 = off) +// grslice - acceleration in this direction in this slice +// i1,i2 - starting and ending addresses for dimension 1 +// idim - declared leading dimension of slices +// idual - dual energy formalism flag (0 = off) +// iflatten - integer flag for flattener (eq. A1, A2) (0 = off) +// isteep - integer flag for steepener (eq. 1.14,1.17,3.2) (0 = off) +// ipresfree - pressure free flag (0 = off, 1 = on, i.e. p=0) +// j1,j2 - starting and ending addresses for dimension 2 +// jdim - declared second dimension of slices +// pslice - extracted 2d slice of the pressure, p +// uslice - extracted 2d slice of the 1-velocity, u +// vslice - extracted 2d slice of the 2-velocity, v +// wslice - extracted 2d slice of the 3-velocity, w +// +// OUTPUT: +// dl,rs - density at left and right edges of each cell +// pl,rs - pressure at left and right edges of each cell +// ul,rs - 1-velocity at left and right edges of each cell +// vl,rs - 2-velocity at left and right edges of each cell +// wl,rs - 3-velocity at left and right edges of each cell +// +// EXTERNALS: +// +// LOCALS: +// +// PARAMETERS: +// ft - a constant used in eq. 1.124 (=2*2/3) +// + +#include +#include +#include +#include "macros_and_parameters.h" +#include "typedefs.h" +#include "global_data.h" +#include "Fluxes.h" +#include "GridList.h" +#include "ExternalBoundary.h" +#include "Grid.h" +#include "fortran.def" + +void intvarC(float *qslice, int in, int is, int ie, int j, int isteep, + float *steepen, int iflatten, float *flatten, float *c1, + float *c2, float *c3, float *c4, float *c5, float *c6, + float *char1, float *char2, float *c0, float *dq, float *ql, + float *qr, float *q6, float *qla, float *qra, float *ql0, + float *qr0); + +int grid::inteuler(int idim, + float *dslice, float *pslice, int gravity, float *grslice, + float *geslice, float *uslice, float *vslice, float *wslice, + float *dxi, float *flatten, + float *dls, float *drs, float *pls, float *prs, float *gels, + float *gers, float *uls, float *urs, float *vls, float *vrs, + float *wls, float *wrs, int ncolors, float *colslice, + float *colls, float *colrs) +{ + + /* Local variables */ + + const int NN = GridDimension[idim]; + const int NC = GridDimension[idim]*MAX_COLOR; + const float ft = 4.0/3.0; + + int i, j, ic, index, cindex, scindex; + float steepen[NN], tmp1[NN], tmp2[NN], tmp3[NN], tmp4[NN]; + float qa,qb,qc,qd,qe,s1,s2,f1; + float c1[NN], c2[NN], c3[NN], c4[NN], c5[NN], c6[NN], dxinv[NN], + dp[NN], pl[NN], pr[NN], p6[NN], du[NN], ul[NN], ur[NN], u6[NN], + dla[NN], dra[NN], pla[NN], pra[NN], ula[NN], ura[NN], vla[NN], + vra[NN], wla[NN], wra[NN], plm[NN], prm[NN], ulm[NN], urm[NN], + dl0[NN], dr0[NN], pl0[NN], pr0[NN], plp[NN], prp[NN], ulp[NN], + urp[NN], ul0[NN], ur0[NN], vl0[NN], vr0[NN], wl0[NN], wr0[NN], + cs[NN], d2d[NN], dxb[NN], cm[NN], c0[NN], cp[NN], char1[NN], + char2[NN], betalp[NN], betalm[NN], betal0[NN], cla[NN], betarp[NN], + betarm[NN], betar0[NN], cra[NN], gela[NN], gera[NN], gel0[NN], ger0[NN], + clainv[NN], crainv[NN], dx2i[NN], dxdt2[NN]; + float colla[NC], colra[NC], coll0[NC], colr0[NC]; + //float colla[MAX_COLOR][NN], colra[MAX_COLOR][NN], coll0[MAX_COLOR][NN], + // colr0[MAX_COLOR][NN]; + + /* Shorthand for data bounds and dimensions */ + + int jdim = (idim+1) % 3; + int in, jn, is, ie, js, je; + + in = GridDimension[idim]; + jn = GridDimension[jdim]; + is = GridStartIndex[idim]; + ie = GridEndIndex[idim]; + js = 0; + je = GridDimension[jdim]-1; + +// +// Compute coefficients used in interpolation formulae (from eq. 1.6) +// + + for (i = is-2; i <= ie+2; i++) { + qa = dxi[i] / (dxi[i-1] + dxi[i] + dxi[i+1]); + c1[i] = qa*(2.0*dxi[i-1] + dxi[i])/(dxi[i+1] + dxi[i]); + c2[i] = qa*(2.0*dxi[i+1] + dxi[i])/(dxi[i-1] + dxi[i]); + dxinv[i] = 1.0/dxi[i]; + dxdt2[i] = 0.5*dtFixed*dxinv[i]; + } + + for (i = is-1; i <= ie+2; i++) { + qa = dxi[i-2] + dxi[i-1] + dxi[i] + dxi[i+1]; + qb = dxi[i-1]/(dxi[i-1] + dxi[i]); + qc = (dxi[i-2] + dxi[i-1])/(2.0*dxi[i-1] + dxi[i ]); + qd = (dxi[i+1] + dxi[i ])/(2.0*dxi[i ] + dxi[i-1]); + qb = qb + 2.0*dxi[i]*qb/qa*(qc-qd); + c3[i] = 1.0 - qb; + c4[i] = qb; + c5[i] = dxi[i ]/qa*qd; + c6[i] = -dxi[i-1]/qa*qc; + dx2i[i] = 0.5*dxinv[i]; + } + +// +// Loop over sweep lines (in this slice) +// + for (j = js; j <= je; j++) { +// +// Precompute steepening coefficients if needed (eqns 1.14-1.17, plus 3.2) +// + if (PPMSteepeningParameter) { + for (i = is-2, index = in*j+is-2; i <= ie+2; i++, index++) { + qa = dxi[i-1] + dxi[i] + dxi[i+1]; + d2d[i] = (dslice[index+1] - dslice[index])/(dxi[i+1] + dxi[i]); + d2d[i] = (d2d[i] - (dslice[index]-dslice[index-1]) + /(dxi[i]+dxi[i-1]))/qa; + dxb[i] = 0.5*(dxi[i] + dxi[i+1]); + } // ENDFOR i + for (i = is-1, index = in*j+is-1; i <= ie+1; i++, index++) { + qc = fabs(dslice[index+1] - dslice[index-1]) + - 0.01*min(fabs(dslice[index+1]), fabs(dslice[index-1])); + s1 = (d2d[i-1] - d2d[i+1])*(powf(dxb[i-1],3) + powf(dxb[i],3)) + /((dxb[i] + dxb[i-1])* + (dslice[index+1] - dslice[index-1] + tiny_number)); + if (d2d[i+1]*d2d[i-1] > 0.0) s1 = 0.0; + if (qc <= 0.0) s1 = 0.0; + s2 = max(0.0, min(20.0*(s1-0.05), 1.0)); + qa = fabs(dslice[index+1] - dslice[index-1])/ + min(dslice[index+1], dslice[index-1]); + qb = fabs(pslice[index+1] - pslice[index-1])/ + min(pslice[index+1], pslice[index-1]); + steepen[i] = (0.1*Gamma*qa >= qb) ? s2 : 0.0; + } // ENDFOR i + } // ENDIF steepen + +// +// Precompute left and right characteristic distances +// + + for (i = 0, index = in*j; i < in; i++, index++) { + cs[i] = sqrtf(Gamma * pslice[index] / dslice[index]); + if (PressureFree) cs[i] = tiny_number; + char1[i] = max(0.0, dtFixed * (uslice[index] + cs[i])) * dx2i[i]; + char2[i] = max(0.0, -dtFixed * (uslice[index] - cs[i])) * dx2i[i]; + } // ENDFOR i + + for (i = is-2, index = in*j+is-2; i <= ie+2; i++, index++) { + cm[i] = dtFixed*(uslice[index]-cs[i])*(0.5*dxinv[i]); + c0[i] = dtFixed*(uslice[index] )*(0.5*dxinv[i]); + cp[i] = dtFixed*(uslice[index]+cs[i])*(0.5*dxinv[i]); + } // ENDFOR i + +// +// Compute left and right states for each variable +// (steepening, if requested, is only applied to density) +// + intvarC(dslice, in, is, ie, j, PPMSteepeningParameter, steepen, + PPMFlatteningParameter, flatten, c1, c2, c3, c4, c5, c6, char1, + char2, c0, tmp1, tmp2, tmp3, tmp4, dla, dra, dl0, dr0); + + intvarC(pslice, in, is, ie, j, 0, steepen, + PPMFlatteningParameter, flatten, c1, c2, c3, c4, c5, c6, char1, + char2, c0, dp, pl, pr, p6, pla, pra, pl0, pr0); + + intvarC(uslice, in, is, ie, j, 0, steepen, + PPMFlatteningParameter, flatten, c1, c2, c3, c4, c5, c6, char1, + char2, c0, du, ul, ur, u6, ula, ura, ul0, ur0); + + intvarC(vslice, in, is, ie, j, 0, steepen, + PPMFlatteningParameter, flatten, c1, c2, c3, c4, c5, c6, char1, + char2, c0, tmp1, tmp2, tmp3, tmp4, vla, vra, vl0, vr0); + + intvarC(wslice, in, is, ie, j, 0, steepen, + PPMFlatteningParameter, flatten, c1, c2, c3, c4, c5, c6, char1, + char2, c0, tmp1, tmp2, tmp3, tmp4, wla, wra, wl0, wr0); + + if (DualEnergyFormalism) + intvarC(geslice, in, is, ie, j, 0, steepen, + PPMFlatteningParameter, flatten, c1, c2, c3, c4, c5, c6, char1, + char2, c0, tmp1, tmp2, tmp3, tmp4, gela, gera, gel0, ger0); + + for (ic = 0, index = 0, cindex = 0; ic < ncolors; + ic++, index += in*jn, cindex += in) + intvarC(colslice+index, in, is, ie, j, 0, steepen, + PPMFlatteningParameter, flatten, c1, c2, c3, c4, c5, c6, char1, + char2, c0, tmp1, tmp2, tmp3, tmp4, + colla+cindex, colra+cindex, coll0+cindex, colr0+cindex); +// +// +// Correct the initial guess from the linearized gas equations +// +// First, compute averge over characteristic domain of dependance (3.5) +// +// + for (i = is; i <= ie+1; i++) { + plm[i]= pr[i-1]-cm[i-1]*(dp[i-1]-(1.0-ft*cm[i-1])*p6[i-1]); + prm[i]= pl[i ]-cm[i ]*(dp[i ]+(1.0+ft*cm[i ])*p6[i ]); + plp[i]= pr[i-1]-cp[i-1]*(dp[i-1]-(1.0-ft*cp[i-1])*p6[i-1]); + prp[i]= pl[i ]-cp[i ]*(dp[i ]+(1.0+ft*cp[i ])*p6[i ]); + } + + for (i = is; i <= ie+1; i++) { + ulm[i]= ur[i-1]-cm[i-1]*(du[i-1]-(1.0-ft*cm[i-1])*u6[i-1]); + urm[i]= ul[i ]-cm[i ]*(du[i ]+(1.0+ft*cm[i ])*u6[i ]); + ulp[i]= ur[i-1]-cp[i-1]*(du[i-1]-(1.0-ft*cp[i-1])*u6[i-1]); + urp[i]= ul[i ]-cp[i ]*(du[i ]+(1.0+ft*cp[i ])*u6[i ]); + } +// +// Compute correction terms (3.7) +// + for (i = is; i <= ie+1; i++) { + cla[i] = sqrtf(max(Gamma*pla[i]*dla[i], 0.0)); + clainv[i] = 1.0/cla[i]; + cra[i] = sqrtf(max(Gamma*pra[i]*dra[i], 0.0)); + crainv[i] = 1.0/cra[i]; + } +// +// a) left side +// + for (i = is; i <= ie+1; i++) { + betalp[i] = (ula[i]-ulp[i]) + (pla[i]-plp[i])*clainv[i]; + betalm[i] = (ula[i]-ulm[i]) - (pla[i]-plm[i])*clainv[i]; + betal0[i] = (pla[i]-pl0[i])*clainv[i]*clainv[i] + + 1.0/dla[i] - 1.0/dl0[i]; + } +// +// Add gravity component +// + if (gravity) + for (i = is, index = j*in+is; i <= ie+1; i++, index++) { + betalp[i] = betalp[i] - 0.25*dtFixed*(grslice[index-1]+grslice[index]); + betalm[i] = betalm[i] - 0.25*dtFixed*(grslice[index-1]+grslice[index]); + } // ENDFOR i + + for (i = is; i <= ie+1; i++) { + betalp[i] = -betalp[i]*(0.5*clainv[i]); + betalm[i] = +betalm[i]*(0.5*clainv[i]); + } + + for (i = is; i <= ie+1; i++) { + if (cp[i-1] <= 0.0) betalp[i] = 0.0; + if (cm[i-1] <= 0.0) betalm[i] = 0.0; + if (c0[i-1] <= 0.0) betal0[i] = 0.0; + } +// +// b) right side +// + for (i = is; i <= ie+1; i++) { + betarp[i] = (ura[i]-urp[i]) + (pra[i]-prp[i])*crainv[i]; + betarm[i] = (ura[i]-urm[i]) - (pra[i]-prm[i])*crainv[i]; + betar0[i] = (pra[i]-pr0[i])*crainv[i]*crainv[i] + + 1.0/dra[i] - 1.0/dr0[i]; + } + + if (gravity) + for (i = is, index = j*in+is; i <= ie+1; i++, index++) { + betarp[i] = betarp[i] - 0.25*dtFixed*(grslice[index-1]+grslice[index]); + betarm[i] = betarm[i] - 0.25*dtFixed*(grslice[index-1]+grslice[index]); + } + + for (i = is; i <= ie+1; i++) { + betarp[i] = -betarp[i]*(0.5*crainv[i]); + betarm[i] = +betarm[i]*(0.5*crainv[i]); + } + + for (i = is; i <= ie+1; i++) { + if (cp[i] > 0.0) betarp[i] = 0.0; + if (cm[i] > 0.0) betarm[i] = 0.0; + if (c0[i] > 0.0) betar0[i] = 0.0; + } +// +// Finally, combine to create corrected left/right states (eq. 3.6) +// + for (i = is, index = j*in+is; i <= ie+1; i++, index++) { + pls[index] = pla[i] + (betalp[i]+betalm[i])*cla[i]*cla[i]; + prs[index] = pra[i] + (betarp[i]+betarm[i])*cra[i]*cra[i]; + + uls[index] = ula[i] + (betalp[i]-betalm[i])*cla[i]; + urs[index] = ura[i] + (betarp[i]-betarm[i])*cra[i]; + + dls[index] = 1.0/(1.0/dla[i] - (betal0[i]+betalp[i]+betalm[i])); + drs[index] = 1.0/(1.0/dra[i] - (betar0[i]+betarp[i]+betarm[i])); + } // ENDFOR i +// +// Take the appropriate state from the advected variables +// + for (i = is, index = j*in+is; i <= ie+1; i++, index++) { + if (uslice[index-1] <= 0.0) { + vls[index] = vla[i]; + wls[index] = wla[i]; + gels[index] = gela[i]; + } else { + vls[index] = vl0[i]; + wls[index] = wl0[i]; + gels[index] = gel0[i]; + } + + if (uslice[index] >= 0.0) { + vrs[index] = vra[i]; + wrs[index] = wra[i]; + gers[index] = gera[i]; + } else { + vrs[index] = vr0[i]; + wrs[index] = wr0[i]; + gers[index] = ger0[i]; + } + } // ENDFOR i + + for (ic = 0; ic < ncolors; ic++) { + cindex = (jn*ic+j)*in+is; + index = j*in+is; + scindex = ic*in+is; + for (i = is; i <= ie+1; i++, scindex++, cindex++, index++) { + if (uslice[index-1] <= 0.0) + colls[cindex] = colla[scindex]; + else + colls[cindex] = coll0[scindex]; + + if (uslice[index] > 0.0) + colrs[cindex] = colra[scindex]; + else + colrs[cindex] = colr0[scindex]; + } // ENDFOR i + } // ENDFOR ic + +// +// Dual energy formalism: if sound speed squared is less than eta1*v^2 +// then discard the corrections and use pla, ula, dla. This amounts +// to assuming that we are outside the shocked region but the flow is +// hypersonic so this should be true. This is inserted because the +// corrections are inaccurate for hypersonic flows. +// + if (DualEnergyFormalism) + for (i = is, index = j*in+is; i <= ie+1; i++, index++) { + + if (Gamma*pla[i]/dla[i] < DualEnergyFormalismEta2*ula[i]*ula[i] || + max(max(fabsf(cm[i-1]), fabsf(c0[i-1])), fabsf(cp[i-1])) < 1e-3 || + dls[index]/dla[i] > 5.0) { + pls[index] = pla[i]; + uls[index] = ula[i]; + dls[index] = dla[i]; + } + + if (Gamma*pra[i]/dra[i] < DualEnergyFormalismEta2*ura[i]*ura[i] || + max(max(fabs(cm[i]), fabs(c0[i])), fabs(cp[i])) < 1e-3 || + drs[index]/dra[i] > 5.0) { + prs[index] = pra[i]; + urs[index] = ura[i]; + drs[index] = dra[i]; + } + + } // ENDFOR i +// +// Enforce minimum values. +// + for (i = is, index = j*in+is; i <= ie+1; i++, index++) { + pls[index] = max(pls[index], tiny_number); + prs[index] = max(prs[index], tiny_number); + dls[index] = max(dls[index], tiny_number); + drs[index] = max(drs[index], tiny_number); + } +// +// If approximating pressure free conditions, then the density should be +// reset to the pre-corrected state. +// + if (PressureFree) + for (i = is, index = j*in+is; i <= ie+1; i++, index++) { + dls[index] = dla[i]; + drs[index] = dra[i]; + } + + } // ENDFOR j + + return SUCCESS; + +} diff --git a/src/enzo/Grid_xEulerSweep.C b/src/enzo/Grid_xEulerSweep.C index ac8611bc6..ec5a98e36 100644 --- a/src/enzo/Grid_xEulerSweep.C +++ b/src/enzo/Grid_xEulerSweep.C @@ -207,6 +207,7 @@ int grid::xEulerSweep(int k, int NumberOfSubgrids, fluxes *SubgridFluxes[], /* Compute Eulerian left and right states at zone edges via interpolation */ if (ReconstructionMethod == PPM) +#ifndef _OPENMP FORTRAN_NAME(inteuler)(dslice, pslice, &GravityOn, grslice, geslice, uslice, vslice, wslice, CellWidthTemp[0], flatten, &GridDimension[0], &GridDimension[1], @@ -217,6 +218,12 @@ int grid::xEulerSweep(int k, int NumberOfSubgrids, fluxes *SubgridFluxes[], &dtFixed, &Gamma, &PressureFree, dls, drs, pls, prs, gels, gers, uls, urs, vls, vrs, wls, wrs, &NumberOfColours, colslice, colls, colrs); +#else + this->inteuler(dim, dslice, pslice, GravityOn, grslice, geslice, uslice, + vslice, wslice, CellWidthTemp[0], flatten, + dls, drs, pls, prs, gels, gers, uls, urs, vls, vrs, + wls, wrs, NumberOfColours, colslice, colls, colrs); +#endif /* Compute (Lagrangian part of the) Riemann problem at each zone boundary */ diff --git a/src/enzo/Grid_yEulerSweep.C b/src/enzo/Grid_yEulerSweep.C index 24305c442..11c40e635 100644 --- a/src/enzo/Grid_yEulerSweep.C +++ b/src/enzo/Grid_yEulerSweep.C @@ -207,6 +207,7 @@ int grid::yEulerSweep(int i, int NumberOfSubgrids, fluxes *SubgridFluxes[], /* Compute Eulerian left and right states at zone edges via interpolation */ if (ReconstructionMethod == PPM) +#ifndef _OPENMP FORTRAN_NAME(inteuler)(dslice, pslice, &GravityOn, grslice, geslice, uslice, vslice, wslice, CellWidthTemp[1], flatten, &GridDimension[1], &GridDimension[2], @@ -217,6 +218,12 @@ int grid::yEulerSweep(int i, int NumberOfSubgrids, fluxes *SubgridFluxes[], &dtFixed, &Gamma, &PressureFree, dls, drs, pls, prs, gels, gers, uls, urs, vls, vrs, wls, wrs, &NumberOfColours, colslice, colls, colrs); +#else + this->inteuler(dim, dslice, pslice, GravityOn, grslice, geslice, uslice, + vslice, wslice, CellWidthTemp[1], flatten, + dls, drs, pls, prs, gels, gers, uls, urs, vls, vrs, + wls, wrs, NumberOfColours, colslice, colls, colrs); +#endif /* Compute (Lagrangian part of the) Riemann problem at each zone boundary */ diff --git a/src/enzo/Grid_zEulerSweep.C b/src/enzo/Grid_zEulerSweep.C index 2a51a3e9b..861d34439 100644 --- a/src/enzo/Grid_zEulerSweep.C +++ b/src/enzo/Grid_zEulerSweep.C @@ -204,6 +204,7 @@ int grid::zEulerSweep(int j, int NumberOfSubgrids, fluxes *SubgridFluxes[], /* Compute Eulerian left and right states at zone edges via interpolation */ if (ReconstructionMethod == PPM) +#ifndef _OPENMP FORTRAN_NAME(inteuler)(dslice, pslice, &GravityOn, grslice, geslice, uslice, vslice, wslice, CellWidthTemp[2], flatten, &GridDimension[2], &GridDimension[0], @@ -214,6 +215,12 @@ int grid::zEulerSweep(int j, int NumberOfSubgrids, fluxes *SubgridFluxes[], &dtFixed, &Gamma, &PressureFree, dls, drs, pls, prs, gels, gers, uls, urs, vls, vrs, wls, wrs, &NumberOfColours, colslice, colls, colrs); +#else + this->inteuler(dim, dslice, pslice, GravityOn, grslice, geslice, uslice, + vslice, wslice, CellWidthTemp[2], flatten, + dls, drs, pls, prs, gels, gers, uls, urs, vls, vrs, + wls, wrs, NumberOfColours, colslice, colls, colrs); +#endif /* Compute (Lagrangian part of the) Riemann problem at each zone boundary */ diff --git a/src/enzo/IdentifyNewSubgridsBySignature.C b/src/enzo/IdentifyNewSubgridsBySignature.C index 346cb8a11..8813cfe04 100644 --- a/src/enzo/IdentifyNewSubgridsBySignature.C +++ b/src/enzo/IdentifyNewSubgridsBySignature.C @@ -26,18 +26,18 @@ /* function prototypes */ -static int GridEnds[MAX_NUMBER_OF_SUBGRIDS][2]; - int IdentifyNewSubgridsBySignature(ProtoSubgrid *SubgridList[], int &NumberOfSubgrids) { int dim, i, j, NumberOfNewGrids; ProtoSubgrid *NewSubgrid, *Subgrid; + int (*GridEnds)[2] = new int[MAX_NUMBER_OF_SUBGRIDS][2]; /* Loop over all the grids in the queue SubgridList. */ - + if ( NumberOfSubgrids > MAX_NUMBER_OF_SUBGRIDS ) { + delete [] GridEnds; ENZO_VFAIL("PE %"ISYM" NumberOfSubgrids > MAX_NUMBER_OF_SUBGRIDS in IdentifyNewSubgridsBySignature\n", MyProcessorNumber) } @@ -198,11 +198,10 @@ int IdentifyNewSubgridsBySignature(ProtoSubgrid *SubgridList[], Subgrid->CleanUp(); - /* Go to the next grid in the queue. */ - index++; } // end: while (index < NumberOfSubgrids) + delete [] GridEnds; return SUCCESS; } diff --git a/src/enzo/LinkedListRoutines.C b/src/enzo/LinkedListRoutines.C index 798eb657a..fc1e33e13 100644 --- a/src/enzo/LinkedListRoutines.C +++ b/src/enzo/LinkedListRoutines.C @@ -10,9 +10,39 @@ #include "GridList.h" #include "Grid.h" -void InsertPhotonAfter(PhotonPackageEntry * &Node, PhotonPackageEntry * &NewNode) +void MergePhotonLists(PhotonPackageEntry * &Node1, PhotonPackageEntry * &Node2) { + // Find the end of list 2 (list 1 should be the main list) + PhotonPackageEntry *Tail2 = Node2; + while (Tail2->NextPackage != NULL) + Tail2 = Tail2->NextPackage; + // Now we can link them together + Node2->PreviousPackage = Node1; // head2 back to node1 + Tail2->NextPackage = Node1->NextPackage; // tail2 to node1->next + // tail1 back to tail2 + if (Node1->NextPackage != NULL) + Node1->NextPackage->PreviousPackage = Tail2; + Node1->NextPackage = Node2; + //Tail2->NextPackage = Node2; + //Node2->PreviousPackage = Tail2; + return; +} +void MergePhotonMoveLists(ListOfPhotonsToMove * &Node1, + ListOfPhotonsToMove * &Node2) +{ + // Find the end of list 2 (list 1 should be the main list) + ListOfPhotonsToMove *Temp = Node2; + while (Temp->NextPackageToMove != NULL) + Temp = Temp->NextPackageToMove; + // Now we can link them together (tail to head) + Temp->NextPackageToMove = Node1->NextPackageToMove; + Node1->NextPackageToMove = Node2; + return; +} + +void InsertPhotonAfter(PhotonPackageEntry * &Node, PhotonPackageEntry * &NewNode) +{ NewNode->PreviousPackage = Node; NewNode->NextPackage = Node->NextPackage; if (Node->NextPackage != NULL) diff --git a/src/enzo/LoadBalanceHilbertCurve.C b/src/enzo/LoadBalanceHilbertCurve.C index 7256b90ff..45996b0ab 100644 --- a/src/enzo/LoadBalanceHilbertCurve.C +++ b/src/enzo/LoadBalanceHilbertCurve.C @@ -37,6 +37,9 @@ double HilbertCurve3D(FLOAT *coord); Eint32 compare_hkey(const void *a, const void *b); +int CommunicationBroadcastValues(Eint32 *Values, int Number, int BroadcastProcessor); +int CommunicationBroadcastValues(Eint64 *Values, int Number, int BroadcastProcessor); +int CommunicationBufferPurge(void); int CommunicationReceiveHandler(fluxes **SubgridFluxesEstimate[] = NULL, int NumberOfSubgrids[] = NULL, int FluxFlag = FALSE, @@ -44,9 +47,11 @@ int CommunicationReceiveHandler(fluxes **SubgridFluxesEstimate[] = NULL, double ReturnWallTime(void); void fpcol(float *x, int n, int m, FILE *fptr); +#define ALPHA_FADE 0.1 #define FUZZY_BOUNDARY 0.1 #define FUZZY_ITERATIONS 10 -#define NO_SYNC_TIMING +#define SYNC_TIMING +#define GRIDS_PER_LOOP 10000 int LoadBalanceHilbertCurve(HierarchyEntry *GridHierarchyPointer[], int NumberOfGrids, int MoveParticles) @@ -57,19 +62,18 @@ int LoadBalanceHilbertCurve(HierarchyEntry *GridHierarchyPointer[], /* Initialize */ - int *GridWork = new int[NumberOfGrids]; + float *GridWork = new float[NumberOfGrids]; int *NewProcessorNumber = new int[NumberOfGrids]; hilbert_data *HilbertData = new hilbert_data[NumberOfGrids]; - int *BlockDivisions = new int[NumberOfProcessors]; - int *ProcessorWork = new int[NumberOfProcessors]; - int TotalWork, WorkThisProcessor, WorkPerProcessor, WorkLeft; + float TotalWork, WorkThisProcessor, WorkPerProcessor, WorkLeft; int i, dim, grid_num, Rank, block_num, Dims[MAX_DIMENSION]; FLOAT GridCenter[MAX_DIMENSION]; FLOAT LeftEdge[MAX_DIMENSION], RightEdge[MAX_DIMENSION]; FLOAT BoundingBox[2][MAX_DIMENSION]; FLOAT BoundingBoxWidthInv[MAX_DIMENSION]; float GridVolume, AxialRatio; + float ObservedCost, EstimatedCost, NewEstimatedCost, ErrorCost; int GridMemory, NumberOfCells, CellsTotal, NumberOfParticles; int iter; @@ -118,18 +122,61 @@ int LoadBalanceHilbertCurve(HierarchyEntry *GridHierarchyPointer[], } // ENDFOR grids /* Sort the grids along the curve and partition it into pieces with - equal amounts of work. */ + equal amounts of work. Only the host processor knows about the + work. */ //qsort(HilbertData, NumberOfGrids, sizeof(hilbert_data), compare_hkey); std::sort(HilbertData, HilbertData+NumberOfGrids, cmp_hkey()); - TotalWork = 0; for (i = 0; i < NumberOfGrids; i++) { - GridHierarchyPointer[HilbertData[i].grid_num]->GridData-> - CollectGridInformation(GridMemory, GridVolume, NumberOfCells, - AxialRatio, CellsTotal, NumberOfParticles); - GridWork[i] = CellsTotal; - TotalWork += CellsTotal; + grid_num = HilbertData[i].grid_num; + if (MyProcessorNumber == GridHierarchyPointer[grid_num]->GridData->ReturnProcessorNumber()) { + ObservedCost = GridHierarchyPointer[grid_num]->GridData->ReturnCost(0); + EstimatedCost = GridHierarchyPointer[grid_num]->GridData->ReturnEstimatedCost(0); + + // First timestep (use # of cells) + if (ObservedCost < 0 && EstimatedCost < 0) { + NewEstimatedCost = GridHierarchyPointer[grid_num]->GridData->GetGridSize(); + GridHierarchyPointer[grid_num]->GridData->SetEstimatedCost(FLOAT_UNDEFINED,0); + } + // Second timestep (first with timing data) + else if (ObservedCost > 0 && EstimatedCost < 0) { + NewEstimatedCost = ObservedCost; + GridHierarchyPointer[grid_num]->GridData->SetEstimatedCost(NewEstimatedCost,0); + } + // All later timesteps (fading memory filter) + else { + NewEstimatedCost = ALPHA_FADE * (ObservedCost - EstimatedCost) + EstimatedCost; + GridHierarchyPointer[grid_num]->GridData->SetEstimatedCost(NewEstimatedCost,0); + } + +// if (grid_num == 0) +// printf("P%d/G%d: %g %g %g\n", MyProcessorNumber, grid_num, ObservedCost, +// EstimatedCost, NewEstimatedCost); + GridWork[i] = NewEstimatedCost; + } else { + GridWork[i] = 0.0; + } } + CommunicationSumValues(GridWork, NumberOfGrids); + + if (MyProcessorNumber == ROOT_PROCESSOR) { + + int *BlockDivisions = new int[NumberOfProcessors]; + float *ProcessorWork = new float[NumberOfProcessors]; + + TotalWork = 0; + for (i = 0; i < NumberOfGrids; i++) + TotalWork += GridWork[i]; + +#ifdef UNUSED + if (debug) { + for (i = 0; i < NumberOfGrids; i++) { + printf("%10.4g", GridWork[i]); + if (i % 8 == 0 || i == NumberOfGrids-1) printf("\n"); + } + printf("Total work = %g\n", TotalWork); + } +#endif /* Partition into nearly equal workloads */ @@ -138,7 +185,7 @@ int LoadBalanceHilbertCurve(HierarchyEntry *GridHierarchyPointer[], for (i = 0; i < NumberOfProcessors-1; i++) { WorkThisProcessor = 0; WorkPerProcessor = WorkLeft / (NumberOfProcessors-i); - while (WorkThisProcessor < WorkPerProcessor) { + while (WorkThisProcessor < WorkPerProcessor && grid_num < NumberOfGrids-1) { WorkThisProcessor += GridWork[grid_num]; grid_num++; } // ENDWHILE @@ -163,12 +210,14 @@ int LoadBalanceHilbertCurve(HierarchyEntry *GridHierarchyPointer[], BlockDivisions[i] = NumberOfGrids-1; ProcessorWork[i] = WorkLeft; -// if (debug) { -// printf("BlockDivisions = "); -// for (i = 0; i < NumberOfProcessors; i++) -// printf("%d ", BlockDivisions[i]); -// printf("\n"); -// } +#ifdef UNUSED + if (debug) { + printf("BlockDivisions = "); + for (i = 0; i < NumberOfProcessors; i++) + printf("%d ", BlockDivisions[i]); + printf("\n"); + } +#endif /* Mark the new processor numbers with the above divisions. */ @@ -189,12 +238,11 @@ int LoadBalanceHilbertCurve(HierarchyEntry *GridHierarchyPointer[], double div_hkey, min_hkey, max_hkey, global_min_hkey; double hkey_boundary; char direction; - int LoadedBlock, UnloadedBlock, WorkDifference; - int MinWork, MaxWork; - float WorkImbalance; + int LoadedBlock, UnloadedBlock; + float WorkDifference, MinWork, MaxWork, WorkImbalance; for (iter = 0; iter < FUZZY_ITERATIONS; iter++) { - MinWork = 0x7FFFFFFF; + MinWork = 1e20; MaxWork = -1; for (i = 0; i < NumberOfProcessors-1; i++) { @@ -237,7 +285,7 @@ int LoadBalanceHilbertCurve(HierarchyEntry *GridHierarchyPointer[], if (2*GridWork[grid_num] < WorkDifference && NewProcessorNumber[HilbertData[grid_num].grid_num] == LoadedBlock) { // if (debug) -// printf("Moving grid %d (work=%d) from P%d -> P%d\n", +// printf("Moving grid %d (work=%g) from P%d -> P%d\n", // grid_num, GridWork[grid_num], LoadedBlock, UnloadedBlock); ProcessorWork[LoadedBlock] -= GridWork[grid_num]; ProcessorWork[UnloadedBlock] += GridWork[grid_num]; @@ -274,54 +322,129 @@ int LoadBalanceHilbertCurve(HierarchyEntry *GridHierarchyPointer[], /* Intermediate cleanup */ - delete [] GridWork; - delete [] HilbertData; delete [] ProcessorWork; delete [] BlockDivisions; + } // ENDIF ROOT processor + + delete [] HilbertData; + delete [] GridWork; + + /* Broadcast the new processor numbers to the other processors */ + + CommunicationBroadcastValues(NewProcessorNumber, NumberOfGrids, + ROOT_PROCESSOR); + /* Now we know where the grids are going, move them! */ int GridsMoved = 0; + int StartGrid = 0, EndGrid = 1; + int nGrids; + + while (StartGrid < NumberOfGrids) { + + nGrids = 0; + i = StartGrid; + while (nGrids < GRIDS_PER_LOOP && i < NumberOfGrids) { + if (GridHierarchyPointer[i]->GridData->ReturnProcessorNumber() != + NewProcessorNumber[i]) + nGrids++; + i++; + } + EndGrid = i; - /* Post receives */ + if (nGrids == 0) break; - CommunicationReceiveIndex = 0; - CommunicationReceiveCurrentDependsOn = COMMUNICATION_NO_DEPENDENCE; - CommunicationDirection = COMMUNICATION_POST_RECEIVE; + /* Split into two stages: fields then particles+ */ - for (i = 0; i < NumberOfGrids; i++) - if (GridHierarchyPointer[i]->GridData->ReturnProcessorNumber() != - NewProcessorNumber[i]) { - GridHierarchyPointer[i]->GridData-> - CommunicationMoveGrid(NewProcessorNumber[i], MoveParticles); - GridsMoved++; - } + /************************************************/ + /******************** FIELDS ********************/ + /************************************************/ - /* Send grids */ + /* Post receives */ - CommunicationDirection = COMMUNICATION_SEND; + CommunicationReceiveIndex = 0; + CommunicationReceiveCurrentDependsOn = COMMUNICATION_NO_DEPENDENCE; + CommunicationDirection = COMMUNICATION_POST_RECEIVE; - for (i = 0; i < NumberOfGrids; i++) - if (GridHierarchyPointer[i]->GridData->ReturnProcessorNumber() != - NewProcessorNumber[i]) { + for (i = StartGrid; i < EndGrid; i++) + if (GridHierarchyPointer[i]->GridData->ReturnProcessorNumber() != + NewProcessorNumber[i]) { + GridHierarchyPointer[i]->GridData-> + CommunicationMoveGrid1(NewProcessorNumber[i]); + GridsMoved++; + } + + /* Send grids */ + + CommunicationDirection = COMMUNICATION_SEND; + + for (i = StartGrid; i < EndGrid; i++) + if (GridHierarchyPointer[i]->GridData->ReturnProcessorNumber() != + NewProcessorNumber[i]) { + if (RandomForcing) //AK + GridHierarchyPointer[i]->GridData->AppendForcingToBaryonFields(); + GridHierarchyPointer[i]->GridData-> + CommunicationMoveGrid1(NewProcessorNumber[i]); + } + + /* Receive grids */ + + CommunicationReceiveHandler(); + CommunicationBufferPurge(); + + if (debug && GridsMoved > 0) { + tt1 = ReturnWallTime(); + printf("LoadBalance[fields]: Number of grids moved = %"ISYM" out of %"ISYM" " + "(%lg seconds elapsed)\n", GridsMoved, NumberOfGrids, tt1-tt0); + } + + /****************************************************/ + /******************** PARTICLES+ ********************/ + /****************************************************/ + + /* Post receives */ + + CommunicationReceiveIndex = 0; + CommunicationReceiveCurrentDependsOn = COMMUNICATION_NO_DEPENDENCE; + CommunicationDirection = COMMUNICATION_POST_RECEIVE; + + for (i = StartGrid; i < EndGrid; i++) + if (GridHierarchyPointer[i]->GridData->ReturnProcessorNumber() != + NewProcessorNumber[i]) { + GridHierarchyPointer[i]->GridData-> + CommunicationMoveGrid2(NewProcessorNumber[i], MoveParticles); + } + + /* Send grids */ + + CommunicationDirection = COMMUNICATION_SEND; + + for (i = StartGrid; i < EndGrid; i++) + if (GridHierarchyPointer[i]->GridData->ReturnProcessorNumber() != + NewProcessorNumber[i]) { + if (RandomForcing) //AK + GridHierarchyPointer[i]->GridData->AppendForcingToBaryonFields(); + GridHierarchyPointer[i]->GridData-> + CommunicationMoveGrid2(NewProcessorNumber[i], MoveParticles); + } + + /* Receive grids */ + + CommunicationReceiveHandler(); + CommunicationBufferPurge(); + + /* Update processor numbers */ + + for (i = StartGrid; i < EndGrid; i++) { + GridHierarchyPointer[i]->GridData->SetProcessorNumber(NewProcessorNumber[i]); if (RandomForcing) //AK - GridHierarchyPointer[i]->GridData->AppendForcingToBaryonFields(); - GridHierarchyPointer[i]->GridData-> - CommunicationMoveGrid(NewProcessorNumber[i], MoveParticles); + GridHierarchyPointer[i]->GridData->RemoveForcingFromBaryonFields(); } - /* Receive grids */ + StartGrid = EndGrid; - if (CommunicationReceiveHandler() == FAIL) - ENZO_FAIL("CommunicationReceiveHandler() failed!\n"); - - /* Update processor numbers */ - - for (i = 0; i < NumberOfGrids; i++) { - GridHierarchyPointer[i]->GridData->SetProcessorNumber(NewProcessorNumber[i]); - if (RandomForcing) //AK - GridHierarchyPointer[i]->GridData->RemoveForcingFromBaryonFields(); - } + } // ENDWHILE #ifdef SYNC_TIMING CommunicationBarrier(); diff --git a/src/enzo/Make.config.assemble b/src/enzo/Make.config.assemble index 5ee18e313..aa95434e6 100644 --- a/src/enzo/Make.config.assemble +++ b/src/enzo/Make.config.assemble @@ -264,6 +264,42 @@ $(error Illegal value '$(CONFIG_USE_MPI)' for $$(CONFIG_USE_MPI)) endif +#======================================================================= +# DETERMINE OPENMP USAGE +#======================================================================= + + ERROR_OPENMP = 1 + + ifeq ($(CONFIG_OPENMP),yes) + ifeq ($(strip $(MACH_OPENMP)),) + ERROR_OPENMP = 2 + else + ERROR_OPENMP = 0 + ASSEMBLE_OPENMP = $(MACH_OPENMP) + endif + endif + + # Settings for not using OPENMP mods + + ifeq ($(CONFIG_OPENMP),no) + ERROR_OPENMP = 0 + ASSEMBLE_OPENMP = + endif + + # error if CONFIG_OPENMP is incorrect + + ifeq ($(ERROR_OPENMP),1) + .PHONY: error_openmp + error_openmp: + $(error Illegal value '$(CONFIG_OPENMP)' for $$(CONFIG_OPENMP)) + endif + + ifeq ($(ERROR_OPENMP),2) + .PHONY: error_openmp2 + error_openmp2: + $(error MACH_OPENMP undefined with openmp-yes) + endif + #----------------------------------------------------------------------- # Determine CUDA compiler #----------------------------------------------------------------------- @@ -1058,27 +1094,33 @@ FC = $(ASSEMBLE_FC) F90 = $(ASSEMBLE_F90) LD = $(ASSEMBLE_LD) + OMP = $(ASSEMBLE_OPENMP) CUDACOMPILER = $(ASSEMBLE_CUDACOMPILER) CUDACOMPFLAGS = $(ASSEMBLE_CUDAFLAGS) CPPFLAGS = $(MACH_CPPFLAGS) CFLAGS = $(MACH_CFLAGS) \ - $(ASSEMBLE_OPT_FLAGS) + $(ASSEMBLE_OPT_FLAGS) \ + $(ASSEMBLE_OPENMP) CXXFLAGS = $(MACH_CXXFLAGS) \ - $(ASSEMBLE_OPT_FLAGS) + $(ASSEMBLE_OPT_FLAGS) \ + $(ASSEMBLE_OPENMP) FFLAGS = $(MACH_FFLAGS) \ - $(ASSEMBLE_OPT_FLAGS) + $(ASSEMBLE_OPT_FLAGS) \ + $(ASSEMBLE_OPENMP) F90FLAGS = $(MACH_F90FLAGS) \ - $(ASSEMBLE_OPT_FLAGS) + $(ASSEMBLE_OPT_FLAGS) \ + $(ASSEMBLE_OPENMP) LDFLAGS = $(MACH_LDFLAGS) \ - $(ASSEMBLE_OPT_FLAGS) + $(ASSEMBLE_OPT_FLAGS) \ + $(ASSEMBLE_OPENMP) DEFINES = $(MACH_DEFINES) \ $(MAKEFILE_DEFINES) \ $(ASSEMBLE_PARAMETER_DEFINES) \ $(ASSEMBLE_INITS_DEFINES) \ $(ASSEMBLE_INTEGER_DEFINES) \ - $(ASSEMBLE_IDS_DEFINES) \ + $(ASSEMBLE_IDS_DEFINES) \ $(ASSEMBLE_IO_DEFINES) \ $(ASSEMBLE_LCAPERF_DEFINES) \ $(ASSEMBLE_PYTHON_DEFINES) \ diff --git a/src/enzo/Make.config.objects b/src/enzo/Make.config.objects index 360d370de..555aaaa19 100644 --- a/src/enzo/Make.config.objects +++ b/src/enzo/Make.config.objects @@ -396,6 +396,8 @@ OBJS_CONFIG_LIB = \ Grid_CollectParticleMassFlaggingField.o \ Grid_CollectStars.o \ Grid_CommunicationMoveGrid.o \ + Grid_CommunicationMoveGrid1.o \ + Grid_CommunicationMoveGrid2.o \ Grid_CommunicationReceiveRegion.o \ Grid_CommunicationSendActiveParticles.o \ Grid_CommunicationSendParticles.o \ @@ -548,6 +550,7 @@ OBJS_CONFIG_LIB = \ Grid_InitializeGravitatingMassField.o \ Grid_InitializeGravitatingMassFieldParticles.o \ Grid_InitializeUniformGrid.o \ + Grid_inteuler.o \ Grid_InterpolateAccelerations.o \ Grid_InterpolateBoundaryFromParent.o \ Grid_InterpolateFieldValues.o \ @@ -735,6 +738,7 @@ OBJS_CONFIG_LIB = \ intpos.o \ intprim.o \ intvar.o \ + intvarC.o \ Isdigit.o \ KHInitialize.o \ LevelHierarchy_AddLevel.o \ @@ -833,6 +837,7 @@ OBJS_CONFIG_LIB = \ RadiationFieldCalculateRates.o \ RadiationFieldLymanWernerTable.o \ RadiationFieldUpdate.o \ + rate_cool_routines.o \ ReadAllData.o \ ReadAttr.o \ ReadEvolveRefineFile.o \ @@ -1078,6 +1083,8 @@ POBJS_CONFIG_LIB = \ Grid_AddH2DissociationFromTree.o \ Grid_AddRadiationImpulse.o \ Grid_AddRadiationPressureAcceleration.o \ + Grid_AddXraysFromSources.o \ + Grid_AddXraysFromTree.o \ Grid_AllocateInterpolatedRadiation.o \ Grid_CheckSubgridMarker.o \ Grid_CommunicationSendPhotonPackages.o \ @@ -1112,6 +1119,7 @@ POBJS_CONFIG_LIB = \ Grid_SetSubgridMarkerFromParent.o \ Grid_SetSubgridMarkerFromSibling.o \ Grid_SetSubgridMarkerFromSubgrid.o \ + Grid_SetSubgridMarkerIsolatedBoundaries.o \ Grid_SubgridMarkerPostParallel.o \ Grid_Shine.o \ Grid_TestRadiatingStarParticleInitializeGrid.o \ diff --git a/src/enzo/Make.config.settings b/src/enzo/Make.config.settings index 4a8c0cfea..3e9cc7c5c 100644 --- a/src/enzo/Make.config.settings +++ b/src/enzo/Make.config.settings @@ -19,6 +19,8 @@ # CONFIG_INITS # CONFIG_IO # CONFIG_USE_MPI +# CONFIG_USE_OPENMP +# CONFIG_OBJECT_MODE # CONFIG_TASKMAP # CONFIG_PACKED_AMR # CONFIG_PACKED_MEM @@ -119,6 +121,25 @@ CONFIG_USE_MPI = yes +#======================================================================= +# CONFIG_OPENMP +#======================================================================= +# yes compile with OpenMP +# no don't compile with OpenMP +#----------------------------------------------------------------------- + + CONFIG_OPENMP = no + +#======================================================================= +#======================================================================= +# CONFIG_OBJECT_MODE +#======================================================================= +# 32 compile using 32-bit object format +# 64 compile using 64-bit object format +#----------------------------------------------------------------------- + + CONFIG_OBJECT_MODE = 64 + #======================================================================= # CONFIG_TASKMAP #======================================================================= diff --git a/src/enzo/Make.config.targets b/src/enzo/Make.config.targets index 3119b8bd4..6002fa9c1 100644 --- a/src/enzo/Make.config.targets +++ b/src/enzo/Make.config.targets @@ -75,6 +75,16 @@ help-config: @echo " gmake use-mpi-yes" @echo " gmake use-mpi-no" @echo + @echo " Set whether to use OpenMP" + @echo + @echo " gmake openmp-yes" + @echo " gmake openmp-no" + @echo + @echo " Set address/pointer size" + @echo + @echo " gmake object-mode-32" + @echo " gmake object-mode-64" + @echo @echo " Set whether to use unigrid taskmap performance mod" @echo @echo " gmake taskmap-yes" @@ -228,6 +238,7 @@ show-flags: @echo "FC = `which $(FC)`" @echo "F90 = `which $(F90)`" @echo "LD = `which $(LD)`" + @echo "OMP = $(OMP)" @echo "" @echo "DEFINES = $(DEFINES)" @echo "" @@ -262,6 +273,8 @@ show-config: @echo " CONFIG_INITS [inits-{32,64}] : $(CONFIG_INITS)" @echo " CONFIG_IO [io-{32,64}] : $(CONFIG_IO)" @echo " CONFIG_USE_MPI [use-mpi-{yes,no}] : $(CONFIG_USE_MPI)" + @echo " CONFIG_OPENMP [openmp-{yes,no}] : $(CONFIG_OPENMP)" + @echo " CONFIG_OBJECT_MODE [object-mode-{32,64}] : $(CONFIG_OBJECT_MODE)" @echo " CONFIG_TASKMAP [taskmap-{yes,no}] : $(CONFIG_TASKMAP)" @echo " CONFIG_PACKED_AMR [packed-amr-{yes,no}] : $(CONFIG_PACKED_AMR)" @echo " CONFIG_PACKED_MEM [packed-mem-{yes,no}] : $(CONFIG_PACKED_MEM)" @@ -540,6 +553,22 @@ CONFIG_USE-MPI-%: suggest-clean $(MAKE) show-config | grep CONFIG_USE_MPI; \ echo +#----------------------------------------------------------------------- +VALID_OPENMP = openmp-yes openmp-no +.PHONY: $(VALID_OPENMP) + +openmp-yes: CONFIG_OPENMP-yes +openmp-no: CONFIG_OPENMP-no +use-mpi-%: + @printf "\n\tInvalid target: $@\n\n\tValid targets: [$(VALID_OPENMP)]\n\n" +CONFIG_OPENMP-%: suggest-clean + @tmp=.config.temp; \ + grep -v CONFIG_OPENMP $(MAKE_CONFIG_OVERRIDE) > $${tmp}; \ + mv $${tmp} $(MAKE_CONFIG_OVERRIDE); \ + echo "CONFIG_OPENMP = $*" >> $(MAKE_CONFIG_OVERRIDE); \ + $(MAKE) show-config | grep CONFIG_OPENMP; \ + echo + #----------------------------------------------------------------------- VALID_TASKMAP = taskmap-yes taskmap-no diff --git a/src/enzo/Make.mach.linux-gnu b/src/enzo/Make.mach.linux-gnu index da7111bd6..db7e431e2 100644 --- a/src/enzo/Make.mach.linux-gnu +++ b/src/enzo/Make.mach.linux-gnu @@ -63,6 +63,9 @@ MACH_FC_NOMPI = gfortran # Fortran 77 compiler when not using MPI MACH_F90_NOMPI = gfortran # Fortran 90 compiler when not using MPI MACH_LD_NOMPI = g++ # Linker when not using MPI +# OpenMP compiler flag +MACH_OPENMP = -fopenmp + #----------------------------------------------------------------------- # Machine-dependent defines #----------------------------------------------------------------------- diff --git a/src/enzo/Make.mach.ncsa-bluewaters-gnu b/src/enzo/Make.mach.ncsa-bluewaters-gnu index 622b3c144..427ae589d 100644 --- a/src/enzo/Make.mach.ncsa-bluewaters-gnu +++ b/src/enzo/Make.mach.ncsa-bluewaters-gnu @@ -67,9 +67,10 @@ MACH_DEFINES = -DNO_IO_LOG -DSYSCALL -DH5_USE_16_API -DLINUX MACH_CPPFLAGS = -P -traditional MACH_CFLAGS = MACH_CXXFLAGS = -MACH_FFLAGS = -fno-second-underscore -m64 +MACH_FFLAGS = -fno-second-underscore -m64 -ffixed-line-length-132 MACH_F90FLAGS = -fno-second-underscore -m64 MACH_LDFLAGS = -Bstatic +MACH_OPENMP = -fopenmp #----------------------------------------------------------------------- # Optimization flags diff --git a/src/enzo/Make.mach.ncsa-bw-cce b/src/enzo/Make.mach.ncsa-bw-cce new file mode 100644 index 000000000..ef97e9392 --- /dev/null +++ b/src/enzo/Make.mach.ncsa-bw-cce @@ -0,0 +1,121 @@ +#======================================================================= +# +# FILE: Make.mach.ornl-jaguar +# +# DESCRIPTION: Makefile settings for ORNL's Jaguar Cray XT +# +# AUTHOR: James Bordner/Robert Harkness/Alexei Kritsuk +# (updated by Michael Kuhlen on 2010-07-02) +# +# DATE: 2008-04-14 +# +#======================================================================= + +MACH_TEXT = NCSA Blue Waters +MACH_FILE = Make.mach.ncsa-bw-cce + +MACHINE_NOTES = "MACHINE_NOTES for Jaguar at ORNL \\n\ + Load the following modules in addition to the system default ones: \\n\ + 1) 'hdf5'" \\n\ + + +#----------------------------------------------------------------------- +# Commands to run test executables +#----------------------------------------------------------------------- + + +#----------------------------------------------------------------------- +# Install paths (local variables) +#----------------------------------------------------------------------- + +LOCAL_MPI_INSTALL = +LOCAL_HDF5_INSTALL = ${HDF5_DIR} + +LOCAL_HDF4_INSTALL = +LOCAL_HYPRE_INSTALL = ${HOME}/Software/HYPRE/hypre-2.8.0b/src/cce + +#----------------------------------------------------------------------- +# Compiler settings +#----------------------------------------------------------------------- + +MACH_CPP = /usr/bin/cpp + +# With MPI + +MACH_CC_MPI = cc +MACH_CXX_MPI = CC +MACH_FC_MPI = ftn +MACH_F90_MPI = ftn +MACH_LD_MPI = CC + +# Without MPI + +MACH_CC_NOMPI = cc +MACH_CXX_NOMPI = CC +MACH_FC_NOMPI = ftn +MACH_F90_NOMPI = ftn +MACH_LD_NOMPI = CC + +#----------------------------------------------------------------------- +# Machine-dependent defines +#----------------------------------------------------------------------- + +MACH_DEFINES = -DXT3 -DSYSCALL -DH5_USE_16_API + +#----------------------------------------------------------------------- +# Compiler flag settings +#----------------------------------------------------------------------- + +MACH_CPPFLAGS = -P -traditional +MACH_CFLAGS = -hnoomp +MACH_CXXFLAGS = -hnoomp +MACH_FFLAGS = -hnoomp +MACH_F90FLAGS = -hnoomp +MACH_LDFLAGS = -Wl,-static + +#----------------------------------------------------------------------- +# Precision-related flags +#----------------------------------------------------------------------- + +MACH_FFLAGS_INTEGER_32 = -s integer32 +MACH_FFLAGS_INTEGER_64 = -s integer64 +MACH_FFLAGS_REAL_32 = -s real32 +MACH_FFLAGS_REAL_64 = -s real64 + +#----------------------------------------------------------------------- +# Optimization flags +#----------------------------------------------------------------------- + +MACH_OPT_WARN = +MACH_OPT_DEBUG = -g +MACH_OPT_HIGH = -O2 +MACH_OPT_AGGRESSIVE = -O3 + + +#----------------------------------------------------------------------- +# Includes +#----------------------------------------------------------------------- + +LOCAL_INCLUDES_MPI = +LOCAL_INCLUDES_HDF5 = -I$(LOCAL_HDF5_INSTALL)/include +LOCAL_INCLUDES_HYPRE = -I$(LOCAL_HYPRE_INSTALL)/include + +MACH_INCLUDES = $(LOCAL_INCLUDES_HDF5) + +MACH_INCLUDES_MPI = $(LOCAL_INCLUDES_MPI) +MACH_INCLUDES_HYPRE = $(LOCAL_INCLUDES_HYPRE) + +#----------------------------------------------------------------------- +# Libraries +#----------------------------------------------------------------------- +# + +LOCAL_LIBS_MPI = +LOCAL_LIBS_HDF5 = -L$(LOCAL_HDF5_INSTALL)/lib -lhdf5 +LOCAL_LIBS_HDF4 = +LOCAL_LIBS_HYPRE = -L$(LOCAL_HYPRE_INSTALL)/lib -lHYPRE + +MACH_LIBS = -lacml $(LOCAL_LIBS_HDF5) + +MACH_LIBS_MPI = $(LOCAL_LIBS_MPI) +MACH_LIBS_HYPRE = $(LOCAL_LIBS_HYPRE) diff --git a/src/enzo/Make.mach.ncsa-bw-pgi b/src/enzo/Make.mach.ncsa-bw-pgi new file mode 100644 index 000000000..175589f06 --- /dev/null +++ b/src/enzo/Make.mach.ncsa-bw-pgi @@ -0,0 +1,121 @@ +#======================================================================= +# +# FILE: Make.mach.ornl-jaguar +# +# DESCRIPTION: Makefile settings for ORNL's Jaguar Cray XT +# +# AUTHOR: James Bordner/Robert Harkness/Alexei Kritsuk +# (updated by Michael Kuhlen on 2010-07-02) +# +# DATE: 2008-04-14 +# +#======================================================================= + +MACH_TEXT = NCSA Blue Waters +MACH_FILE = Make.mach.ncsa-bw-pgi + +MACHINE_NOTES = "MACHINE_NOTES for Jaguar at ORNL \\n\ + Load the following modules in addition to the system default ones: \\n\ + 1) 'hdf5'" \\n\ + + +#----------------------------------------------------------------------- +# Commands to run test executables +#----------------------------------------------------------------------- + + +#----------------------------------------------------------------------- +# Install paths (local variables) +#----------------------------------------------------------------------- + +LOCAL_MPI_INSTALL = +LOCAL_HDF5_INSTALL = ${HDF5_DIR} + +LOCAL_HDF4_INSTALL = +LOCAL_HYPRE_INSTALL = ${HOME}/Software/HYPRE/hypre-2.8.0b/src/pgi + +#----------------------------------------------------------------------- +# Compiler settings +#----------------------------------------------------------------------- + +MACH_CPP = /usr/bin/cpp + +# With MPI + +MACH_CC_MPI = cc +MACH_CXX_MPI = CC +MACH_FC_MPI = ftn +MACH_F90_MPI = ftn +MACH_LD_MPI = CC + +# Without MPI + +MACH_CC_NOMPI = cc +MACH_CXX_NOMPI = CC +MACH_FC_NOMPI = ftn +MACH_F90_NOMPI = ftn +MACH_LD_NOMPI = CC + +#----------------------------------------------------------------------- +# Machine-dependent defines +#----------------------------------------------------------------------- + +MACH_DEFINES = -DXT3 -DSYSCALL -DH5_USE_16_API + +#----------------------------------------------------------------------- +# Compiler flag settings +#----------------------------------------------------------------------- + +MACH_CPPFLAGS = -P -traditional +MACH_CFLAGS = +MACH_CXXFLAGS = +MACH_FFLAGS = +MACH_F90FLAGS = +MACH_LDFLAGS = -Wl,-static + +#----------------------------------------------------------------------- +# Precision-related flags +#----------------------------------------------------------------------- + +MACH_FFLAGS_INTEGER_32 = -i4 +MACH_FFLAGS_INTEGER_64 = -i8 +MACH_FFLAGS_REAL_32 = -r4 +MACH_FFLAGS_REAL_64 = -r8 + +#----------------------------------------------------------------------- +# Optimization flags +#----------------------------------------------------------------------- + +MACH_OPT_WARN = +MACH_OPT_DEBUG = -g +MACH_OPT_HIGH = -O2 +MACH_OPT_AGGRESSIVE = -O3 -fastsse + + +#----------------------------------------------------------------------- +# Includes +#----------------------------------------------------------------------- + +LOCAL_INCLUDES_MPI = +LOCAL_INCLUDES_HDF5 = -I$(LOCAL_HDF5_INSTALL)/include +LOCAL_INCLUDES_HYPRE = -I$(LOCAL_HYPRE_INSTALL)/include + +MACH_INCLUDES = $(LOCAL_INCLUDES_HDF5) + +MACH_INCLUDES_MPI = $(LOCAL_INCLUDES_MPI) +MACH_INCLUDES_HYPRE = $(LOCAL_INCLUDES_HYPRE) + +#----------------------------------------------------------------------- +# Libraries +#----------------------------------------------------------------------- +# + +LOCAL_LIBS_MPI = +LOCAL_LIBS_HDF5 = -L$(LOCAL_HDF5_INSTALL)/lib -lhdf5 +LOCAL_LIBS_HDF4 = +LOCAL_LIBS_HYPRE = -L$(LOCAL_HYPRE_INSTALL)/lib -lHYPRE + +MACH_LIBS = -lacml $(LOCAL_LIBS_HDF5) + +MACH_LIBS_MPI = $(LOCAL_LIBS_MPI) +MACH_LIBS_HYPRE = $(LOCAL_LIBS_HYPRE) diff --git a/src/enzo/Make.mach.xeonphi_intel b/src/enzo/Make.mach.xeonphi_intel new file mode 100644 index 000000000..c42141fec --- /dev/null +++ b/src/enzo/Make.mach.xeonphi_intel @@ -0,0 +1,119 @@ +#======================================================================= +# +# FILE: Make.mach.xeon-phi +# +# DESCRIPTION: Makefile settings for the VizLab XeonPhi machine +# +# AUTHOR: John Wise (jwise@gatech.edu) +# CJ Llorente (cjllorente3@gatech.edu) +# +# DATE: 2017-07-14 +# +#======================================================================= + +MACH_TEXT = GA Tech Vizlab Xeon Phi +MACH_VALID = 1 +MACH_FILE = Make.mach.xeon-phi + +#----------------------------------------------------------------------- +# Install paths (local variables) +#----------------------------------------------------------------------- + +#change this to your local hdf5 install path +LOCAL_HDF5 = /usr + +#----------------------------------------------------------------------- +# Compiler settings +#----------------------------------------------------------------------- + +export OMPI_CC=icc +export OMPI_CXX=icpc + +MACH_CPP = cpp # C preprocessor command + +# With MPI + +MACH_CC_MPI = mpicc # C compiler when using MPI +MACH_CXX_MPI = mpic++ # C++ compiler when using MPI +MACH_FC_MPI = ifort # Fortran 77 compiler when using MPI +MACH_F90_MPI = ifort # Fortran 90 compiler when using MPI +MACH_LD_MPI = mpic++ # Linker when using MPI + +# Without MPI + +MACH_CC_NOMPI = icc # C compiler when not using MPI +MACH_CXX_NOMPI = icpc # C++ compiler when not using MPI +MACH_FC_NOMPI = ifort # Fortran 77 compiler when not using MPI +MACH_F90_NOMPI = ifort # Fortran 90 compiler when not using MPI +MACH_LD_NOMPI = icpc # Linker when not using MPI + +#----------------------------------------------------------------------- +# Machine-dependent defines +#----------------------------------------------------------------------- + +MACH_DEFINES = -DLINUX -DH5_USE_16_API -DMEM_TRACE + +#----------------------------------------------------------------------- +# Compiler flag settings +#----------------------------------------------------------------------- + + +MACH_CPPFLAGS = -P -traditional +MACH_CFLAGS = +MACH_CXXFLAGS = -DMPICH_IGNORE_CXX_SEEK +MACH_FFLAGS = -132 +MACH_F90FLAGS = +MACH_LDFLAGS = +MACH_OPENMP = -qopenmp + + +#----------------------------------------------------------------------- +# Precision-related flags +#----------------------------------------------------------------------- + +MACH_FFLAGS_INTEGER_32 = -i4 +MACH_FFLAGS_INTEGER_64 = -i8 +MACH_FFLAGS_REAL_32 = -r4 +MACH_FFLAGS_REAL_64 = -r8 + +#----------------------------------------------------------------------- +# Optimization flags +#----------------------------------------------------------------------- + +MACH_OPT_WARN = -Wall -g +MACH_OPT_DEBUG = -O0 -g +MACH_OPT_HIGH = -O2 -g +MACH_OPT_AGGRESSIVE = -O3 -g + +#----------------------------------------------------------------------- +# Includes +#----------------------------------------------------------------------- + +LOCAL_INCLUDES_MPI = # MPI includes +LOCAL_INCLUDES_HDF5 = -I $(LOCAL_HDF5)/include/hdf5/serial # HDF5 includes +LOCAL_INCLUDES_HYPRE = # hypre includes +LOCAL_INCLUDES_PAPI = # PAPI includes + +MACH_INCLUDES = -I /usr/include $(LOCAL_INCLUDES_HDF5) + +MACH_INCLUDES_MPI = $(LOCAL_INCLUDES_MPI) +MACH_INCLUDES_HYPRE = $(LOCAL_INCLUDES_HYPRE) +MACH_INCLUDES_PAPI = $(LOCAL_INCLUDES_PAPI) + +#----------------------------------------------------------------------- +# Libraries +#----------------------------------------------------------------------- + +LOCAL_LIBS_MPI = # MPI libraries +LOCAL_LIBS_HDF5 = -L $(LOCAL_HDF5)/lib/x86_64-linux-gnu -lhdf5_serial # HDF5 libraries +LOCAL_LIBS_HYPRE = # hypre libraries +LOCAL_LIBS_PAPI = # PAPI libraries + +# Machine-dependent libraries +LOCAL_LIBS_MACH = -lifcore -limf -lifport -liomp5 +#LOCAL_LIBS_MACH = -lgfortran + +MACH_LIBS = $(LOCAL_LIBS_HDF5) $(LOCAL_LIBS_MACH) +MACH_LIBS_MPI = $(LOCAL_LIBS_MPI) +MACH_LIBS_HYPRE = $(LOCAL_LIBS_HYPRE) +MACH_LIBS_PAPI = $(LOCAL_LIBS_PAPI) diff --git a/src/enzo/Makefile b/src/enzo/Makefile index 10cae9653..ca5b16af2 100644 --- a/src/enzo/Makefile +++ b/src/enzo/Makefile @@ -84,6 +84,9 @@ include $(MAKE_CONFIG_OVERRIDE) # required by this makefile. E.g. $(CXX), $(CXXFLAGS), etc. #----------------------------------------------------------------------- +-include $(ENZO_DIR)/Make.mach.$(CONFIG_MACHINE) +-include $(HOME)/.enzo/Make.mach.$(CONFIG_MACHINE) + include Make.config.assemble #----------------------------------------------------------------------- @@ -92,8 +95,8 @@ include Make.config.assemble MACH_SHARED_EXT=so --include $(ENZO_DIR)/Make.mach.$(CONFIG_MACHINE) --include $(HOME)/.enzo/Make.mach.$(CONFIG_MACHINE) +#-include $(ENZO_DIR)/Make.mach.$(CONFIG_MACHINE) +#-include $(HOME)/.enzo/Make.mach.$(CONFIG_MACHINE) #======================================================================= # OBJECT FILES diff --git a/src/enzo/NestedCosmologySimulationInitialize.C b/src/enzo/NestedCosmologySimulationInitialize.C index 621e330ca..508e56ce4 100644 --- a/src/enzo/NestedCosmologySimulationInitialize.C +++ b/src/enzo/NestedCosmologySimulationInitialize.C @@ -1053,7 +1053,9 @@ int NestedCosmologySimulationReInitialize(HierarchyEntry *TopGrid, // Go down to the grid(s) on the next level CurrentGrid = CurrentGrid->NextGridNextLevel; - + + CommunicationBarrier(); + } // end loop over initial grid levels // Create tracer particles (on top grid) diff --git a/src/enzo/New_Grid_ReadGrid.C b/src/enzo/New_Grid_ReadGrid.C index fb83cab11..d6c3ed242 100644 --- a/src/enzo/New_Grid_ReadGrid.C +++ b/src/enzo/New_Grid_ReadGrid.C @@ -74,7 +74,7 @@ int grid::Group_ReadGrid(FILE *fptr, int GridID, HDF5_hid_t file_id, FILE *log_fptr; - hid_t group_id, dset_id, old_fields; + hid_t group_id, dset_id, old_fields, attr_id; hid_t file_dsp_id; hid_t num_type; @@ -103,7 +103,7 @@ int grid::Group_ReadGrid(FILE *fptr, int GridID, HDF5_hid_t file_id, int ReadOnlyActive = TRUE; if ((ReadEverything == TRUE) || (ReadGhostZones == TRUE)) { ReadOnlyActive = FALSE; - } + } if(ReadText && HierarchyFileInputFormat == 1){ @@ -289,7 +289,7 @@ int grid::Group_ReadGrid(FILE *fptr, int GridID, HDF5_hid_t file_id, size *= GridDimension[dim]; active_size *= ActiveDim[dim]; } - + // CAUTION - are the coordinates reversed? for (int dim = 0; dim < GridRank; dim++) { @@ -309,6 +309,19 @@ int grid::Group_ReadGrid(FILE *fptr, int GridID, HDF5_hid_t file_id, readAttribute(old_fields, HDF5_PREC, "dtFixed", &dtFixedCopy, TRUE); this->dtFixed = dtFixedCopy; } + + /* Read observed cost */ + + H5E_BEGIN_TRY{ + attr_id = H5Aopen_name(group_id, "ObservedCost"); + }H5E_END_TRY + if (attr_id != h5_error) { + H5Aclose(attr_id); + readAttribute(group_id, HDF5_REAL, "ObservedCost", this->ObservedCost, TRUE); + } else { + for (i = 0; i < MAX_COMPUTE_TIMERS; i++) + this->ObservedCost[i] = FLOAT_UNDEFINED; + } /* loop over fields, reading each one */ diff --git a/src/enzo/New_Grid_WriteGrid.C b/src/enzo/New_Grid_WriteGrid.C index 06adaad19..32053c1b7 100644 --- a/src/enzo/New_Grid_WriteGrid.C +++ b/src/enzo/New_Grid_WriteGrid.C @@ -357,6 +357,14 @@ int grid::Group_WriteGrid(FILE *fptr, char *base_name, int grid_id, HDF5_hid_t f } } + /* Write observed cost */ + + if (this->ObservedCost[0] > 0) { + hsize_t cost_size = MAX_COMPUTE_TIMERS; + writeArrayAttribute(group_id, HDF5_REAL, cost_size, "ObservedCost", + this->ObservedCost); + } + if (VelAnyl==1){ float *curl_x, *curl_y, *curl_z, *div; diff --git a/src/enzo/PhotonGrid_Methods.h b/src/enzo/PhotonGrid_Methods.h index b3df0d13b..b700fc5a9 100644 --- a/src/enzo/PhotonGrid_Methods.h +++ b/src/enzo/PhotonGrid_Methods.h @@ -139,6 +139,12 @@ float LookUpCrossSectionH2II(float hnu, float T); int AddRadiationPressureAcceleration(void); +/* Add optically thin X-ray field */ + + int AddXraysFromSources(Star *AllStars); + int AddXraysFromTree(void); + int AddOpticallyThinXrays(Star *AllStars, int NumberOfSources); + /* Initialize ionized sphere around a source */ int InitializeSource(RadiationSourceEntry *RS); diff --git a/src/enzo/PhotonGrid_Variables.h b/src/enzo/PhotonGrid_Variables.h index aeca05e18..aaf68e02a 100644 --- a/src/enzo/PhotonGrid_Variables.h +++ b/src/enzo/PhotonGrid_Variables.h @@ -1,4 +1,4 @@ -#define MAX_SOURCES 3000 +#define MAX_SOURCES 100000 // Photons int NumberOfPhotonPackages; //int NumberOfRenderingPackages; diff --git a/src/enzo/PopIIIRotationModel.C b/src/enzo/PopIIIRotationModel.C index bf5bfe843..b49cb39fa 100644 --- a/src/enzo/PopIIIRotationModel.C +++ b/src/enzo/PopIIIRotationModel.C @@ -22,7 +22,6 @@ #include #include #include "ErrorExceptions.h" -#include "phys_constants.h" #include "macros_and_parameters.h" #include "typedefs.h" #include "global_data.h" @@ -33,6 +32,7 @@ #include "Hierarchy.h" #include "TopGridData.h" #include "LevelHierarchy.h" +#include "phys_constants.h" int j, bin, nvalue; float frac, a, b, c, Mass, age; diff --git a/src/enzo/PrepareDensityField.C b/src/enzo/PrepareDensityField.C index 9bcb83d60..fa0b203dd 100644 --- a/src/enzo/PrepareDensityField.C +++ b/src/enzo/PrepareDensityField.C @@ -107,7 +107,7 @@ int PrepareDensityField(LevelHierarchyEntry *LevelArray[], LCAPERF_START("PrepareDensityField"); int grid1, grid2, StartGrid, EndGrid; - + /* Set the time for evaluation of the fields, etc. */ FLOAT EvaluateTime = LevelArray[level]->GridData->ReturnTime() + @@ -162,6 +162,8 @@ int PrepareDensityField(LevelHierarchyEntry *LevelArray[], /* Next, send data and process grids on the same processor. */ CommunicationDirection = COMMUNICATION_SEND; + //this is where we want to place the OMP parallel region: FINDME +#pragma omp parallel for if(NumberOfProcessors == 1) for (grid1 = StartGrid; grid1 < EndGrid; grid1++) DepositParticleMassField(Grids[grid1], EvaluateTime); @@ -225,7 +227,7 @@ int PrepareDensityField(LevelHierarchyEntry *LevelArray[], if (traceMPI) fprintf(tracePtr, "PrepareDensityField: P(%"ISYM"): PGMF2 (receive)\n", MyProcessorNumber); - + TIME_MSG("PrepareGravitatingMassField2"); LCAPERF_START("PrepareGravitatingMassField2a"); for (StartGrid = 0; StartGrid < NumberOfGrids; StartGrid += GRIDS_PER_LOOP) { @@ -257,10 +259,12 @@ int PrepareDensityField(LevelHierarchyEntry *LevelArray[], CommunicationDirection = COMMUNICATION_SEND; #ifdef FAST_SIB +#pragma omp parallel for if(NumberOfProcessors == 1) for (grid1 = StartGrid; grid1 < EndGrid; grid1++) PrepareGravitatingMassField2a(Grids[grid1], grid1, SiblingList, MetaData, level, When); #else +#pragma omp parallel for if(NumberOfProcessors == 1) for (grid1 = StartGrid; grid1 < EndGrid; grid1++) PrepareGravitatingMassField2a(Grids[grid1], MetaData, LevelArray, level, When); @@ -314,7 +318,7 @@ int PrepareDensityField(LevelHierarchyEntry *LevelArray[], if (traceMPI) fprintf(tracePtr, "PrepareDensityField: P(%"ISYM"): COMF1 (send)\n", MyProcessorNumber); - + TIME_MSG("CopyOverlappingMassField"); LCAPERF_START("CopyOverlappingMassField"); for (StartGrid = 0; StartGrid < NumberOfGrids; StartGrid += GRIDS_PER_LOOP) { @@ -419,6 +423,7 @@ int PrepareDensityField(LevelHierarchyEntry *LevelArray[], CopyPotentialFieldAverage = 2; +#pragma omp parallel for schedule(guided) for (grid1 = 0; grid1 < NumberOfGrids; grid1++) { Grids[grid1]->GridData->SolveForPotential(level, EvaluateTime); if (CopyGravPotential) @@ -524,7 +529,7 @@ int PrepareDensityField(LevelHierarchyEntry *LevelArray[], TIMER_STOP("SolveForPotential"); LCAPERF_STOP("SolveForPotential"); } // ENDIF level > 0 - + /* if level > MaximumGravityRefinementLevel, then do final potential solve (and acceleration interpolation) here rather than in the main EvolveLevel since it involves communications. */ @@ -535,6 +540,7 @@ int PrepareDensityField(LevelHierarchyEntry *LevelArray[], (but only if there is at least a subgrid -- it should be only if there is a subgrrid on reallevel, but this is ok). */ +#pragma omp parallel for schedule(guided) for (grid1 = 0; grid1 < NumberOfGrids; grid1++) if (Grids[grid1]->NextGridNextLevel != NULL) { Grids[grid1]->GridData->SolveForPotential(MaximumGravityRefinementLevel); diff --git a/src/enzo/PrepareGravitatingMassField.C b/src/enzo/PrepareGravitatingMassField.C index 4d3fc201e..21c22e0f1 100644 --- a/src/enzo/PrepareGravitatingMassField.C +++ b/src/enzo/PrepareGravitatingMassField.C @@ -49,6 +49,8 @@ int PrepareGravitatingMassField1(HierarchyEntry *Grid) int RefinementFactor = RefineBy; grid *CurrentGrid = Grid->GridData; + START_LOAD_TIMER; + /* Gravity: initialize and clear the gravitating mass field. */ if (CommunicationDirection == COMMUNICATION_POST_RECEIVE || @@ -72,6 +74,7 @@ int PrepareGravitatingMassField1(HierarchyEntry *Grid) // if (CommunicationReceiveIndex != CommunicationReceiveIndexLast) // CommunicationReceiveCurrentDependsOn = CommunicationReceiveIndex-1; + END_LOAD_TIMER(CurrentGrid,0); return SUCCESS; } @@ -93,6 +96,8 @@ int PrepareGravitatingMassField2a(HierarchyEntry *Grid, TopGridData *MetaData, int grid2; grid *CurrentGrid = Grid->GridData; + + START_LOAD_TIMER; /* Baryons: deposit mass into GravitatingMassField. */ @@ -140,7 +145,8 @@ int PrepareGravitatingMassField2a(HierarchyEntry *Grid, TopGridData *MetaData, } } // end: if (CommunicationDirection != COMMUNICATION_SEND) - + + END_LOAD_TIMER(CurrentGrid,0); return SUCCESS; } @@ -152,11 +158,13 @@ int PrepareGravitatingMassField2b(HierarchyEntry *Grid, int level) /* declarations */ grid *CurrentGrid = Grid->GridData; + START_LOAD_TIMER; CommunicationReceiveCurrentDependsOn = COMMUNICATION_NO_DEPENDENCE; if (level > 0) CurrentGrid->PreparePotentialField(Grid->ParentGrid->GridData); + END_LOAD_TIMER(CurrentGrid,0); return SUCCESS; } diff --git a/src/enzo/ReadParameterFile.C b/src/enzo/ReadParameterFile.C index 7d0a0eb88..f7a64b53a 100644 --- a/src/enzo/ReadParameterFile.C +++ b/src/enzo/ReadParameterFile.C @@ -368,6 +368,8 @@ int ReadParameterFile(FILE *fptr, TopGridData &MetaData, float *Initialdt) &MetallicityRefinementMinMetallicity); ret += sscanf(line, "MetallicityRefinementMinDensity = %"FSYM, &MetallicityRefinementMinDensity); + ret += sscanf(line, "MetallicityForRefinement = %"FSYM, + &MetallicityForRefinement); ret += sscanf(line, "DomainLeftEdge = %"PSYM" %"PSYM" %"PSYM, DomainLeftEdge, DomainLeftEdge+1, DomainLeftEdge+2); @@ -1001,6 +1003,8 @@ int ReadParameterFile(FILE *fptr, TopGridData &MetaData, float *Initialdt) &StarMakerExplosionDelayTime); ret += sscanf(line, "StarFeedbackDistRadius = %"ISYM, &StarFeedbackDistRadius); ret += sscanf(line, "StarFeedbackDistCellStep = %"ISYM, &StarFeedbackDistCellStep); + ret += sscanf(line, "StarMakerUsePhysicalDensityThreshold = %"ISYM, + &StarMakerUsePhysicalDensityThreshold); ret += sscanf(line, "StarClusterUseMetalField = %"ISYM, &StarClusterUseMetalField); @@ -2146,7 +2150,20 @@ int ReadParameterFile(FILE *fptr, TopGridData &MetaData, float *Initialdt) if (debug) printf("Initialdt in ReadParameterFile = %e\n", *Initialdt); - // +#ifdef _OPENMP + if (ConservativeReconstruction == TRUE) + ENZO_FAIL("ConservativeReconstruction not supported yet with openmp-yes.\n"); + if (PositiveReconstruction == TRUE) + ENZO_FAIL("PositiveReconstruction not supported yet with openmp-yes.\n"); +#endif + + /* Turn off reseting LB if we're running serially */ + + if (NumberOfProcessors == 1 && ResetLoadBalancing) + ResetLoadBalancing = FALSE; + + if (HybridParallelRootGridSplit == FALSE) + NumberOfCores = NumberOfProcessors; CheckShearingBoundaryConsistency(MetaData); diff --git a/src/enzo/RebuildHierarchy.C b/src/enzo/RebuildHierarchy.C index 9aae166f5..dd411e194 100644 --- a/src/enzo/RebuildHierarchy.C +++ b/src/enzo/RebuildHierarchy.C @@ -21,6 +21,7 @@ #include #include #include +#include #include "EnzoTiming.h" #include "ErrorExceptions.h" @@ -41,8 +42,8 @@ void AddLevel(LevelHierarchyEntry *LevelArray[], HierarchyEntry *Grid, int level); -int FindSubgrids(HierarchyEntry *Grid, int level, int &TotalFlaggedCells, - int &FlaggedGrids); +int FindSubgrids(HierarchyEntry *Grid, + int level, int &TotalFlaggedCells, int &FlaggedGrids); void WriteListOfInts(FILE *fptr, int N, int nums[]); int ReportMemoryUsage(char *header = NULL); int DepositParticleMassFlaggingField(LevelHierarchyEntry* LevelArray[], @@ -155,10 +156,15 @@ int RebuildHierarchy(TopGridData *MetaData, /* For each grid on this level collect all the particles below it. Notice that this must be done even for static hierarchy's. */ - HierarchyEntry *GridParent[MAX_NUMBER_OF_SUBGRIDS]; - grid *GridPointer[MAX_NUMBER_OF_SUBGRIDS]; - grid *ContigiousGridList[MAX_NUMBER_OF_SUBGRIDS]; + std::vector GridParent_vec(MAX_NUMBER_OF_SUBGRIDS); + std::vector GridPointer_vec(MAX_NUMBER_OF_SUBGRIDS); + std::vector ContigiousGridList_vec(MAX_NUMBER_OF_SUBGRIDS); + std::vector ToGrids_vec(MAX_NUMBER_OF_SUBGRIDS); + HierarchyEntry **GridParent = GridParent_vec.data(); + grid **GridPointer = GridPointer_vec.data(); + grid **ContigiousGridList = ContigiousGridList_vec.data(); + grid **ToGrids = ToGrids_vec.data(); /* Because we're storing particles in "empty" grids that are local to the subgrid, keep track of the number of particles stored @@ -350,6 +356,8 @@ int RebuildHierarchy(TopGridData *MetaData, // if (debug) ReportMemoryUsage("Memory usage report: Rebuild 3"); +#ifdef UNUSED +#endif /* 3) Rebuild all grids on this level and below. Note: All the grids in LevelArray[level+] have been deleted. */ @@ -420,10 +428,14 @@ int RebuildHierarchy(TopGridData *MetaData, tt0 = ReturnWallTime(); TotalFlaggedCells = FlaggedGrids = 0; +#pragma omp parallel for schedule(guided) \ + reduction(+:TotalFlaggedCells, FlaggedGrids) for (j = 0; j < grids; j++) - FindSubgrids(GridHierarchyPointer[j], i, TotalFlaggedCells, FlaggedGrids); + FindSubgrids(GridHierarchyPointer[j], i, + TotalFlaggedCells, FlaggedGrids); CommunicationSumValues(&TotalFlaggedCells, 1); CommunicationSumValues(&FlaggedGrids, 1); + if (debug) printf("RebuildHierarchy[%"ISYM"]: " "Flagged %"ISYM"/%"ISYM" grids. %"ISYM" flagged cells\n", @@ -508,6 +520,7 @@ int RebuildHierarchy(TopGridData *MetaData, Overlap counter, deleting the grid which it reaches zero. */ tt0 = ReturnWallTime(); +#pragma omp parallel for schedule(guided) for (j = 0; j < subgrids; j++) { SubgridHierarchyPointer[j]->ParentGrid->GridData-> DebugCheck("Rebuild parent"); @@ -529,8 +542,12 @@ int RebuildHierarchy(TopGridData *MetaData, RemoveForcingFromBaryonFields(); } + SubgridHierarchyPointer[j]->GridData->SetParentCost + (SubgridHierarchyPointer[j]->ParentGrid->GridData); + SubgridHierarchyPointer[j]->GridData->DebugCheck("Rebuild child"); } + tt1 = ReturnWallTime(); RHperf[8] += tt1-tt0; @@ -661,8 +678,9 @@ int RebuildHierarchy(TopGridData *MetaData, } /* 3g) loop over parent, and copy particles to new grids. */ - - grid *ToGrids[MAX_NUMBER_OF_SUBGRIDS]; + + // This should remain commented +//#pragma omp parallel for schedule(guided) private(k, ToGrids) for (j = 0; j < grids; j++) if (GridHierarchyPointer[j]->NextGridNextLevel != NULL) { @@ -709,6 +727,8 @@ int RebuildHierarchy(TopGridData *MetaData, } // end: if (StaticHierarchy == TRUE) + /* Reset */ + /* set grid IDs */ for (i = level; i < MAX_DEPTH_OF_HIERARCHY-1; i++) diff --git a/src/enzo/RestartPhotons.C b/src/enzo/RestartPhotons.C index 036a96cb6..df6a44255 100644 --- a/src/enzo/RestartPhotons.C +++ b/src/enzo/RestartPhotons.C @@ -34,6 +34,8 @@ #define CONVERGE 0.001 +int GenerateGridArray(LevelHierarchyEntry *LevelArray[], int level, + HierarchyEntry **Grids[]); int GetUnits(float *DensityUnits, float *LengthUnits, float *TemperatureUnits, float *TimeUnits, float *VelocityUnits, FLOAT Time); @@ -54,6 +56,14 @@ int RestartPhotons(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], if (!RadiativeTransfer) return SUCCESS; + HierarchyEntry **Grids[MAX_DEPTH_OF_HIERARCHY]; + int nGrids[MAX_DEPTH_OF_HIERARCHY]; + for (level = 0; level < MAX_DEPTH_OF_HIERARCHY; level++) + if (LevelArray[level] != NULL) + nGrids[level] = GenerateGridArray(LevelArray, level, &Grids[level]); + else + nGrids[level] = 0; + /* Get units. */ float LengthUnits, TimeUnits, TemperatureUnits, VelocityUnits, @@ -145,12 +155,27 @@ int RestartPhotons(TopGridData *MetaData, LevelHierarchyEntry *LevelArray[], RadiativeTransferCoupledRateSolver = savedCoupledChemistrySolver; dtPhoton = SavedPhotonTimestep; - /* Optically thin Lyman-Werner (H2) radiation field */ + /* Optically thin Lyman-Werner (H2) and X-ray radiation field */ + + int NumberOfSources = 0; + if (AllStars != NULL) { + Star *cstar = AllStars->NextStar; + while (cstar != NULL) { + cstar = cstar->NextStar; + NumberOfSources++; + } + } else if (ProblemType == 50) { + RadiationSourceEntry *RS = GlobalRadiationSources->NextSource; + while (RS != NULL) { + RS = RS->NextSource; + NumberOfSources++; + } + } if (AllStars == NULL) return SUCCESS; - int NumberOfSources = 0; + NumberOfSources = 0; Star *cstar = AllStars->NextStar; while (cstar != NULL) { cstar = cstar->NextStar; diff --git a/src/enzo/SetBoundaryConditions.C b/src/enzo/SetBoundaryConditions.C index ffeb36299..07bedb53e 100644 --- a/src/enzo/SetBoundaryConditions.C +++ b/src/enzo/SetBoundaryConditions.C @@ -1,3 +1,4 @@ + /*********************************************************************** / / SET BOUNDARY CONDITIONS (CALLED BY EVOLVE LEVEL) @@ -68,7 +69,6 @@ int SetBoundaryConditions(HierarchyEntry *Grids[], int NumberOfGrids, int loopEnd = (ShearingBoundaryDirection != -1) ? 2 : 1; - int grid1, grid2, StartGrid, EndGrid, loop; LCAPERF_START("SetBoundaryConditions"); @@ -81,16 +81,15 @@ int SetBoundaryConditions(HierarchyEntry *Grids[], int NumberOfGrids, #endif - if (loop == 0) { TIME_MSG("Interpolating boundaries from parent"); - for (StartGrid = 0; StartGrid < NumberOfGrids; StartGrid += GRIDS_PER_LOOP) { + + EndGrid = min(StartGrid + GRIDS_PER_LOOP, NumberOfGrids); if (traceMPI) fprintf(tracePtr, "SBC loop\n"); - EndGrid = min(StartGrid + GRIDS_PER_LOOP, NumberOfGrids); /* -------------- FIRST PASS ----------------- */ /* Here, we just generate the calls to generate the receive buffers, @@ -100,14 +99,11 @@ int SetBoundaryConditions(HierarchyEntry *Grids[], int NumberOfGrids, CommunicationDirection = COMMUNICATION_POST_RECEIVE; CommunicationReceiveIndex = 0; - for (grid1 = StartGrid; grid1 < EndGrid; grid1++) { /* a) Interpolate boundaries from the parent grid or set external boundary conditions. */ - - CommunicationReceiveCurrentDependsOn = COMMUNICATION_NO_DEPENDENCE; - + CommunicationReceiveCurrentDependsOn = COMMUNICATION_NO_DEPENDENCE; if (level == 0) { Grids[grid1]->GridData->SetExternalBoundaryValues(Exterior); @@ -122,8 +118,8 @@ int SetBoundaryConditions(HierarchyEntry *Grids[], int NumberOfGrids, /* -------------- SECOND PASS ----------------- */ /* Now we generate all the sends, and do all the computation for grids which are on the same processor as well. */ - CommunicationDirection = COMMUNICATION_SEND; + for (grid1 = StartGrid; grid1 < EndGrid; grid1++) { /* a) Interpolate boundaries from the parent grid or set @@ -211,7 +207,7 @@ int SetBoundaryConditions(HierarchyEntry *Grids[], int NumberOfGrids, } // end loop over batchs of grids // ENDFOR loop (for ShearingBox) - + /* c) Apply external reflecting boundary conditions, if needed. */ for (grid1 = 0; grid1 < NumberOfGrids; grid1++) diff --git a/src/enzo/SetDefaultGlobalValues.C b/src/enzo/SetDefaultGlobalValues.C index 2b2d30de5..edf3d5dc9 100644 --- a/src/enzo/SetDefaultGlobalValues.C +++ b/src/enzo/SetDefaultGlobalValues.C @@ -204,6 +204,7 @@ int SetDefaultGlobalValues(TopGridData &MetaData) MetallicityRefinementMinLevel = -1; MetallicityRefinementMinMetallicity = 1.0e-5; MetallicityRefinementMinDensity = FLOAT_UNDEFINED; + MetallicityForRefinement = 1.0; FluxCorrection = TRUE; UseCoolingTimestep = FALSE; @@ -338,6 +339,7 @@ int SetDefaultGlobalValues(TopGridData &MetaData) Unigrid = FALSE; UnigridTranspose = 2; NumberOfRootGridTilesPerDimensionPerProcessor = 1; + HybridParallelRootGridSplit = TRUE; PartitionNestedGrids = FALSE; ExtractFieldsOnly = TRUE; for (i = 0; i < MAX_DIMENSION; i++) { @@ -580,6 +582,7 @@ int SetDefaultGlobalValues(TopGridData &MetaData) StarParticleCreation = FALSE; StarParticleFeedback = FALSE; StarParticleRadiativeFeedback = FALSE; + StarMakerUsePhysicalDensityThreshold = FALSE; BigStarFormation = FALSE; BigStarFormationDone = FALSE; BigStarSeparation = 0.25; diff --git a/src/enzo/StarParticleRadTransfer.C b/src/enzo/StarParticleRadTransfer.C index d4abe7807..35b1cdc8f 100644 --- a/src/enzo/StarParticleRadTransfer.C +++ b/src/enzo/StarParticleRadTransfer.C @@ -90,6 +90,9 @@ int StarParticleRadTransfer(LevelHierarchyEntry *LevelArray[], int level, for (j = 0; j < nbins; j++) Q[j] /= QTotal; if (QTotal < tiny_number) continue; + // Don't create a source if the luminosity is zero + if (QTotal == 0.0) continue; + #ifdef USE_MEAN_ENERGY double meanEnergy = 0; nbins = 1; diff --git a/src/enzo/Star_CalculateFeedbackParameters.C b/src/enzo/Star_CalculateFeedbackParameters.C index a7c6f78fc..20c3906d1 100644 --- a/src/enzo/Star_CalculateFeedbackParameters.C +++ b/src/enzo/Star_CalculateFeedbackParameters.C @@ -61,6 +61,8 @@ void Star::CalculateFeedbackParameters(float &Radius, const float *SNExplosionEnergy = (PopIIIUseHypernova ==TRUE) ? HypernovaEnergy : CoreCollapseEnergy; + const int max_radius = 5; // Don't exceed max_radius*PopIIISNRadius + float StarLevelCellWidth, tdyn, frac; double EjectaVolume, SNEnergy, HeliumCoreMass, Delta_SF, MetalMass; diff --git a/src/enzo/Star_ComputePhotonRates.C b/src/enzo/Star_ComputePhotonRates.C index 0f9b7a895..9aaefdf45 100644 --- a/src/enzo/Star_ComputePhotonRates.C +++ b/src/enzo/Star_ComputePhotonRates.C @@ -17,7 +17,6 @@ #include #include #include "ErrorExceptions.h" -#include "phys_constants.h" #include "macros_and_parameters.h" #include "typedefs.h" #include "global_data.h" @@ -28,6 +27,7 @@ #include "Hierarchy.h" #include "TopGridData.h" #include "LevelHierarchy.h" +#include "phys_constants.h" float ReturnValuesFromSpectrumTable(float ColumnDensity, float dColumnDensity, int mode); float CalculateRotationalPhotonRates(float Mass, float age, int species); diff --git a/src/enzo/Star_FindFeedbackSphere.C b/src/enzo/Star_FindFeedbackSphere.C index f74626ecf..040253c7e 100644 --- a/src/enzo/Star_FindFeedbackSphere.C +++ b/src/enzo/Star_FindFeedbackSphere.C @@ -81,6 +81,26 @@ int Star::FindFeedbackSphere(LevelHierarchyEntry *LevelArray[], int level, return SUCCESS; } + /* Don't include feedback for SUPERNOVAE outside of the refine region. */ + + if (FeedbackFlag == SUPERNOVA) { + bool inside = true; + for (dim = 0; dim < MAX_DIMENSION; dim++) + inside &= (this->pos[dim] - Radius >= RefineRegionLeftEdge[dim] && + this->pos[dim] + Radius <= RefineRegionRightEdge[dim]); + if (!inside) { + SkipMassRemoval = TRUE; + if (debug) + printf("StarParticle[%"ISYM"]: M=%"GSYM", " + "PISN bubble outside of refine region. Skipping.\n" + "pos = %"GOUTSYM" %"GOUTSYM" %"GOUTSYM", radius = %g\n", + Identifier, Mass, this->pos[0], this->pos[1], this->pos[2], + Radius); + this->FeedbackFlag = DEATH; + } + return SUCCESS; + } + /*********************************************************************** For star formation, we need to find a sphere with enough mass to diff --git a/src/enzo/WriteParameterFile.C b/src/enzo/WriteParameterFile.C index fab74cf66..cf5310a65 100644 --- a/src/enzo/WriteParameterFile.C +++ b/src/enzo/WriteParameterFile.C @@ -344,7 +344,6 @@ int WriteParameterFile(FILE *fptr, TopGridData &MetaData, char *name = NULL) // There's probably a better way to do this. fprintf(fptr, "ActiveParticleDensityThreshold = %"GSYM"\n", ActiveParticleDensityThreshold); - fprintf(fptr, "SmartStarAccretion = %"ISYM"\n", SmartStarAccretion); fprintf(fptr, "SmartStarFeedback = %"ISYM"\n", SmartStarFeedback); fprintf(fptr, "SmartStarEddingtonCap = %"ISYM"\n", SmartStarEddingtonCap); fprintf(fptr, "SmartStarBHFeedback = %"ISYM"\n", SmartStarBHFeedback); @@ -382,6 +381,8 @@ int WriteParameterFile(FILE *fptr, TopGridData &MetaData, char *name = NULL) MetallicityRefinementMinMetallicity); fprintf(fptr, "MetallicityRefinementMinDensity = %"GSYM"\n", MetallicityRefinementMinDensity); + fprintf(fptr, "MetallicityForRefinement = %"GSYM"\n", + MetallicityForRefinement); fprintf(fptr, "DomainLeftEdge = "); WriteListOfFloats(fptr, MetaData.TopGridRank, DomainLeftEdge); @@ -770,6 +771,7 @@ int WriteParameterFile(FILE *fptr, TopGridData &MetaData, char *name = NULL) fprintf(fptr, "UnigridTranspose = %"ISYM"\n", UnigridTranspose); fprintf(fptr, "NumberOfRootGridTilesPerDimensionPerProcessor = %"ISYM"\n", NumberOfRootGridTilesPerDimensionPerProcessor); + fprintf(fptr, "HybridParallelRootGridSplit = %"ISYM"\n", HybridParallelRootGridSplit); fprintf(fptr, "PartitionNestedGrids = %"ISYM"\n", PartitionNestedGrids); fprintf(fptr, "ExtractFieldsOnly = %"ISYM"\n", ExtractFieldsOnly); fprintf(fptr, "CubeDumpEnabled = %"ISYM"\n", CubeDumpEnabled); @@ -906,9 +908,12 @@ int WriteParameterFile(FILE *fptr, TopGridData &MetaData, char *name = NULL) StarParticleFeedback); fprintf(fptr, "StarParticleRadiativeFeedback = %"ISYM"\n", StarParticleRadiativeFeedback); + fprintf(fptr, "StarMakerUsePhysicalDensityThreshold = %"ISYM"\n", + StarMakerUsePhysicalDensityThreshold); fprintf(fptr, "NumberOfParticleAttributes = %"ISYM"\n", NumberOfParticleAttributes); + /* Sink particles (for present day star formation) & winds */ fprintf(fptr, "SinkMergeDistance = %"FSYM"\n", SinkMergeDistance); diff --git a/src/enzo/enzo.C b/src/enzo/enzo.C index bfb466cc7..02a2d5d99 100644 --- a/src/enzo/enzo.C +++ b/src/enzo/enzo.C @@ -20,7 +20,11 @@ #ifdef USE_MPI #include "mpi.h" #endif /* USE_MPI */ - + +#ifdef _OPENMP +#include "omp.h" +#endif + #include #include #include @@ -306,6 +310,10 @@ Eint32 MAIN_NAME(Eint32 argc, char *argv[]) t_init0 = MPI_Wtime(); #endif /* USE_MPI */ +#ifdef _OPENMP + omp_set_dynamic(0); +#endif + // Create enzo timer and initialize default timers enzo_timer = new enzo_timing::enzo_timer(); TIMER_REGISTER("CommunicationTranspose"); diff --git a/src/enzo/fft_utils.F b/src/enzo/fft_utils.F index 1f78ce702..bb5123c4d 100644 --- a/src/enzo/fft_utils.F +++ b/src/enzo/fft_utils.F @@ -65,6 +65,14 @@ subroutine copy3dft(source, dest, sdim1, sdim2, sdim3, c write(6,*) 'se',start1, start2, start3 c write(6,*) end1, end2, end3 c + +!$omp parallel do +!$omp- private(k,j,i) +!$omp- collapse(1) +!$omp- shared(start3, end3, start2, end2, start1, end1) +!$omp- shared(dest, source, dstart3, dstart2, dstart1) +!$omp- shared(sstart1, sstart2, sstart3) +!$omp- default(none) do k = start3, end3 do j = start2, end2 do i = start1, end1, 2 @@ -75,6 +83,8 @@ subroutine copy3dft(source, dest, sdim1, sdim2, sdim3, enddo enddo enddo +!$omp end parallel do + c return end @@ -140,6 +150,14 @@ subroutine copy3drt(source, dest, sdim1, sdim2, sdim3, end2 = min(sstart2+sdim2, dstart2+ddim2) - 1 end3 = min(sstart3+sdim3, dstart3+ddim3) - 1 c + +!$omp parallel do +!$omp- private(k,j,i) +!$omp- collapse(1) +!$omp- shared(start3, end3, start2, end2, start1, end1) +!$omp- shared(dest, source, dstart3, dstart2, dstart1) +!$omp- shared(sstart1, sstart2, sstart3) +!$omp- default(none) do k = start3, end3 do j = start2, end2 do i = start1, end1, 2 @@ -150,6 +168,8 @@ subroutine copy3drt(source, dest, sdim1, sdim2, sdim3, enddo enddo enddo +!$omp end parallel do + c return end diff --git a/src/enzo/flux_hll.F b/src/enzo/flux_hll.F index 7a8a09526..8dae7cc09 100644 --- a/src/enzo/flux_hll.F +++ b/src/enzo/flux_hll.F @@ -379,6 +379,8 @@ subroutine flux_hll( if (ifallback .eq. 1) $ write(0,*) 'Cannot fallback anymore. Already in HLL.' write(0,*) 'stop in euler with e < 0' + call flush(6) + call flush(0) ERROR_MESSAGE endif enddo diff --git a/src/enzo/flux_hllc.F b/src/enzo/flux_hllc.F index 2d4125682..3026bd285 100644 --- a/src/enzo/flux_hllc.F +++ b/src/enzo/flux_hllc.F @@ -391,6 +391,7 @@ subroutine flux_hllc( c c Now check for negative colors (Warning only) c +#ifdef UNUSED do n=1, ncolor do i=i1, i2 if (colslice(i,j,n) + @@ -415,6 +416,7 @@ subroutine flux_hllc( endif enddo enddo +#endif enddo ! j diff --git a/src/enzo/global_data.h b/src/enzo/global_data.h index a6d11994f..8ea39abc4 100644 --- a/src/enzo/global_data.h +++ b/src/enzo/global_data.h @@ -47,6 +47,7 @@ EXTERN int CoresPerNode; EXTERN int PreviousMaxTask; EXTERN int LoadBalancingMinLevel; EXTERN int LoadBalancingMaxLevel; +EXTERN int HybridParallelRootGridSplit; /* FileDirectedOutput checks for file existence: stopNow (writes, stops), outputNow, subgridcycleCount */ @@ -574,6 +575,7 @@ EXTERN FLOAT EvolveCoolingRefineRegionRightEdge[MAX_REFINE_REGIONS][3]; // right EXTERN int MyProcessorNumber; EXTERN int NumberOfProcessors; +EXTERN int NumberOfCores; EXTERN float CommunicationTime; /* Parameter to indicate if top grid should do parallel IO @@ -642,6 +644,7 @@ EXTERN float MinimumOverDensityForRefinement[MAX_FLAGGING_METHODS]; EXTERN float MinimumMassForRefinement[MAX_FLAGGING_METHODS]; EXTERN float MinimumMassForRefinementLevelExponent[MAX_FLAGGING_METHODS]; EXTERN float DepositPositionsParticleSmoothRadius; +EXTERN float MetallicityForRefinement; /* For CellFlaggingMethod = 3, The minimum pressure jump required to be a shock. @@ -737,6 +740,7 @@ EXTERN int BigStarFormationDone; EXTERN float BigStarSeparation; EXTERN double SimpleQ; EXTERN float SimpleRampTime; +EXTERN int StarMakerUsePhysicalDensityThreshold; /* Set this flag to allow star formation only once per root grid time step (at the beginning) and with a SFR proportional to the full diff --git a/src/enzo/grid_cic.F b/src/enzo/grid_cic.F deleted file mode 100644 index 57e9f9a75..000000000 --- a/src/enzo/grid_cic.F +++ /dev/null @@ -1,523 +0,0 @@ -#include "fortran.def" -c======================================================================= -c/////////////////////// SUBROUTINE DEP_GRID_CIC \\\\\\\\\\\\\\\\\\\\\ -c - subroutine dep_grid_cic(source, dest, temp, velx, vely, velz, - & dt, rfield, ndim, ihydro, delx, dely, delz, - & sdim1, sdim2, sdim3, - & sstart1, sstart2, sstart3, - & send1, send2, send3, - & offset1, offset2, offset3, - & ddim1, ddim2, ddim3, - & refine1, refine2, refine3) -c -c DEPOSIT SOURCE GRID INTO DEST GRID USING CIC INTERPOLATION -c -c written by: Greg Bryan -c date: March, 1999 -c modified1: -c -c PURPOSE: -c -c INPUTS: -c source - source field -c rfield - source-like field indicating if cell is refined -c (1=no, 0=yes) -c sdim1-3 - source dimension -c ddim1-3 - destination dimension -c ndim - rank of fields -c refine1-3 - refinement factors -c sstart1-3 - source start index -c send1-3 - source end index -c offset1-3 - offset from this grid edge to dest grid edge -c (>= 0, in dest cell units) -c velx,y,z - velocities -c dt - time step -c delx - cell size of source grid -c temp - temporary field, 4*size of dest -c ihydro - hydro method (2 - zeus, velocity is cell centered) -c -c OUTPUT ARGUMENTS: -c dest - prolonged field -c -c EXTERNALS: -c -c LOCALS: -c -c----------------------------------------------------------------------- -c - implicit NONE -#include "fortran_types.def" -c -c----------------------------------------------------------------------- -c -c argument declarations -c - INTG_PREC ddim1, ddim2, ddim3, sdim1, sdim2, sdim3, ndim, ihydro, - & refine1, refine2, refine3, sstart1, sstart2, sstart3, - & send1, send2, send3 - R_PREC source(sdim1, sdim2, sdim3), dest(ddim1, ddim2, ddim3), - & rfield(sdim1, sdim2, sdim3), - & velx(sdim1, sdim2, sdim3), vely(sdim1, sdim2, sdim3), - & velz(sdim1, sdim2, sdim3), dt, delx, dely, delz, - & offset1, offset2, offset3, - & temp(ddim1, ddim2, ddim3, 4) -c -c locals -c - INTG_PREC i, j, k, i1, j1, k1, n - R_PREC fact1, fact2, fact3, x, y, z, dx, dy, dz, weight, mass, - & coef1, coef2, coef3, shift1, shift2, shift3, - & start1, start2, start3, half, edge1, edge2, edge3, temp1 - parameter (half = 0.5001_RKIND) -c -c\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\/////////////////////////////// -c======================================================================= -c -c Clear dest and temp_vel fields. -c - -! write(0,'("grid_cic: ",9i4)') sdim1,sdim2,sdim3,ddim1,ddim2,ddim3, -! & offset1,offset2,offset3 - - do k=1,ddim3 - do j=1,ddim2 - do i=1,ddim1 - dest(i,j,k) = 0._RKIND - enddo - do n=1,ndim+1 - do i=1,ddim1 - temp(i,j,k,n) = 0._RKIND - enddo - enddo - enddo - enddo -c -c Precompute some things -c - fact1 = 1._RKIND/REAL(refine1,RKIND) - fact2 = 1._RKIND/REAL(refine2,RKIND) - fact3 = 1._RKIND/REAL(refine3,RKIND) -c - coef1 = dt/delx*fact1 - if (ndim .gt. 1) coef2 = dt/dely*fact2 - if (ndim .gt. 2) coef3 = dt/delz*fact3 -c - start1 = -sstart1 - 0.5_RKIND + offset1*REAL(refine1,RKIND) - start2 = -sstart2 - 0.5_RKIND + offset2*REAL(refine2,RKIND) - start3 = -sstart3 - 0.5_RKIND + offset3*REAL(refine3,RKIND) -c - edge1 = REAL(ddim1,RKIND) - half - edge2 = REAL(ddim2,RKIND) - half - edge3 = REAL(ddim3,RKIND) - half - -! write(0,'("grid_cic: ",6f12.4)') start1,start2,start3, -! & edge1,edge2,edge3 - -c -c a) 1D -c - if (ndim .eq. 1) then - weight = fact1 -c -c compute density and mass-weighted velocity field -c - do i=sstart1+1, send1+1 - x = min(max((start1 + i)*fact1, half), edge1) - i1 = int(x + 0.5_RKIND,IKIND) - dx = REAL(i1,RKIND) + 0.5_RKIND - x - mass = (1._RKIND - rfield(i,1,1))*weight*source(i,1,1) -c - temp(i1 ,1 ,1, 1) = temp(i1 ,1 ,1, 1) + - & mass* dx - temp(i1+1,1 ,1, 1) = temp(i1+1,1 ,1, 1) + - & mass*(1._RKIND-dx) -c - temp1 = velx(i,1,1)*mass - if (ihydro .eq. 2) temp1 = - & 0.5_RKIND*(velx(i,1,1)+velx(i+1,1,1))*mass - temp(i1 ,1 ,1, 2) = temp(i1 ,1 ,1, 2) + - & temp1* dx - temp(i1+1,1 ,1, 2) = temp(i1+1,1 ,1, 2) + - & temp1*(1._RKIND-dx) - enddo -c -c Use velocity and mass field to generate mass field advanced by dt -c - do i=1,ddim1 - shift1 = temp(i,1,1,2)/max(temp(i,1,1,1), tiny) * coef1 - x = min(max((i - 0.5_RKIND + shift1), half), edge1) - i1 = int(x + 0.5_RKIND,IKIND) - dx = REAL(i1,RKIND) + 0.5_RKIND - x - mass = temp(i,1,1,1) - dest(i1 ,1 ,1) = dest(i1 ,1 ,1) + mass* dx - dest(i1+1,1 ,1) = dest(i1+1,1 ,1) + mass*(1._RKIND-dx) - enddo - endif -c -c b) 2D -c - if (ndim .eq. 2) then - weight = fact1*fact2 -c -c compute density and mass-weighted velocity field -c - do j=sstart2+1, send2+1 - y = min(max((start2 + j)*fact2, half), edge2) - j1 = int(y + 0.5_RKIND,IKIND) - dy = REAL(j1,RKIND) + 0.5_RKIND - y - do i=sstart1+1, send1+1 - x = min(max((start1 + i)*fact1, half), edge1) - i1 = int(x + 0.5_RKIND,IKIND) - dx = REAL(i1,RKIND) + 0.5_RKIND - x - mass = (1._RKIND - rfield(i,j,1))*weight*source(i,j,1) -c - temp(i1 ,j1 ,1,1) = temp(i1 ,j1 ,1,1) + - & mass* dx * dy - temp(i1+1,j1 ,1,1) = temp(i1+1,j1 ,1,1) + - & mass*(1._RKIND-dx)* dy - temp(i1 ,j1+1,1,1) = temp(i1 ,j1+1,1,1) + - & mass* dx *(1._RKIND-dy) - temp(i1+1,j1+1,1,1) = temp(i1+1,j1+1,1,1) + - & mass*(1. 0-dx)*(1._RKIND-dy) -c - temp1 = velx(i,j,1)*mass - if (ihydro .eq. 2) temp1 = - & 0.5_RKIND*(velx(i,j,1)+velx(i+1,j,1))*mass - temp(i1 ,j1 ,1,2) = temp(i1 ,j1 ,1,2) + - & temp1* dx * dy - temp(i1+1,j1 ,1,2) = temp(i1+1,j1 ,1,2) + - & temp1*(1._RKIND-dx)* dy - temp(i1 ,j1+1,1,2) = temp(i1 ,j1+1,1,2) + - & temp1* dx *(1._RKIND-dy) - temp(i1+1,j1+1,1,2) = temp(i1+1,j1+1,1,2) + - & temp1*(1._RKIND-dx)*(1._RKIND-dy) -c - temp1 = vely(i,j,1)*mass - if (ihydro .eq. 2) temp1 = - & 0.5_RKIND*(vely(i,j,1)+vely(i,j+1,1))*mass - temp(i1 ,j1 ,1,3) = temp(i1 ,j1 ,1,3) + - & temp1* dx * dy - temp(i1+1,j1 ,1,3) = temp(i1+1,j1 ,1,3) + - & temp1*(1._RKIND-dx)* dy - temp(i1 ,j1+1,1,3) = temp(i1 ,j1+1,1,3) + - & temp1* dx *(1._RKIND-dy) - temp(i1+1,j1+1,1,3) = temp(i1+1,j1+1,1,3) + - & temp1*(1._RKIND-dx)*(1._RKIND-dy) -c - enddo - enddo -c -c Use velocity and mass field to generate mass field advanced by dt -c - do j=1, ddim2 - do i=1, ddim1 - shift2 = temp(i,j,1,3)/ - & max(temp(i,j,1,1),tiny)*coef2 - y = min(max((j - 0.5_RKIND + shift2), half), edge2) - j1 = int(y + 0.5_RKIND,IKIND) - dy = REAL(j1,RKIND) + 0.5_RKIND - y - shift1 = temp(i,j,1,2)/max(temp(i,j,1,1),tiny)*coef1 - x = min(max((i - 0.5_RKIND + shift1), half), edge1) - i1 = int(x + 0.5_RKIND,IKIND) - dx = REAL(i1,RKIND) + 0.5_RKIND - x - mass = temp(i,j,1,1) - dest(i1 ,j1 ,1) = dest(i1 ,j1 ,1) + - & mass* dx * dy - dest(i1+1,j1 ,1) = dest(i1+1,j1 ,1) + - & mass*(1._RKIND-dx)* dy - dest(i1 ,j1+1,1) = dest(i1 ,j1+1,1) + - & mass* dx *(1._RKIND-dy) - dest(i1+1,j1+1,1) = dest(i1+1,j1+1,1) + - & mass*(1._RKIND-dx)*(1._RKIND-dy) - enddo - enddo - endif -c -c c) 3D -c - if (ndim .eq. 3) then - weight = fact1*fact2*fact3 -c -c compute density and mass-weighted velocity field -c - do k=sstart3+1, send3+1 - z = min(max((start3 + k)*fact3, half), edge3) - k1 = int(z + 0.5_RKIND,IKIND) - dz = REAL(k1,RKIND) + 0.5_RKIND - z - do j=sstart2+1, send2+1 - y = min(max((start2 + j)*fact2, half), edge2) - j1 = int(y + 0.5_RKIND,IKIND) - dy = REAL(j1,RKIND) + 0.5_RKIND - y - do i=sstart1+1, send1+1 - x = min(max((start1 + i)*fact1, half), edge1) - i1 = int(x + 0.5_RKIND,IKIND) - dx = REAL(i1,RKIND) + 0.5_RKIND - x - mass = (1._RKIND - rfield(i,j,k))*weight*source(i,j,k) -c - temp(i1 ,j1 ,k1 ,1) = temp(i1 ,j1 ,k1 ,1) + - & mass* dx * dy * dz - temp(i1+1,j1 ,k1 ,1) = temp(i1+1,j1 ,k1 ,1) + - & mass*(1._RKIND-dx)* dy * dz - temp(i1 ,j1+1,k1 ,1) = temp(i1 ,j1+1,k1 ,1) + - & mass* dx *(1._RKIND-dy)* dz - temp(i1+1,j1+1,k1 ,1) = temp(i1+1,j1+1,k1 ,1) + - & mass*(1._RKIND-dx)*(1._RKIND-dy)* dz - temp(i1 ,j1 ,k1+1,1) = temp(i1 ,j1 ,k1+1,1) + - & mass* dx * dy *(1._RKIND-dz) - temp(i1+1,j1 ,k1+1,1) = temp(i1+1,j1 ,k1+1,1) + - & mass*(1._RKIND-dx)* dy *(1._RKIND-dz) - temp(i1 ,j1+1,k1+1,1) = temp(i1 ,j1+1,k1+1,1) + - & mass* dx *(1._RKIND-dy)*(1._RKIND-dz) - temp(i1+1,j1+1,k1+1,1) = temp(i1+1,j1+1,k1+1,1) + - & mass*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) -c - temp1 = velx(i,j,k)*mass - if (ihydro .eq. 2) temp1 = - & 0.5_RKIND*(velx(i,j,k)+velx(i+1,j,k))*mass - temp(i1 ,j1 ,k1 ,2) = temp(i1 ,j1 ,k1 ,2) + - & temp1* dx * dy * dz - temp(i1+1,j1 ,k1 ,2) = temp(i1+1,j1 ,k1 ,2) + - & temp1*(1._RKIND-dx)* dy * dz - temp(i1 ,j1+1,k1 ,2) = temp(i1 ,j1+1,k1 ,2) + - & temp1* dx *(1._RKIND-dy)* dz - temp(i1+1,j1+1,k1 ,2) = temp(i1+1,j1+1,k1 ,2) + - & temp1*(1._RKIND-dx)*(1._RKIND-dy)* dz - temp(i1 ,j1 ,k1+1,2) = temp(i1 ,j1 ,k1+1,2) + - & temp1* dx * dy *(1._RKIND-dz) - temp(i1+1,j1 ,k1+1,2) = temp(i1+1,j1 ,k1+1,2) + - & temp1*(1._RKIND-dx)* dy *(1._RKIND-dz) - temp(i1 ,j1+1,k1+1,2) = temp(i1 ,j1+1,k1+1,2) + - & temp1* dx *(1._RKIND-dy)*(1._RKIND-dz) - temp(i1+1,j1+1,k1+1,2) = temp(i1+1,j1+1,k1+1,2) + - & temp1*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) -c - temp1 = vely(i,j,k)*mass - if (ihydro .eq. 2) temp1 = - & 0.5_RKIND*(vely(i,j,k)+vely(i,j+1,k))*mass - temp(i1 ,j1 ,k1 ,3) = temp(i1 ,j1 ,k1 ,3) + - & temp1* dx * dy * dz - temp(i1+1,j1 ,k1 ,3) = temp(i1+1,j1 ,k1 ,3) + - & temp1*(1._RKIND-dx)* dy * dz - temp(i1 ,j1+1,k1 ,3) = temp(i1 ,j1+1,k1 ,3) + - & temp1* dx *(1._RKIND-dy)* dz - temp(i1+1,j1+1,k1 ,3) = temp(i1+1,j1+1,k1 ,3) + - & temp1*(1._RKIND-dx)*(1._RKIND-dy)* dz - temp(i1 ,j1 ,k1+1,3) = temp(i1 ,j1 ,k1+1,3) + - & temp1* dx * dy *(1._RKIND-dz) - temp(i1+1,j1 ,k1+1,3) = temp(i1+1,j1 ,k1+1,3) + - & temp1*(1._RKIND-dx)* dy *(1._RKIND-dz) - temp(i1 ,j1+1,k1+1,3) = temp(i1 ,j1+1,k1+1,3) + - & temp1* dx *(1._RKIND-dy)*(1._RKIND-dz) - temp(i1+1,j1+1,k1+1,3) = temp(i1+1,j1+1,k1+1,3) + - & temp1*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) -c - temp1 = velz(i,j,k)*mass - if (ihydro .eq. 2) temp1 = - & 0.5_RKIND*(velz(i,j,k)+velz(i,j,k+1))*mass - temp(i1 ,j1 ,k1 ,4) = temp(i1 ,j1 ,k1 ,4) + - & temp1* dx * dy * dz - temp(i1+1,j1 ,k1 ,4) = temp(i1+1,j1 ,k1 ,4) + - & temp1*(1._RKIND-dx)* dy * dz - temp(i1 ,j1+1,k1 ,4) = temp(i1 ,j1+1,k1 ,4) + - & temp1* dx *(1._RKIND-dy)* dz - temp(i1+1,j1+1,k1 ,4) = temp(i1+1,j1+1,k1 ,4) + - & temp1*(1._RKIND-dx)*(1._RKIND-dy)* dz - temp(i1 ,j1 ,k1+1,4) = temp(i1 ,j1 ,k1+1,4) + - & temp1* dx * dy *(1._RKIND-dz) - temp(i1+1,j1 ,k1+1,4) = temp(i1+1,j1 ,k1+1,4) + - & temp1*(1._RKIND-dx)* dy *(1._RKIND-dz) - temp(i1 ,j1+1,k1+1,4) = temp(i1 ,j1+1,k1+1,4) + - & temp1* dx *(1._RKIND-dy)*(1._RKIND-dz) - temp(i1+1,j1+1,k1+1,4) = temp(i1+1,j1+1,k1+1,4) + - & temp1*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) -c - enddo - enddo - enddo -c -c Use velocity and mass field to generate mass field advanced by dt -c - do k=1, ddim3 - do j=1, ddim2 - do i=1, ddim1 - shift3 = temp(i,j,k,4)/max(temp(i,j,k,1),tiny)*coef3 - z = min(max((k - 0.5_RKIND + shift3), half), edge3) - k1 = int(z + 0.5_RKIND,IKIND) - dz = REAL(k1,RKIND) + 0.5_RKIND - z -c - shift2 = temp(i,j,k,3)/max(temp(i,j,k,1),tiny)*coef2 - y = min(max((j - 0.5_RKIND + shift2), half), edge2) - j1 = int(y + 0.5_RKIND,IKIND) - dy = REAL(j1,RKIND) + 0.5_RKIND - y -c - shift1 = temp(i,j,k,2)/max(temp(i,j,k,1),tiny)*coef1 - x = min(max((i - 0.5_RKIND + shift1), half), edge1) - i1 = int(x + 0.5_RKIND,IKIND) - dx = REAL(i1,RKIND) + 0.5_RKIND - x -c -c if (i1 .lt. 1 .or. i1 .ge. ddim1 .or. -c & j1 .lt. 1 .or. j1 .ge. ddim2 .or. -c & k1 .lt. 1 .or. k1 .ge. ddim3 ) -c & write(6,*) i1,j1,k1,ddim1,ddim2,ddim3 -c - mass = temp(i,j,k,1) - dest(i1 ,j1 ,k1 ) = dest(i1 ,j1 ,k1 ) + - & mass* dx * dy * dz - dest(i1+1,j1 ,k1 ) = dest(i1+1,j1 ,k1 ) + - & mass*(1._RKIND-dx)* dy * dz - dest(i1 ,j1+1,k1 ) = dest(i1 ,j1+1,k1 ) + - & mass* dx *(1._RKIND-dy)* dz - dest(i1+1,j1+1,k1 ) = dest(i1+1,j1+1,k1 ) + - & mass*(1._RKIND-dx)*(1._RKIND-dy)* dz - dest(i1 ,j1 ,k1+1) = dest(i1 ,j1 ,k1+1) + - & mass* dx * dy *(1._RKIND-dz) - dest(i1+1,j1 ,k1+1) = dest(i1+1,j1 ,k1+1) + - & mass*(1._RKIND-dx)* dy *(1._RKIND-dz) - dest(i1 ,j1+1,k1+1) = dest(i1 ,j1+1,k1+1) + - & mass* dx *(1._RKIND-dy)*(1._RKIND-dz) - dest(i1+1,j1+1,k1+1) = dest(i1+1,j1+1,k1+1) + - & mass*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) - enddo - enddo - enddo -c - endif -c - return - end - - - -c======================================================================= -c/////////////////////// SUBROUTINE INT_GRID_CIC \\\\\\\\\\\\\\\\\\\\\ -c - subroutine int_grid_cic(source, dest, ndim, - & sdim1, sdim2, sdim3, - & ddim1, ddim2, ddim3, - & start1, start2, start3, - & refine1, refine2, refine3) -c -c INTERPOLATE FROM SOURCE GRID INTO DEST -c -c written by: Greg Bryan -c date: March, 1999 -c modified1: -c -c PURPOSE: -c -c INPUTS: -c source - source field -c sdim1-3 - source dimension -c ddim1-3 - destination dimension -c ndim - rank of fields -c start1-3 - start of dest field in dest grid cells (R_PREC) -c refine1-3 - refinement factors -c sstart1-3 - source start index -c send1-3 - source end index -c -c OUTPUT ARGUMENTS: -c dest - interpolated field -c -c EXTERNALS: -c -c LOCALS: -c -c----------------------------------------------------------------------- -c - implicit NONE -#include "fortran_types.def" -c -c----------------------------------------------------------------------- -c -c argument declarations -c - INTG_PREC ddim1, ddim2, ddim3, sdim1, sdim2, sdim3, ndim, - & refine1, refine2, refine3 - R_PREC source(sdim1, sdim2, sdim3), dest(ddim1, ddim2, ddim3), - & start1, start2, start3 -c -c locals -c - INTG_PREC i, j, k, i1, j1, k1 - R_PREC fact1, fact2, fact3, x, y, z, dx, dy, dz -c -c\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\/////////////////////////////// -c======================================================================= -c -c Precompute some things -c - fact1 = 1._RKIND/REAL(refine1,RKIND) - fact2 = 1._RKIND/REAL(refine2,RKIND) - fact3 = 1._RKIND/REAL(refine3,RKIND) -c -c a) 1D -c - if (ndim .eq. 1) then - do i=1, ddim1 - x = (start1 + i - 0.5_RKIND)*fact1 - i1 = int(x + 0.5_RKIND,IKIND) - dx = REAL(i1,RKIND) + 0.5_RKIND - x - dest(i,1,1) = source(i1 ,1 ,1)* dx + - & source(i1+1,1 ,1)*(1._RKIND-dx) - enddo - endif -c -c b) 2D -c - if (ndim .eq. 2) then - do j=1, ddim2 - y = (start2 + j - 0.5_RKIND)*fact2 - j1 = int(y + 0.5_RKIND,IKIND) - dy = REAL(j1,RKIND) + 0.5_RKIND - y - do i=1, ddim1 - x = (start1 + i - 0.5_RKIND)*fact1 - i1 = int(x + 0.5_RKIND,IKIND) - dx = REAL(i1,RKIND) + 0.5_RKIND - x - dest(i,j,1) = source(i1 ,j1 ,1)* dx * dy + - & source(i1+1,j1 ,1)*(1._RKIND-dx)* dy + - & source(i1 ,j1+1,1)* dx *(1._RKIND-dy) + - & source(i1+1,j1+1,1)*(1._RKIND-dx)*(1._RKIND-dy) - enddo - enddo - endif -c -c c) 3D -c - if (ndim .eq. 3) then - do k=1, ddim3 - z = (start3 + k - 0.5_RKIND)*fact3 - k1 = int(z + 0.5_RKIND,IKIND) - dz = REAL(k1,RKIND) + 0.5_RKIND - z - do j=1, ddim2 - y = (start2 + j - 0.5_RKIND)*fact2 - j1 = int(y + 0.5_RKIND,IKIND) - dy = REAL(j1,RKIND) + 0.5_RKIND - y - do i=1, ddim1 - x = (start1 + i - 0.5_RKIND)*fact1 - i1 = int(x + 0.5_RKIND,IKIND) - dx = REAL(i1,RKIND) + 0.5_RKIND - x - dest(i,j,k) = - & source(i1 ,j1 ,k1 ) - & * dx * dy * dz + - & source(i1+1,j1 ,k1 ) - & *(1._RKIND-dx)* dy * dz + - & source(i1 ,j1+1,k1 ) - & * dx *(1._RKIND-dy)* dz + - & source(i1+1,j1+1,k1 ) - & *(1._RKIND-dx)*(1._RKIND-dy)* dz + - & source(i1 ,j1 ,k1+1) - & * dx * dy *(1._RKIND-dz)+ - & source(i1+1,j1 ,k1+1) - & *(1._RKIND-dx)* dy *(1._RKIND-dz)+ - & source(i1 ,j1+1,k1+1) - & * dx *(1._RKIND-dy)*(1._RKIND-dz)+ - & source(i1+1,j1+1,k1+1) - & *(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) - enddo - enddo - enddo - endif -c - return - end diff --git a/src/enzo/grid_cic.F90 b/src/enzo/grid_cic.F90 new file mode 100644 index 000000000..fb0646b14 --- /dev/null +++ b/src/enzo/grid_cic.F90 @@ -0,0 +1,543 @@ +#include "fortran.def" +!======================================================================= +!/////////////////////// SUBROUTINE DEP_GRID_CIC \\\\\\\\\\\\\\\\\\\\\ +! +subroutine dep_grid_cic(source, dest, velx, vely, velz,& + dt, rfield, ndim, ihydro, delx, dely, delz,& + sdim1, sdim2, sdim3, & + sstart1, sstart2, sstart3, & + send1, send2, send3, & + offset1, offset2, offset3, & + ddim1, ddim2, ddim3, & + refine1, refine2, refine3) +! +! DEPOSIT SOURCE GRID INTO DEST GRID USING CIC INTERPOLATION +! +! written by: Greg Bryan +! date: March, 1999 +! modified1: +! +! PURPOSE: +! +! INPUTS: +! source - source field +! rfield - source-like field indicating if cell is refined +! (1=no, 0=yes) +! sdim1-3 - source dimension +! ddim1-3 - destination dimension +! ndim - rank of fields +! refine1-3 - refinement factors +! sstart1-3 - source start index +! send1-3 - source end index +! offset1-3 - offset from this grid edge to dest grid edge +! (>= 0, in dest cell units) +! velx,y,z - velocities +! dt - time step +! delx - cell size of source grid +! temp - temporary field, 4*size of dest +! ihydro - hydro method (2 - zeus, velocity is cell centered) +! +! OUTPUT ARGUMENTS: +! dest - prolonged field +! +! EXTERNALS: +! +! LOCALS: +! +!----------------------------------------------------------------------- +! + implicit NONE +#include "fortran_types.def" +! +!----------------------------------------------------------------------- +! +! argument declarations +! + INTG_PREC ddim1, ddim2, ddim3, sdim1, sdim2, sdim3, ndim, ihydro, & + refine1, refine2, refine3, sstart1, sstart2, sstart3, & + send1, send2, send3 + R_PREC source(sdim1, sdim2, sdim3), dest(ddim1, ddim2, ddim3), & + rfield(sdim1, sdim2, sdim3), & + velx(sdim1, sdim2, sdim3), vely(sdim1, sdim2, sdim3), & + velz(sdim1, sdim2, sdim3), dt, delx, dely, delz, & + offset1, offset2, offset3 +! +! locals +! + INTG_PREC i, j, k, i1, j1, k1, n, me, mek + R_PREC fact1, fact2, fact3, x, y, z, dx, dy, dz, weight, mass, & + coef1, coef2, coef3, shift1, shift2, shift3, & + start1, start2, start3, half, edge1, edge2, edge3, temp1 + parameter (half = 0.5001_RKIND) + INTG_PREC, external :: omp_get_thread_num, omp_get_num_threads + R_PREC, dimension(:,:,:,:), allocatable :: temp +! +!\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\/////////////////////////////// +!======================================================================= +! +! Clear dest and temp_vel fields. +! + +! write(0,'("grid_cic: ",9i4)') sdim1,sdim2,sdim3,ddim1,ddim2,ddim3, +! & offset1,offset2,offset3 + + allocate(temp(ddim1, ddim2, ddim3, 4)) + +!!$omp parallel do private(i,j,n) schedule(static) + do k=1,ddim3 + dest(:,:,k) = 0.0 + temp(:,:,k,:) = 0.0 + enddo +!!$omp end parallel do + +! +! Precompute some things +! + fact1 = 1._RKIND/real(refine1, RKIND) + fact2 = 1._RKIND/real(refine2, RKIND) + fact3 = 1._RKIND/real(refine3, RKIND) +! + coef1 = dt/delx*fact1 + if (ndim .gt. 1) coef2 = dt/dely*fact2 + if (ndim .gt. 2) coef3 = dt/delz*fact3 +! + start1 = -sstart1 - 0.5_RKIND + offset1*real(refine1, RKIND) + start2 = -sstart2 - 0.5_RKIND + offset2*real(refine2, RKIND) + start3 = -sstart3 - 0.5_RKIND + offset3*real(refine3, RKIND) +! + edge1 = real(ddim1, RKIND) - half + edge2 = real(ddim2, RKIND) - half + edge3 = real(ddim3, RKIND) - half + +! write(0,'("grid_cic: ",6f12.4)') start1,start2,start3, +! & edge1,edge2,edge3 + +! +! a) 1D +! + if (ndim .eq. 1) then + weight = fact1 +! +! compute density and mass-weighted velocity field +! + do i=sstart1+1, send1+1 + x = min(max((start1 + i)*fact1, half), edge1) + i1 = int(x + 0.5_RKIND, IKIND) + dx = real(i1, RKIND) + 0.5_RKIND - x + mass = (1._RKIND - rfield(i,1,1))*weight*source(i,1,1) + + temp(i1 ,1 ,1, 1) = temp(i1 ,1 ,1, 1) + & + mass* dx + temp(i1+1,1 ,1, 1) = temp(i1+1,1 ,1, 1) + & + mass*(1._RKIND-dx) +! + temp1 = velx(i,1,1)*mass + if (ihydro .eq. 2) temp1 = & + 0.5_RKIND*(velx(i,1,1)+velx(i+1,1,1))*mass + temp(i1 ,1 ,1, 2) = temp(i1 ,1 ,1, 2) + & + temp1* dx + temp(i1+1,1 ,1, 2) = temp(i1+1,1 ,1, 2) + & + temp1*(1._RKIND-dx) + enddo +! +! Use velocity and mass field to generate mass field advanced by dt +! + do i=1,ddim1 + shift1 = temp(i,1,1,2)/max(temp(i,1,1,1),tiny)*coef1 + x = min(max((i - 0.5_RKIND + shift1), half), edge1) + i1 = int(x + 0.5_RKIND, IKIND) + dx = real(i1, RKIND) + 0.5_RKIND - x + mass = temp(i,1,1,1) + dest(i1 ,1 ,1) = dest(i1 ,1 ,1) + mass* dx + dest(i1+1,1 ,1) = dest(i1+1,1 ,1) + mass*(1._RKIND-dx) + enddo + endif +! +! b) 2D +! + if (ndim .eq. 2) then + weight = fact1*fact2 +! +! compute density and mass-weighted velocity field +! + do j=sstart2+1, send2+1 + y = min(max((start2 + j)*fact2, half), edge2) + j1 = int(y + 0.5_RKIND, IKIND) + dy = real(j1, RKIND) + 0.5_RKIND - y + do i=sstart1+1, send1+1 + x = min(max((start1 + i)*fact1, half), edge1) + i1 = int(x + 0.5_RKIND, IKIND) + dx = real(i1, RKIND) + 0.5_RKIND - x + mass = (1._RKIND - rfield(i,j,1))*weight*source(i,j,1) +! + temp(i1 ,j1 ,1,1) = temp(i1 ,j1 ,1,1) + & + mass* dx * dy + temp(i1+1,j1 ,1,1) = temp(i1+1,j1 ,1,1) + & + mass*(1._RKIND-dx)* dy + temp(i1 ,j1+1,1,1) = temp(i1 ,j1+1,1,1) + & + mass* dx *(1._RKIND-dy) + temp(i1+1,j1+1,1,1) = temp(i1+1,j1+1,1,1) + & + mass*(1._RKIND-dx)*(1._RKIND-dy) +! + temp1 = velx(i,j,1)*mass + if (ihydro .eq. 2) temp1 = & + 0.5_RKIND*(velx(i,j,1)+velx(i+1,j,1))*mass + temp(i1 ,j1 ,1,2) = temp(i1 ,j1 ,1,2) + & + temp1* dx * dy + temp(i1+1,j1 ,1,2) = temp(i1+1,j1 ,1,2) + & + temp1*(1._RKIND-dx)* dy + temp(i1 ,j1+1,1,2) = temp(i1 ,j1+1,1,2) + & + temp1* dx *(1._RKIND-dy) + temp(i1+1,j1+1,1,2) = temp(i1+1,j1+1,1,2) + & + temp1*(1._RKIND-dx)*(1._RKIND-dy) +! + temp1 = vely(i,j,1)*mass + if (ihydro .eq. 2) temp1 = & + 0.5_RKIND*(vely(i,j,1)+vely(i,j+1,1))*mass + temp(i1 ,j1 ,1,3) = temp(i1 ,j1 ,1,3) + & + temp1* dx * dy + temp(i1+1,j1 ,1,3) = temp(i1+1,j1 ,1,3) + & + temp1*(1._RKIND-dx)* dy + temp(i1 ,j1+1,1,3) = temp(i1 ,j1+1,1,3) + & + temp1* dx *(1._RKIND-dy) + temp(i1+1,j1+1,1,3) = temp(i1+1,j1+1,1,3) + & + temp1*(1._RKIND-dx)*(1._RKIND-dy) + + enddo + enddo +! +! Use velocity and mass field to generate mass field advanced by dt +! + do j=1, ddim2 + do i=1, ddim1 + shift2 = temp(i,j,1,3)/ & + max(temp(i,j,1,1),tiny)*coef2 + y = min(max((j - 0.5_RKIND + shift2), half), edge2) + j1 = int(y + 0.5_RKIND, IKIND) + dy = real(j1, RKIND) + 0.5_RKIND - y + shift1 = temp(i,j,1,2)/ & + max(temp(i,j,1,1),tiny)*coef1 + x = min(max((i - 0.5_RKIND + shift1), half), edge1) + i1 = int(x + 0.5_RKIND, IKIND) + dx = real(i1, RKIND) + 0.5_RKIND - x + mass = temp(i,j,1,1) + dest(i1 ,j1 ,1) = dest(i1 ,j1 ,1) + & + mass* dx * dy + dest(i1+1,j1 ,1) = dest(i1+1,j1 ,1) + & + mass*(1._RKIND-dx)* dy + dest(i1 ,j1+1,1) = dest(i1 ,j1+1,1) + & + mass* dx *(1._RKIND-dy) + dest(i1+1,j1+1,1) = dest(i1+1,j1+1,1) + & + mass*(1._RKIND-dx)*(1._RKIND-dy) + enddo + enddo + endif +! +! c) 3D +! + if (ndim .eq. 3) then + weight = fact1*fact2*fact3 + +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! START PARALLEL REGION +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +! +! compute density and mass-weighted velocity field +! + +!!!!$omp parallel do schedule(static) private(i,j,k) & +!!!!$omp private(x, i1, dx) & +!!!!$omp private(y, j1, dy) & +!!!!$omp private(z, k1, dz) & +!!!!$omp private(mass, temp1, me) & +!!!!$omp reduction(+:temp) + do k=sstart3+1, send3+1 + z = min(max((start3 + k)*fact3, half), edge3) + k1 = int(z + 0.5_RKIND, IKIND) + dz = real(k1, RKIND) + 0.5_RKIND - z + do j=sstart2+1, send2+1 + y = min(max((start2 + j)*fact2, half), edge2) + j1 = int(y + 0.5_RKIND, IKIND) + dy = real(j1, RKIND) + 0.5_RKIND - y + do i=sstart1+1, send1+1 + x = min(max((start1 + i)*fact1, half), edge1) + i1 = int(x + 0.5_RKIND, IKIND) + dx = real(i1, RKIND) + 0.5_RKIND - x + mass = (1._RKIND - rfield(i,j,k))*weight*source(i,j,k) + ! + temp(i1 ,j1 ,k1 ,1) = temp(i1 ,j1 ,k1 ,1) + & + mass* dx * dy * dz + temp(i1+1,j1 ,k1 ,1) = temp(i1+1,j1 ,k1 ,1) + & + mass*(1._RKIND-dx)* dy * dz + temp(i1 ,j1+1,k1 ,1) = temp(i1 ,j1+1,k1 ,1) + & + mass* dx *(1._RKIND-dy)* dz + temp(i1+1,j1+1,k1 ,1) = temp(i1+1,j1+1,k1 ,1) + & + mass*(1._RKIND-dx)*(1._RKIND-dy)* dz + temp(i1 ,j1 ,k1+1,1) = temp(i1 ,j1 ,k1+1,1) + & + mass* dx * dy *(1._RKIND-dz) + temp(i1+1,j1 ,k1+1,1) = temp(i1+1,j1 ,k1+1,1) + & + mass*(1._RKIND-dx)* dy *(1._RKIND-dz) + temp(i1 ,j1+1,k1+1,1) = temp(i1 ,j1+1,k1+1,1) + & + mass* dx *(1._RKIND-dy)*(1._RKIND-dz) + temp(i1+1,j1+1,k1+1,1) = temp(i1+1,j1+1,k1+1,1) + & + mass*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) + ! + temp1 = velx(i,j,k)*mass + if (ihydro .eq. 2) temp1 = & + 0.5_RKIND*(velx(i,j,k)+velx(i+1,j,k))*mass + temp(i1 ,j1 ,k1 ,2) = temp(i1 ,j1 ,k1 ,2) + & + temp1* dx * dy * dz + temp(i1+1,j1 ,k1 ,2) = temp(i1+1,j1 ,k1 ,2) + & + temp1*(1._RKIND-dx)* dy * dz + temp(i1 ,j1+1,k1 ,2) = temp(i1 ,j1+1,k1 ,2) + & + temp1* dx *(1._RKIND-dy)* dz + temp(i1+1,j1+1,k1 ,2) = temp(i1+1,j1+1,k1 ,2) + & + temp1*(1._RKIND-dx)*(1._RKIND-dy)* dz + temp(i1 ,j1 ,k1+1,2) = temp(i1 ,j1 ,k1+1,2) + & + temp1* dx * dy *(1._RKIND-dz) + temp(i1+1,j1 ,k1+1,2) = temp(i1+1,j1 ,k1+1,2) + & + temp1*(1._RKIND-dx)* dy *(1._RKIND-dz) + temp(i1 ,j1+1,k1+1,2) = temp(i1 ,j1+1,k1+1,2) + & + temp1* dx *(1._RKIND-dy)*(1._RKIND-dz) + temp(i1+1,j1+1,k1+1,2) = temp(i1+1,j1+1,k1+1,2) + & + temp1*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) + ! + temp1 = vely(i,j,k)*mass + if (ihydro .eq. 2) temp1 = & + 0.5_RKIND*(vely(i,j,k)+vely(i,j+1,k))*mass + temp(i1 ,j1 ,k1 ,3) = temp(i1 ,j1 ,k1 ,3) + & + temp1* dx * dy * dz + temp(i1+1,j1 ,k1 ,3) = temp(i1+1,j1 ,k1 ,3) + & + temp1*(1._RKIND-dx)* dy * dz + temp(i1 ,j1+1,k1 ,3) = temp(i1 ,j1+1,k1 ,3) + & + temp1* dx *(1._RKIND-dy)* dz + temp(i1+1,j1+1,k1 ,3) = temp(i1+1,j1+1,k1 ,3) + & + temp1*(1._RKIND-dx)*(1._RKIND-dy)* dz + temp(i1 ,j1 ,k1+1,3) = temp(i1 ,j1 ,k1+1,3) + & + temp1* dx * dy *(1._RKIND-dz) + temp(i1+1,j1 ,k1+1,3) = temp(i1+1,j1 ,k1+1,3) + & + temp1*(1._RKIND-dx)* dy *(1._RKIND-dz) + temp(i1 ,j1+1,k1+1,3) = temp(i1 ,j1+1,k1+1,3) + & + temp1* dx *(1._RKIND-dy)*(1._RKIND-dz) + temp(i1+1,j1+1,k1+1,3) = temp(i1+1,j1+1,k1+1,3) + & + temp1*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) + ! + temp1 = velz(i,j,k)*mass + if (ihydro .eq. 2) temp1 = & + 0.5_RKIND*(velz(i,j,k)+velz(i,j,k+1))*mass + temp(i1 ,j1 ,k1 ,4) = temp(i1 ,j1 ,k1 ,4) + & + temp1* dx * dy * dz + temp(i1+1,j1 ,k1 ,4) = temp(i1+1,j1 ,k1 ,4) + & + temp1*(1._RKIND-dx)* dy * dz + temp(i1 ,j1+1,k1 ,4) = temp(i1 ,j1+1,k1 ,4) + & + temp1* dx *(1._RKIND-dy)* dz + temp(i1+1,j1+1,k1 ,4) = temp(i1+1,j1+1,k1 ,4) + & + temp1*(1._RKIND-dx)*(1._RKIND-dy)* dz + temp(i1 ,j1 ,k1+1,4) = temp(i1 ,j1 ,k1+1,4) + & + temp1* dx * dy *(1._RKIND-dz) + temp(i1+1,j1 ,k1+1,4) = temp(i1+1,j1 ,k1+1,4) + & + temp1*(1._RKIND-dx)* dy *(1._RKIND-dz) + temp(i1 ,j1+1,k1+1,4) = temp(i1 ,j1+1,k1+1,4) + & + temp1* dx *(1._RKIND-dy)*(1._RKIND-dz) + temp(i1+1,j1+1,k1+1,4) = temp(i1+1,j1+1,k1+1,4) + & + temp1*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) + enddo + enddo + enddo +!!!!$omp end parallel do + +! +! Use velocity and mass field to generate mass field advanced by dt +! + +!!!!$omp parallel do schedule(static) private(i,j) & +!!!!$omp private(x, i1, dx) & +!!!!$omp private(y, j1, dy) & +!!!!$omp private(z, k1, dz) & +!!!!$omp private(mass, shift1, shift2, shift3) & +!!!!$omp reduction(+:dest) + do k=1, ddim3 + do j=1, ddim2 + do i=1, ddim1 + shift3 = temp(i,j,k,4)/ & + max(temp(i,j,k,1),tiny)*coef3 + z = min(max((k - 0.5_RKIND + shift3), half), edge3) + k1 = int(z + 0.5_RKIND, IKIND) + dz = real(k1, RKIND) + 0.5_RKIND - z + + shift2 = temp(i,j,k,3)/ & + max(temp(i,j,k,1),tiny)*coef2 + y = min(max((j - 0.5_RKIND + shift2), half), edge2) + j1 = int(y + 0.5_RKIND, IKIND) + dy = real(j1, RKIND) + 0.5_RKIND - y + + shift1 = temp(i,j,k,2)/ & + max(temp(i,j,k,1),tiny)*coef1 + x = min(max((i - 0.5_RKIND + shift1), half), edge1) + i1 = int(x + 0.5_RKIND, IKIND) + dx = real(i1, RKIND) + 0.5_RKIND - x +! +! if (i1 .lt. 1 .or. i1 .ge. ddim1 .or. +! j1 .lt. 1 .or. j1 .ge. ddim2 .or. +! k1 .lt. 1 .or. k1 .ge. ddim3 ) +! write(6,*) i1,j1,k1,ddim1,ddim2,ddim3 +! + mass = temp(i,j,k,1) + dest(i1 ,j1 ,k1 ) = dest(i1 ,j1 ,k1 ) + & + mass* dx * dy * dz + dest(i1+1,j1 ,k1 ) = dest(i1+1,j1 ,k1 ) + & + mass*(1._RKIND-dx)* dy * dz + dest(i1 ,j1+1,k1 ) = dest(i1 ,j1+1,k1 ) + & + mass* dx *(1._RKIND-dy)* dz + dest(i1+1,j1+1,k1 ) = dest(i1+1,j1+1,k1 ) + & + mass*(1._RKIND-dx)*(1._RKIND-dy)* dz + dest(i1 ,j1 ,k1+1) = dest(i1 ,j1 ,k1+1) + & + mass* dx * dy *(1._RKIND-dz) + dest(i1+1,j1 ,k1+1) = dest(i1+1,j1 ,k1+1) + & + mass*(1._RKIND-dx)* dy *(1._RKIND-dz) + dest(i1 ,j1+1,k1+1) = dest(i1 ,j1+1,k1+1) + & + mass* dx *(1._RKIND-dy)*(1._RKIND-dz) + dest(i1+1,j1+1,k1+1) = dest(i1+1,j1+1,k1+1) + & + mass*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) + enddo + enddo + enddo +!!!!$omp end parallel do + +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! END PARALLEL REGION +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! + endif + deallocate(temp) + + return +end subroutine dep_grid_cic + + + +!======================================================================= +!/////////////////////// SUBROUTINE INT_GRID_CIC \\\\\\\\\\\\\\\\\\\\\ +! +subroutine int_grid_cic(source, dest, ndim, & + sdim1, sdim2, sdim3, & + ddim1, ddim2, ddim3, & + start1, start2, start3, & + refine1, refine2, refine3) +! +! INTERPOLATE FROM SOURCE GRID INTO DEST +! +! written by: Greg Bryan +! date: March, 1999 +! modified1: +! +! PURPOSE: +! +! INPUTS: +! source - source field +! sdim1-3 - source dimension +! ddim1-3 - destination dimension +! ndim - rank of fields +! start1-3 - start of dest field in dest grid cells (real) +! refine1-3 - refinement factors +! sstart1-3 - source start index +! send1-3 - source end index +! +! OUTPUT ARGUMENTS: +! dest - interpolated field +! +! EXTERNALS: +! +! LOCALS: +! +!----------------------------------------------------------------------- +! + implicit NONE +#include "fortran_types.def" +! +!----------------------------------------------------------------------- +! +! argument declarations +! + INTG_PREC ddim1, ddim2, ddim3, sdim1, sdim2, sdim3, ndim, & + refine1, refine2, refine3 + R_PREC source(sdim1, sdim2, sdim3), dest(ddim1, ddim2, ddim3), & + start1, start2, start3 +! +! locals +! + INTG_PREC i, j, k, i1, j1, k1 + R_PREC fact1, fact2, fact3, x, y, z, dx, dy, dz +! +!\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\/////////////////////////////// +!======================================================================= +! +! Precompute some things +! + fact1 = 1._RKIND/real(refine1, RKIND) + fact2 = 1._RKIND/real(refine2, RKIND) + fact3 = 1._RKIND/real(refine3, RKIND) +! +! a) 1D +! + if (ndim .eq. 1) then + do i=1, ddim1 + x = (start1 + i - 0.5_RKIND)*fact1 + i1 = int(x + 0.5_RKIND, IKIND) + dx = real(i1, RKIND) + 0.5_RKIND - x + dest(i,1,1) = source(i1 ,1 ,1)* dx + & + source(i1+1,1 ,1)*(1._RKIND-dx) + enddo + endif +! +! b) 2D +! + if (ndim .eq. 2) then + do j=1, ddim2 + y = (start2 + j - 0.5_RKIND)*fact2 + j1 = int(y + 0.5_RKIND, IKIND) + dy = real(j1, RKIND) + 0.5_RKIND - y + do i=1, ddim1 + x = (start1 + i - 0.5_RKIND)*fact1 + i1 = int(x + 0.5_RKIND, IKIND) + dx = real(i1, RKIND) + 0.5_RKIND - x + dest(i,j,1) = source(i1 ,j1 ,1)* dx * dy + & + source(i1+1,j1 ,1)*(1._RKIND-dx)* dy + & + source(i1 ,j1+1,1)* dx *(1._RKIND-dy) + & + source(i1+1,j1+1,1)*(1._RKIND-dx)*(1._RKIND-dy) + enddo + enddo + endif +! +! c) 3D +! + if (ndim .eq. 3) then + do k=1, ddim3 + z = (start3 + k - 0.5_RKIND)*fact3 + k1 = int(z + 0.5_RKIND, IKIND) + dz = real(k1, RKIND) + 0.5_RKIND - z + do j=1, ddim2 + y = (start2 + j - 0.5_RKIND)*fact2 + j1 = int(y + 0.5_RKIND, IKIND) + dy = real(j1, RKIND) + 0.5_RKIND - y + do i=1, ddim1 + x = (start1 + i - 0.5_RKIND)*fact1 + i1 = int(x + 0.5_RKIND, IKIND) + dx = real(i1, RKIND) + 0.5_RKIND - x + dest(i,j,k) = & + source(i1 ,j1 ,k1 )* dx * dy * dz + & + source(i1+1,j1 ,k1 )*(1._RKIND-dx)* dy * dz + & + source(i1 ,j1+1,k1 )* dx *(1._RKIND-dy)* dz + & + source(i1+1,j1+1,k1 )*(1._RKIND-dx)*(1._RKIND-dy)* dz + & + source(i1 ,j1 ,k1+1)* dx * dy *(1._RKIND-dz)+ & + source(i1+1,j1 ,k1+1)*(1._RKIND-dx)* dy *(1._RKIND-dz)+ & + source(i1 ,j1+1,k1+1)* dx *(1._RKIND-dy)*(1._RKIND-dz)+ & + source(i1+1,j1+1,k1+1)*(1._RKIND-dx)*(1._RKIND-dy)*(1._RKIND-dz) + enddo + enddo + enddo + endif +! + return +end subroutine int_grid_cic diff --git a/src/enzo/hydro_rk/Grid_UpdateMHDPrim.C b/src/enzo/hydro_rk/Grid_UpdateMHDPrim.C index b97b7b486..ab0e186a9 100644 --- a/src/enzo/hydro_rk/Grid_UpdateMHDPrim.C +++ b/src/enzo/hydro_rk/Grid_UpdateMHDPrim.C @@ -69,8 +69,8 @@ int grid::UpdateMHDPrim(float **dU, float c1, float c2) } } - float *Prim[NEQ_MHD+NSpecies+NColor]; - float *OldPrim[NEQ_MHD+NSpecies+NColor]; + float *Prim[MAX_NUMBER_OF_BARYON_FIELDS]; + float *OldPrim[MAX_NUMBER_OF_BARYON_FIELDS]; this->ReturnHydroRKPointers(Prim, false); this->ReturnOldHydroRKPointers(OldPrim, false); @@ -78,17 +78,17 @@ int grid::UpdateMHDPrim(float **dU, float c1, float c2) int NSpecies_renorm; if (MixSpeciesAndColors) NSpecies_renorm = NSpecies+NColor; - else if (NoMultiSpeciesButColors) { + else { NSpecies_renorm = NSpecies; } - else - switch (MultiSpecies) { //update pure species! not colours! - case 0: NSpecies_renorm = 0; break; - case 1: NSpecies_renorm = 5; break; - case 2: NSpecies_renorm = 8; break; - case 3: NSpecies_renorm = 11; break; - default: NSpecies_renorm = 0; break; - } +// else +// switch (MultiSpecies) { //update pure species! not colours! +// case 0: NSpecies_renorm = 0; break; +// case 1: NSpecies_renorm = 5; break; +// case 2: NSpecies_renorm = 8; break; +// case 3: NSpecies_renorm = 11; break; +// default: NSpecies_renorm = 0; break; +// } // update species for (field = NEQ_MHD; field < NEQ_MHD+NSpecies_renorm; field++) { diff --git a/src/enzo/hydro_rk/Grid_UpdatePrim.C b/src/enzo/hydro_rk/Grid_UpdatePrim.C index 8ab6cf67d..13f22c59e 100644 --- a/src/enzo/hydro_rk/Grid_UpdatePrim.C +++ b/src/enzo/hydro_rk/Grid_UpdatePrim.C @@ -79,62 +79,14 @@ int grid::UpdatePrim(float **dU, float c1, float c2) NSpecies_renorm = NSpecies; } else - switch (MultiSpecies) { //update pure species! not colours! - case 0: NSpecies_renorm = 0; break; - case 1: NSpecies_renorm = 5; break; - case 2: NSpecies_renorm = 8; break; - case 3: NSpecies_renorm = 11; break; - default: NSpecies_renorm = 0; break; - } - - // update species - /* - for (field = NEQ_HYDRO; field < NEQ_HYDRO+NSpecies_renorm; field++) { - n = 0; - n_dU = 0; - for (k = 0; k < GridDimension[2]; k++) { - for (j = 0; j < GridDimension[1]; j++) { - igrid = (k * GridDimension[1] + j) * GridDimension[0]; - for (i = 0; i < GridDimension[0]; i++, n++, igrid++) { - // dU exists only for active region - if (i >= GridStartIndex[0] && i <= GridEndIndex[0] && - j >= GridStartIndex[1] && j <= GridEndIndex[1] && - k >= GridStartIndex[2] && k <= GridEndIndex[2]) - Prim[field][igrid] = c1*OldPrim[field][igrid] + - (1-c1)*Prim[field][igrid]*Prim[iden][igrid] + c2*dU[field][n_dU++]; - D[n] += Prim[field][igrid]; - } - } - } - } - - // renormalize species - - for (field = NEQ_HYDRO; field < NEQ_HYDRO+NSpecies_renorm; field++) { - n = 0; - for (k = 0; k < GridDimension[2]; k++) { - for (j = 0; j < GridDimension[1]; j++) { - igrid = (k * GridDimension[1] + j) * GridDimension[0]; - for (i = 0; i < GridDimension[0]; i++, n++, igrid++) { - Prim[field][igrid] = min(1.0, max((Prim[field][igrid]/D[n]), SmallX)); - Prim[field][igrid] = Prim[field][igrid]/D[n]; - sum[n] += Prim[field][igrid]; - } - } - } - } - - for (field = NEQ_HYDRO; field < NEQ_HYDRO+NSpecies_renorm; field++) { - n = 0; - for (k = 0; k < GridDimension[2]; k++) { - for (j = 0; j < GridDimension[1]; j++) { - igrid = (k * GridDimension[1] + j) * GridDimension[0]; - for (i = 0; i < GridDimension[0]; i++, n++, igrid++) - Prim[field][igrid] /= sum[n]; - } - } - } - */ + NSpecies_renorm = NSpecies; +// switch (MultiSpecies) { //update pure species! not colours! +// case 0: NSpecies_renorm = 0; break; +// case 1: NSpecies_renorm = 5; break; +// case 2: NSpecies_renorm = 8; break; +// case 3: NSpecies_renorm = 11; break; +// default: NSpecies_renorm = 0; break; +// } // ORIGINAL //##### diff --git a/src/enzo/intvarC.C b/src/enzo/intvarC.C new file mode 100644 index 000000000..d8c7af193 --- /dev/null +++ b/src/enzo/intvarC.C @@ -0,0 +1,154 @@ +//======================================================================= +///////////////////////// SUBROUTINE INTVAR \\\\\\\\\\\\\\\\\\\\\\\\\\\ +// +// subroutine intvar(qslice, idim, i1, i2, isteep, steepen, iflatten, +// & flatten, c1, c2, c3, c4, c5, c6, char1, char2, +// & c0, dq, ql, qr, q6, qla, qra, ql0, qr0) +// +// COMPUTES LEFT AND RIGHT EULERIAN INTERFACE VALUES FOR RIEMANN SOLVER +// +// written by: Greg Bryan +// date: March, 1996 +// modified1: January, 2010 by JHW (translated to C++) +// +// PURPOSE: Uses piecewise parabolic interpolation to compute left- +// and right interface values to be fed into Riemann solver during a +// one dimensional sweeps. This version computes the Eulerian corrections +// to the left and right states described in section three of Colella & +// Woodward (1984), JCP. The routine works on a single variable in +// one dimension. +// +// INPUT: +// qslice - one dimensional field of quantity q (one of d,e,u,v...) +// idim - declared dimension of 1D fields +// i1, i2 - start and end indexes of active region +// isteep - steepening flag (1 = on, 0 = off); only apply to density! +// steepen - steepening coefficients +// iflatten - flattening flag (1 = on, 0 = off) +// flatten - flattening coefficients +// c1-6 - precomputed grid coefficients +// char1,2 - characteristic distances for +/- waves (for average) +// c0 - characteristic distance (for lagrangean cell face) +// dq, ql, qr, q6 - 1D field temporaries +// +// OUTPUT: +// qla, qra - left and right state values (from char1,2) +// ql0, qr0 - left and right state values (from c0) +// +// EXTERNALS: +// +// LOCALS: +// +// PARAMETERS: +// ft - a constant used in eq. 1.124 (=2*2/3) +// +//----------------------------------------------------------------------- + +#include +#include +#include "macros_and_parameters.h" +#include "typedefs.h" + +void intvarC(float *qslice, int in, int is, int ie, int j, int isteep, + float *steepen, int iflatten, float *flatten, float *c1, + float *c2, float *c3, float *c4, float *c5, float *c6, + float *char1, float *char2, float *c0, float *dq, float *ql, + float *qr, float *q6, float *qla, float *qra, float *ql0, + float *qr0) +{ + + const double ft = 4.0/3.0; + int i, index, indexm1, indexm2; + float qplus, qmnus, qvanl, temp1, temp2, temp3, temp22, temp23; + indexm1 = j*in+is-1; + indexm2 = indexm1-1; +// +// Compute average linear slopes (eqn 1.7) +// Monotonize (eqn 1.8) +// + for (i = is-2, index = indexm2; i <= ie+2; i++, index++) { + qplus = qslice[index+1] - qslice[index]; + qmnus = qslice[index ] - qslice[index-1]; + qvanl = 2.0 * qplus * qmnus / (qmnus + qplus); + dq[i] = c1[i] * qplus + c2[i] * qmnus; + temp1 = min(min(min(fabsf(dq[i]), 2.0*fabsf(qmnus)), 2.0*fabsf(qplus)), + fabsf(qvanl)); + dq[i] = (qplus*qmnus > 0) ? temp1*sign(dq[i]) : 0.0; + } +// +// Construct left and right values (eqn 1.6) +// + for (i = is-1, index = indexm1; i <= ie+2; i++, index++) { + ql[i] = c3[i] * qslice[index-1] + c4[i] * qslice[index] + + c5[i] * dq[i-1] + c6[i] * dq[i]; + qr[i-1] = ql[i]; + } + +// +// Steepen if asked for (use precomputed steepening parameter) +// + if (isteep) + for (i = is-1, index = indexm1; i <= ie+1; i++, index++) { + ql[i] = (1.0-steepen[i])*ql[i] + + steepen[i]*(qslice[index-1] + 0.5*dq[i-1]); + qr[i] = (1.0-steepen[i])*qr[i] + + steepen[i]*(qslice[index+1] + 0.5*dq[i+1]); + } +// +// Monotonize again (eqn 1.10) +// + for (i = is-1, index = indexm1; i <= ie+1; i++, index++) { + temp1 = (qr[i]-qslice[index])*(qslice[index]-ql[i]); + temp2 = qr[i]-ql[i]; + temp3 = 6.0*(qslice[index]-0.5*(qr[i]+ql[i])); + if (temp1 < 0.0) { + ql[i] = qslice[index]; + qr[i] = qslice[index]; + } + temp22 = temp2*temp2; + temp23 = temp2*temp3; + if (temp22 < temp23) ql[i] = 3.0*qslice[index] - 2.0*qr[i]; + if (temp22 < -temp23) qr[i] = 3.0*qslice[index] - 2.0*ql[i]; + } // ENDFOR i +// +// If requested, flatten slopes with flatteners calculated in calcdiss (4.1) +// + if (iflatten) + for (i = is-1, index = indexm1; i <= ie+1; i++, index++) { + ql[i] = qslice[index]*flatten[i] + ql[i]*(1.0-flatten[i]); + qr[i] = qslice[index]*flatten[i] + qr[i]*(1.0-flatten[i]); + } +// +// Ensure that the L/R values lie between neighboring cell-centered +// values (Taken from ATHENA, lr_states) +// +#define CHECK_LR +#ifdef CHECK_LR + for (i = is-1, index = indexm1; i <= ie+1; i++, index++) { + ql[i] = max(min(qslice[index], qslice[index-1]), ql[i]); + ql[i] = min(max(qslice[index], qslice[index-1]), ql[i]); + qr[i] = max(min(qslice[index], qslice[index+1]), qr[i]); + qr[i] = min(max(qslice[index], qslice[index+1]), qr[i]); + } +#endif +// +// Now construct left and right interface values (eqn 1.12 and 3.3) +// + for (i = is-1, index = indexm1; i <= ie+1; i++, index++) { + q6[i] = 6.0*(qslice[index]-0.5*(ql[i]+qr[i])); + dq[i] = qr[i] - ql[i]; + } + + for (i = is; i <= ie+1; i++) { + qla[i]= qr[i-1]-char1[i-1]*(dq[i-1]-(1.0-ft*char1[i-1])*q6[i-1]); + qra[i]= ql[i ]+char2[i ]*(dq[i ]+(1.0-ft*char2[i ])*q6[i ]); + } + + for (i = is; i <= ie+1; i++) { + ql0[i] = qr[i-1]-c0[i-1]*(dq[i-1]-(1.0-ft*c0[i-1])*q6[i-1]); + qr0[i] = ql[i ]-c0[i ]*(dq[i ]+(1.0+ft*c0[i ])*q6[i ]); + } + + return; + +} diff --git a/src/enzo/macros_and_parameters.h b/src/enzo/macros_and_parameters.h index bb15fd887..4bc0655bf 100644 --- a/src/enzo/macros_and_parameters.h +++ b/src/enzo/macros_and_parameters.h @@ -102,6 +102,8 @@ #define MAX_CROSS_SECTIONS 4 +#define MAX_COMPUTE_TIMERS 5 + #define ROOT_PROCESSOR 0 #define VERSION 2.6 /* current version number */ @@ -648,5 +650,17 @@ typedef long long int HDF5_hid_t; #define TIME_MSG(A) ; #endif +/* Timing macros for load balancing */ +#ifdef USE_MPI +#define START_GRID_TIMER double _mpi_time = MPI_Wtime(); +#define END_GRID_TIMER(A) this->ObservedCost[A] += MPI_Wtime() - _mpi_time; +#define START_LOAD_TIMER double _mpi_time = MPI_Wtime(); +#define END_LOAD_TIMER(A,B) A->AddToCost(B,MPI_Wtime() - _mpi_time); +#else +#define START_GRID_TIMER ; +#define END_GRID_TIMER ; +#define START_LOAD_TIMER ; +#define END_LOAD_TIMER(A) ; +#endif #endif diff --git a/src/enzo/solve_rate_cool.F b/src/enzo/rate_cool_routines.F similarity index 53% rename from src/enzo/solve_rate_cool.F rename to src/enzo/rate_cool_routines.F index 4652d3012..faf80eef8 100644 --- a/src/enzo/solve_rate_cool.F +++ b/src/enzo/rate_cool_routines.F @@ -2,720 +2,6 @@ #include "phys_const.def" #include "error.def" -!======================================================================= -!///////////////////// SUBROUTINE SOLVE_RATE \\\\\\\\\\\\\\\\\\\\\\\\\ - - subroutine solve_rate_cool(d, e, ge, u, v, w, de, - & HI, HII, HeI, HeII, HeIII, - & in, jn, kn, nratec, iexpand, imethod, - & idual, ispecies, imetal, imcool, idust, idim, - & is, js, ks, ie, je, ke, ih2co, ipiht, igammah, - & dx, dt, aye, redshift, temstart, temend, - & utem, uxyz, uaye, urho, utim, - & eta1, eta2, gamma, fh, dtoh, z_solar, - & k1a, k2a, k3a, k4a, k5a, k6a, k7a, k8a, k9a, k10a, - & k11a, k12a, k13a, k13dda, k14a, k15a, - & k16a, k17a, k18a, k19a, k22a, - & k24, k25, k26, k27, k28, k29, k30, k31, - & k50a, k51a, k52a, k53a, k54a, k55a, k56a, - & ndratec, dtemstart, dtemend, h2dusta, - & ncrna, ncrd1a, ncrd2a, - & ceHIa, ceHeIa, ceHeIIa, ciHIa, ciHeIa, - & ciHeISa, ciHeIIa, reHIIa, reHeII1a, - & reHeII2a, reHeIIIa, brema, compa, gammaha, - & comp_xraya, comp_temp, piHI, piHeI, piHeII, - & HM, H2I, H2II, DI, DII, HDI, metal, - & hyd01ka, h2k01a, vibha, rotha, rotla, - & gpldla, gphdla, hdltea, hdlowa, - & gaHIa, gaH2a, gaHea, gaHpa, gaela, - & gasgra, metala, n_xe, xe_start, xe_end, - & inutot, iradtype, nfreq, imetalregen, - & iradshield, avgsighp, avgsighep, avgsighe2p, - & iradtrans, iradcoupled, iradstep, ierr, - & irt_honly, - & kphHI, kphHeI, kphHeII, kdissH2I, - & photogamma, - & ih2optical, iciecool, ithreebody, ciecoa, - & icmbTfloor, iClHeat, - & clEleFra, clGridRank, clGridDim, - & clPar1, clPar2, clPar3, clPar4, clPar5, - & clDataSize, clCooling, clHeating) - -! -! SOLVE MULTI-SPECIES RATE EQUATIONS AND RADIATIVE COOLING -! -! written by: Yu Zhang, Peter Anninos and Tom Abel -! date: -! modified1: January, 1996 by Greg Bryan; converted to KRONOS -! modified2: October, 1996 by GB; adapted to AMR -! modified3: May, 1999 by GB and Tom Abel, 3bodyH2, solver, HD -! modified4: June, 2005 by GB to solve rate & cool at same time -! modified5: April, 2009 by JHW to include radiative transfer -! modified6: September, 2009 by BDS to include cloudy cooling -! -! PURPOSE: -! Solve the multi-species rate and cool equations. -! -! INPUTS: -! in,jn,kn - dimensions of 3D fields -! -! d - total density field -! de - electron density field -! HI,HII - H density fields (neutral & ionized) -! HeI/II/III - He density fields -! DI/II - D density fields (neutral & ionized) -! HDI - neutral HD molecule density field -! HM - H- density field -! H2I - H_2 (molecular H) density field -! H2II - H_2+ density field -! kph* - photoionization fields -! gamma* - photoheating fields -! -! is,ie - start and end indices of active region (zero based) -! idual - dual energy formalism flag (0 = off, 1 = on) -! iexpand - comoving coordinates flag (0 = off, 1 = on) -! idim - dimensionality (rank) of problem -! ispecies - chemistry module (1 - H/He only, 2 - molecular H, 3 - D) -! iradshield - flag for crude radiative shielding correction -! iradtype - type of radiative field (only used if = 8) -! imetal - flag if metal field is active (0 = no, 1 = yes) -! imcool - flag if there is metal cooling -! idust - flag for H2 formation on dust grains -! imethod - Hydro method (0 = PPMDE, 2 = ZEUS-type) -! ih2co - flag to include H2 cooling (1 = on, 0 = off) -! ipiht - flag to include photoionization heating (1 = on, 0 = off) -! iradtrans - flag to include radiative transfer (1 = on, 0 = off) -! iradcoupled - flag to indicate coupled radiative transfer -! iradstep - flag to indicate intermediate coupled radiative transfer timestep -! -! fh - Hydrogen mass fraction (typically 0.76) -! dtoh - Deuterium to H mass ratio -! z_solar - Solar metal mass fraction -! dt - timestep to integrate over -! aye - expansion factor (in code units) -! -! utim - time units (i.e. code units to CGS conversion factor) -! uaye - expansion factor conversion factor (uaye = 1/(1+zinit)) -! urho - density units -! uxyz - length units -! utem - temperature(-like) units -! -! temstart, temend - start and end of temperature range for rate table -! nratec - dimensions of chemical rate arrays (functions of temperature) -! dtemstart, dtemend - start and end of dust temperature range -! ndratec - extra dimension for H2 formation on dust rate (dust temperature) -! -! icmbTfloor - flag to include temperature floor from cmb -! iClHeat - flag to include cloudy heating -! clEleFra - parameter to account for additional electrons from metals -! clGridRank - rank of cloudy cooling data grid -! clGridDim - array containing dimensions of cloudy data -! clPar1, clPar2, clPar3, clPar4, clPar5 - arrays containing cloudy grid parameter values -! clDataSize - total size of flattened 1D cooling data array -! clCooling - cloudy cooling data -! clHeating - cloudy heating data -! -! OUTPUTS: -! update chemical rate densities (HI, HII, etc) -! -! PARAMETERS: -! itmax - maximum allowed sub-cycle iterations -! -!----------------------------------------------------------------------- - - implicit NONE -#include "fortran_types.def" - -! General Arguments - - INTG_PREC in, jn, kn, is, js, ks, ie, je, ke, nratec, imethod, - & idual, iexpand, ih2co, ipiht, ispecies, imetal, idim, - & iradtype, nfreq, imetalregen, iradshield, iradtrans, - & iradcoupled, iradstep, n_xe, ierr, imcool, idust, - & irt_honly, igammah, ih2optical, iciecool, ithreebody, - & ndratec - P_PREC dx - R_PREC dt, aye, temstart, temend, eta1, eta2, gamma, - & utim, uxyz, uaye, urho, utem, fh, dtoh, z_solar, - & xe_start, xe_end, dtemstart, dtemend, redshift - -! Density, energy and velocity fields fields - - R_PREC de(in,jn,kn), HI(in,jn,kn), HII(in,jn,kn), - & HeI(in,jn,kn), HeII(in,jn,kn), HeIII(in,jn,kn) - R_PREC HM(in,jn,kn), H2I(in,jn,kn), H2II(in,jn,kn) - R_PREC DI(in,jn,kn), DII(in,jn,kn), HDI(in,jn,kn) - R_PREC d(in,jn,kn), ge(in,jn,kn), e(in,jn,kn), - & u(in,jn,kn), v(in,jn,kn), w(in,jn,kn), - & metal(in,jn,kn) - -! Radiation fields - - R_PREC kphHI(in,jn,kn), kphHeI(in,jn,kn), kphHeII(in,jn,kn), - & kdissH2I(in,jn,kn) - R_PREC photogamma(in,jn,kn) - -! Cooling tables (coolings rates as a function of temperature) - - R_PREC hyd01ka(nratec), h2k01a(nratec), vibha(nratec), - & rotha(nratec), rotla(nratec), gpldla(nratec), - & gphdla(nratec), hdltea(nratec), hdlowa(nratec) - R_PREC gaHIa(nratec), gaH2a(nratec), gaHea(nratec), - & gaHpa(nratec), gaela(nratec), gasgra(nratec), - & ciecoa(nratec) - R_PREC ceHIa(nratec), ceHeIa(nratec), ceHeIIa(nratec), - & ciHIa(nratec), ciHeIa(nratec), ciHeISa(nratec), - & ciHeIIa(nratec), reHIIa(nratec), reHeII1a(nratec), - & reHeII2a(nratec), reHeIIIa(nratec), brema(nratec) - R_PREC metala(nratec, n_xe) - R_PREC compa, piHI, piHeI, piHeII, comp_xraya, comp_temp, - & inutot(nfreq), avgsighp, avgsighep, avgsighe2p - R_PREC gammaha - -! Chemistry tables (rates as a function of temperature) - - R_PREC k1a (nratec), k2a (nratec), k3a (nratec), k4a (nratec), - & k5a (nratec), k6a (nratec), k7a (nratec), k8a (nratec), - & k9a (nratec), k10a(nratec), k11a(nratec), k12a(nratec), - & k13a(nratec), k14a(nratec), k15a(nratec), k16a(nratec), - & k17a(nratec), k18a(nratec), k19a(nratec), k22a(nratec), - & k50a(nratec), k51a(nratec), k52a(nratec), k53a(nratec), - & k54a(nratec), k55a(nratec), k56a(nratec), - & k13dda(nratec, 7), h2dusta(nratec, ndratec), - & ncrna(nratec), ncrd1a(nratec), ncrd2a(nratec), - & k24, k25, k26, k27, k28, k29, k30, k31 - -! Cloudy cooling data - - INTG_PREC icmbTfloor, iClHeat, clGridRank, clDataSize - INTG_PREC clGridDim(5) - R_PREC clEleFra - R_PREC clPar1(clGridDim(1)), clPar2(clGridDim(2)), - & clPar3(clGridDim(3)), clPar4(clGridDim(4)), - & clPar5(clGridDim(5)) - R_PREC clCooling(clDataSize), clHeating(clDataSize) - -! Parameters - - INTG_PREC itmax, ijk - parameter (itmax = 10000, ijk = MAX_ANY_SINGLE_DIRECTION) - -#ifdef CONFIG_BFLOAT_4 - R_PREC tolerance - parameter (tolerance = 1.e-5_RKIND) -#endif - -#ifdef CONFIG_BFLOAT_8 - R_PREC tolerance - parameter (tolerance = 1.e-10_RKIND) -#endif - - -! Locals - - INTG_PREC i, j, k, iter - INTG_PREC clGridDim1, clGridDim2, clGridDim3, clGridDim4, - & clGridDim5 - R_PREC ttmin, dom, energy, comp1, comp2 - real*8 coolunit, dbase1, tbase1, xbase1, chunit, uvel - real*8 heq1, heq2, eqk221, eqk222, eqk131, eqk132, - & eqt1, eqt2, eqtdef, dheq, heq, dlogtem, dx_cgs - -! row temporaries - - INTG_PREC indixe(ijk) - R_PREC t1(ijk), t2(ijk), logtem(ijk), tdef(ijk), - & dtit(ijk), ttot(ijk), p2d(ijk), tgas(ijk), tgasold(ijk), - & tdust(ijk), metallicity(ijk), rhoH(ijk), olddtit - -! Rate equation row temporaries - - R_PREC HIp(ijk), HIIp(ijk), HeIp(ijk), HeIIp(ijk), HeIIIp(ijk), - & HMp(ijk), H2Ip(ijk), H2IIp(ijk), - & dep(ijk), dedot(ijk),HIdot(ijk), dedot_prev(ijk), - & DIp(ijk), DIIp(ijk), HDIp(ijk), HIdot_prev(ijk), - & k24shield(ijk), k25shield(ijk), k26shield(ijk), - & k31shield(ijk) - R_PREC k1 (ijk), k2 (ijk), k3 (ijk), k4 (ijk), k5 (ijk), - & k6 (ijk), k7 (ijk), k8 (ijk), k9 (ijk), k10(ijk), - & k11(ijk), k12(ijk), k13(ijk), k14(ijk), k15(ijk), - & k16(ijk), k17(ijk), k18(ijk), k19(ijk), k22(ijk), - & k50(ijk), k51(ijk), k52(ijk), k53(ijk), k54(ijk), - & k55(ijk), k56(ijk), k13dd(ijk, 7), h2dust(ijk), - & ncrn(ijk), ncrd1(ijk), ncrd2(ijk) - -! Cooling/heating row locals - - real*8 ceHI(ijk), ceHeI(ijk), ceHeII(ijk), - & ciHI(ijk), ciHeI(ijk), ciHeIS(ijk), ciHeII(ijk), - & reHII(ijk), reHeII1(ijk), reHeII2(ijk), reHeIII(ijk), - & brem(ijk), edot(ijk) - R_PREC hyd01k(ijk), h2k01(ijk), vibh(ijk), roth(ijk), rotl(ijk), - & gpldl(ijk), gphdl(ijk), hdlte(ijk), hdlow(ijk), cieco(ijk) - -! Iteration mask - - LOGIC_PREC itmask(ijk) -! -!\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\///////////////////////////////// -!======================================================================= - -! Set error indicator - - ierr = 0 - -! Set units - - dom = urho*(aye**3)/mass_h - tbase1 = utim - xbase1 = uxyz/(aye*uaye) ! uxyz is [x]*a = [x]*[a]*a' ' - dbase1 = urho*(aye*uaye)**3 ! urho is [dens]/a^3 = [dens]/([a]*a')^3 ' - coolunit = (uaye**5 * xbase1**2 * mass_h**2) / - & (tbase1**3 * dbase1) - uvel = uxyz / utim -c chunit = (7.17775e-12_RKIND)/(2._RKIND*uvel*uvel*mass_h) ! 4.5 eV per H2 formed - chunit = (ev2erg)/(2._RKIND*uvel*uvel*mass_h) ! 1 eV per H2 formed - - dx_cgs = dx * xbase1; - dlogtem = (log(temend) - log(temstart))/REAL(nratec-1,RKIND) - -! Convert densities from comoving to proper - - call scale_fields(d, de, HI, HII, HeI, HeII, HeIII, - & HM, H2I, H2II, DI, DII, HDI, metal, - & is, ie, js, je, ks, ke, - & in, jn, kn, ispecies, imetal, aye**(-3)) - - call ceiling_species(d, de, HI, HII, HeI, HeII, HeIII, - & HM, H2I, H2II, DI, DII, HDI, metal, - & is, ie, js, je, ks, ke, - & in, jn, kn, ispecies, imetal) - -! Loop over zones, and do an entire i-column in one go - - do k = ks+1, ke+1 - do j = js+1, je+1 - -! tolerance = 1.0e-06 * dt - -! Set iteration mask to include only cells with radiation in the -! intermediate coupled chemistry / energy step - - if (iradcoupled .eq. 1 .and. iradstep .eq. 1) then - do i = is+1, ie+1 - if (kphHI(i,j,k) .gt. 0) then - itmask(i) = .true. - else - itmask(i) = .false. - endif - enddo - endif - -! Normal rate solver, but don't double-count the cells with radiation - - if (iradcoupled .eq. 1 .and. iradstep .eq. 0) then - do i = is+1, ie+1 - if (kphHI(i,j,k) .gt. 0) then - itmask(i) = .false. - else - itmask(i) = .true. - endif - enddo - endif - -! No radiation timestep coupling - - if (iradcoupled .eq. 0 .or. iradtrans .eq. 0) then - do i = is+1, ie+1 - itmask(i) = .true. - enddo - endif - -! Set time elapsed to zero for each cell in 1D section - - do i = is+1, ie+1 - ttot(i) = 0._RKIND - enddo - -! ------------------ Loop over subcycles ---------------- - - do iter = 1, itmax - -! Compute the cooling rate, tgas, tdust, and metallicity for this row - - call cool1d_multi( - & d, e, ge, u, v, w, de, HI, HII, HeI, HeII, HeIII, - & in, jn, kn, nratec, idual, imethod, - & iexpand, ispecies, imetal, imcool, idust, idim, - & is, ie, j, k, ih2co, ipiht, iter, igammah, - & aye, redshift, temstart, temend, z_solar, - & utem, uxyz, uaye, urho, utim, - & eta1, eta2, gamma, - & ceHIa, ceHeIa, ceHeIIa, ciHIa, ciHeIa, - & ciHeISa, ciHeIIa, reHIIa, reHeII1a, - & reHeII2a, reHeIIIa, brema, compa, gammaha, - & comp_xraya, comp_temp, - & piHI, piHeI, piHeII, comp1, comp2, - & HM, H2I, H2II, DI, DII, HDI, metal, - & hyd01ka, h2k01a, vibha, rotha, rotla, - & hyd01k, h2k01, vibh, roth, rotl, - & gpldla, gphdla, gpldl, gphdl, - & hdltea, hdlowa, hdlte, hdlow, - & gaHIa, gaH2a, gaHea, gaHpa, gaela, - & gasgra, metala, n_xe, xe_start, xe_end, - & ceHI, ceHeI, ceHeII, ciHI, ciHeI, ciHeIS, ciHeII, - & reHII, reHeII1, reHeII2, reHeIII, brem, - & indixe, t1, t2, logtem, tdef, edot, - & tgas, tgasold, p2d, tdust, metallicity, rhoH, - & inutot, iradtype, nfreq, imetalregen, - & iradshield, avgsighp, avgsighep, avgsighe2p, - & iradtrans, photogamma, - & ih2optical, iciecool, ciecoa, cieco, - & icmbTfloor, iClHeat, - & clEleFra, clGridRank, clGridDim, - & clPar1, clPar2, clPar3, clPar4, clPar5, - & clDataSize, clCooling, clHeating, - & itmask) - -! Look-up rates as a function of temperature for 1D set of zones -! (maybe should add itmask to this call) - - call lookup_cool_rates1d(temstart, temend, nratec, j, k, - & is, ie, ijk, iradtype, iradshield, ithreebody, - & in, jn, kn, ispecies, idust, tgas, d, HI, HII, - & HeI, HeII, H2I, tdust, metallicity, - & k1a, k2a, k3a, k4a, k5a, k6a, k7a, k8a, k9a, k10a, - & k11a, k12a, k13a, k13dda, k14a, k15a, k16a, - & k17a, k18a, k19a, k22a, - & k50a, k51a, k52a, k53a, k54a, k55a, k56a, - & ndratec, dtemstart, dtemend, h2dusta, - & ncrna, ncrd1a, ncrd2a, - & avgsighp, avgsighep, avgsighe2p, piHI, piHeI, - & k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, - & k11, k12, k13, k14, k15, k16, k17, k18, - & k19, k22, k24, k25, k26, k31, - & k50, k51, k52, k53, k54, k55, - & k56, k13dd, k24shield, k25shield, k26shield, - & k31shield, h2dust, ncrn, ncrd1, ncrd2, - & t1, t2, tdef, logtem, indixe, - & dom, coolunit, tbase1, xbase1, dx_cgs, iradtrans, - & kdissH2I, itmask) - -! Compute dedot and HIdot, the rates of change of de and HI -! (should add itmask to this call) - - call rate_timestep(dedot, HIdot, ispecies, idust, - & de, HI, HII, HeI, HeII, HeIII, d, - & HM, H2I, H2II, - & in, jn, kn, is, ie, j, k, - & k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, - & k12, k13, k14, k15, k16, k17, k18, k19, k22, - & k24, k25, k26, k27, k28, k29, k30, - & k50, k51, k52, k53, k54, k55, k56, - & h2dust, ncrn, ncrd1, ncrd2, rhoH, - & k24shield, k25shield, k26shield, k31shield, - & iradtrans, irt_honly, kphHI, kphHeI, kphHeII, - & itmask, edot, chunit, dom) - -! Find timestep that keeps relative chemical changes below 10% - - do i = is+1, ie+1 - if (itmask(i)) then -! Bound from below to prevent numerical errors - - if (abs(dedot(i)) < tiny) - & dedot(i) = min(REAL(tiny,RKIND),de(i,j,k)) - if (abs(HIdot(i)) < tiny) - & HIdot(i) = min(REAL(tiny,RKIND),HI(i,j,k)) - -! If the net rate is almost perfectly balanced then set -! it to zero (since it is zero to available precision) - - if (min(abs(k1(i)* de(i,j,k)*HI(i,j,k)), - & abs(k2(i)*HII(i,j,k)*de(i,j,k)))/ - & max(abs(dedot(i)),abs(HIdot(i))) - & > 1.e6_RKIND) then - dedot(i) = tiny - HIdot(i) = tiny - endif - -! If the iteration count is high then take the smaller of -! the calculated dedot and last time step's actual dedot. -! This is intended to get around the problem of a low -! electron or HI fraction which is in equilibrium with high -! individual terms (which all nearly cancel). - - if (iter > 50) then - dedot(i) = min(abs(dedot(i)), abs(dedot_prev(i))) - HIdot(i) = min(abs(HIdot(i)), abs(HIdot_prev(i))) - endif - -! compute minimum rate timestep - - olddtit = dtit(i) - dtit(i) = min(abs(0.1_RKIND*de(i,j,k)/dedot(i)), - & abs(0.1_RKIND*HI(i,j,k)/HIdot(i)), - & dt-ttot(i), 0.5_RKIND*dt) - - if ( d(i,j,k)*dom > 1.e8 .and. - & edot(i) > 0.0 .and. - & ispecies > 1 .and. - & ( iradtrans .eq. 0 .or. - & (iradtrans .eq. 1 .and. kphHI(i,j,k) < 0.0) ) - & ) then - ! Equilibrium value for H is: - ! H = (-1.0 / (4*k22)) * (k13 - sqrt(8 k13 k22 rho + k13^2)) - ! We now want this to change by 10% or less, but we're only - ! differentiating by dT. We have de/dt. We need dT/de. - ! T = (g-1)*p2d*utem/N; tgas == (g-1)(p2d*utem/N) - ! dH_eq / dt = (dH_eq/dT) * (dT/de) * (de/dt) - ! dH_eq / dT (see above; we can calculate the derivative here) - ! dT / de = utem * (gamma - 1.0) / N == tgas / p2d - ! de / dt = edot - ! Now we use our estimate of dT/de to get the estimated - ! difference in the equilibrium - eqt2 = min(log(tgas(i)) + 0.1_RKIND*dlogtem, t2(i)) - eqtdef = (eqt2 - t1(i))/(t2(i) - t1(i)) - eqk222 = k22a(indixe(i)) + - & (k22a(indixe(i)+1) -k22a(indixe(i)))*eqtdef - eqk132 = k13a(indixe(i)) + - & (k13a(indixe(i)+1) -k13a(indixe(i)))*eqtdef - heq2 = (-1._RKIND / (4._RKIND*eqk222)) * (eqk132- - & sqrt(8._RKIND*eqk132*eqk222*fh*d(i,j,k) - & +eqk132**2._RKIND)) - - eqt1 = max(log(tgas(i)) - 0.1_RKIND*dlogtem, t1(i)) - eqtdef = (eqt1 - t1(i))/(t2(i) - t1(i)) - eqk221 = k22a(indixe(i)) + - & (k22a(indixe(i)+1) -k22a(indixe(i)))*eqtdef - eqk131 = k13a(indixe(i)) + - & (k13a(indixe(i)+1) -k13a(indixe(i)))*eqtdef - heq1 = (-1._RKIND / (4._RKIND*eqk221)) * (eqk131- - & sqrt(8._RKIND*eqk131*eqk221*fh*d(i,j,k) - & +eqk131**2._RKIND)) - - dheq = (abs(heq2-heq1)/(exp(eqt2) - exp(eqt1))) - & * (tgas(i)/p2d(i)) * edot(i) - heq = (-1._RKIND / (4._RKIND*k22(i))) * (k13(i)- - & sqrt(8._RKIND*k13(i)*k22(i)*fh*d(i,j,k) - & +k13(i)**2._RKIND)) - !write(0,*) heq2, heq1, eqt2, eqt1, tgas(i), p2d(i), -! & edot(i) - if(d(i,j,k)*dom>1e18 .and. i==4)write(0,*) - & HI(i,j,k)/heq, edot(i),tgas(i) - dtit(i) = min(dtit(i), 0.1d0*heq/dheq) - endif - if (iter.gt.10) dtit(i) = min(olddtit*1.5d0, dtit(i)) - -#define DONT_WRITE_COOLING_DEBUG -#ifdef WRITE_COOLING_DEBUG -! Output some debugging information if required - - if (dtit(i)/dt > 1.e-2 .and. iter > 800 - & .and. abs((dt-ttot(i))/dt) > 1.e-3) then - write(4,1000) iter,i,j,k,dtit(i), - & ttot(i),dt,de(i,j,k),dedot(i),HI(i,j,k),HIdot(i), - & tgas(i), dedot_prev(i), HIdot_prev(i) - write(4,1100) HI(i,j,k),HII(i,j,k), - & HeI(i,j,k),HeII(i,j,k),HeIII(i,j,k), - & HM(i,j,k),H2I(i,j,k),H2II(i,j,k),de(i,j,k) - write(4,1100) - & - k1(i) *de(i,j,k) *HI(i,j,k) , - & - k7(i) *de(i,j,k) *HI(i,j,k), - & - k8(i) *HM(i,j,k) *HI(i,j,k), - & - k9(i) *HII(i,j,k) *HI(i,j,k), - & - k10(i)*H2II(i,j,k) *HI(i,j,k)/2._RKIND, - & - 2._RKIND*k22(i)*HI(i,j,k)**2 *HI(i,j,k), - & + k2(i) *HII(i,j,k) *de(i,j,k) , - & + 2._RKIND*k13(i)*HI(i,j,k) *H2I(i,j,k)/2._RKIND, - & + k11(i)*HII(i,j,k) *H2I(i,j,k)/2._RKIND, - & + 2._RKIND*k12(i)*de(i,j,k) *H2I(i,j,k)/2._RKIND, - & + k14(i)*HM(i,j,k) *de(i,j,k), - & + k15(i)*HM(i,j,k) *HI(i,j,k), - & + 2._RKIND*k16(i)*HM(i,j,k) *HII(i,j,k), - & + 2._RKIND*k18(i)*H2II(i,j,k) *de(i,j,k)/2._RKIND, - & + k19(i)*H2II(i,j,k) *HM(i,j,k)/2._RKIND - endif - 1000 format(i5,3(i3,1x),1p,11(e11.3)) - 1100 format(1p,20(e11.3)) -#endif /* WRITE_COOLING_DEBUG */ - else ! itmask - dtit(i) = dt; - endif - enddo ! end loop over i - -! Compute maximum timestep for cooling/heating - - do i = is+1, ie+1 - if (itmask(i)) then -! Set energy per unit volume of this cell based in the pressure -! (the gamma used here is the right one even for H2 since p2d -! is calculated with this gamma). - - energy = max(p2d(i)/(gamma-1._RKIND), tiny) - -! This is an alternate energy calculation, based directly on -! the code's specific energy field, which differs from the above -! only if using the dual energy formalism. - -! energy = max(ge(i,j,k)*d(i,j,k), p2d(i)/(gamma-1.0), -! & tiny) -! if (energy < tiny) energy = d(i,j,k)*(e(i,j,k) - -! & 0.5*(u(i,j,k)**2 + v(i,j,k)**2 + w(i,j,k)**2)) - -! If the temperature is at the bottom of the temperature look-up -! table and edot < 0, then shut off the cooling. - - if (tgas(i) <= 1.01_RKIND*temstart .and. - & edot(i) < 0.0) edot(i) = tiny - if (abs(edot(i)) < tiny) edot(i) = tiny -! -! Compute timestep for 10% change - -! if (iter > 100) then -! dtit(i) = min(REAL(abs(0.1*energy/edot(i)),RKIND), -! & dt-ttot(i), dtit(i)) -! else - dtit(i) = min(REAL(abs(0.1_RKIND*energy/edot(i)),RKIND), - & dt-ttot(i), dtit(i)) -! endif - - if (dtit(i) .ne. dtit(i)) !##### - & write(6,*) 'HUGE dtit :: ', energy, edot(i), dtit(i), - & dt, ttot(i), abs(0.1_RKIND*energy/edot(i)), - & REAL(abs(0.1_RKIND*energy/edot(i)),RKIND) - -#define NO_FORTRAN_DEBUG -#ifdef FORTRAN_DEBUG - if (ge(i,j,k) <= 0.0 .and. idual == 1) - & write(6,*) 'a',ge(i,j,k),energy,d(i,j,k),e(i,j,k),iter - if (idual == 1 .and. - & ge(i,j,k)+edot(i)/d(i,j,k)*dtit(i) <= 0.0) - & write(6,*) i,j,k,iter,ge(i,j,k),edot(i),tgas(i), - & energy,de(i,j,k),ttot(i),d(i,j,k),e(i,j,k) -#endif /* FORTRAN_DEBUG */ - -#ifdef WRITE_COOLING_DEBUG -! If the timestep is too small, then output some debugging info - - if (((dtit(i)/dt < 1.e-2 .and. iter > 800) - & .or. iter > itmax-100) .and. - & abs((dt-ttot(i))/dt) > 1.e-3) - & write(3,2000) i,j,k,iter,ge(i,j,k),edot(i),tgas(i), - & energy,de(i,j,k),ttot(i),d(i,j,k),e(i,j,k),dtit(i) - 2000 format(4(i4,1x),1p,10(e14.3)) -#endif /* WRITE_COOLING_DEBUG */ - endif ! itmask - enddo ! end loop over i - -! Update total and gas energy - - do i = is+1, ie+1 - if (itmask(i)) then - e(i,j,k) = e(i,j,k) + edot(i)/d(i,j,k)*dtit(i) -#ifdef WRITE_COOLING_DEBUG - if (e(i,j,k) .ne. e(i,j,k)) - & write(3,*) edot(i),d(i,j,k),dtit(i) -#endif /* WRITE_COOLING_DEBUG */ - -! If using the dual energy formalism, there are 2 energy fields - - if (idual == 1) then - ge(i,j,k) = ge(i,j,k) + edot(i)/d(i,j,k)*dtit(i) - -! Alternate energy update schemes (not currently used) - -! ge(i,j,k) = max(ge(i,j,k) + edot(i)/d(i,j,k)*dtit(i), -! & 0.5_RKIND*ge(i,j,k)) -! if (ge(i,j,k) <= tiny) ge(i,j,k) = (energy + -! & edot(i)*dtit(i))/d(i,j,k) -#ifdef WRITE_COOLING_DEBUG - if (ge(i,j,k) <= 0.0) write(3,*) - & 'a',ge(i,j,k),energy,d(i,j,k),e(i,j,k),iter -#endif /* WRITE_COOLING_DEBUG */ - endif - endif ! itmask - enddo - -! Solve rate equations with one linearly implicit Gauss-Seidel -! sweep of a backward Euler method --- - - call step_rate(de, HI, HII, HeI, HeII, HeIII, d, - & HM, H2I, H2II, DI, DII, HDI, dtit, - & in, jn, kn, is, ie, j, k, ispecies, idust, - & k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, - & k12, k13, k14, k15, k16, k17, k18, k19, k22, - & k24, k25, k26, k27, k28, k29, k30, - & k50, k51, k52, k53, k54, k55, k56, - & h2dust, rhoH, - & k24shield, k25shield, k26shield, k31shield, - & HIp, HIIp, HeIp, HeIIp, HeIIIp, dep, - & HMp, H2Ip, H2IIp, DIp, DIIp, HDIp, - & dedot_prev, HIdot_prev, - & iradtrans, irt_honly, kphHI, kphHeI, kphHeII, - & itmask) - -! Add the timestep to the elapsed time for each cell and find -! minimum elapsed time step in this row - - ttmin = huge - do i = is+1, ie+1 - ttot(i) = min(ttot(i) + dtit(i), dt) - if (abs(dt-ttot(i)) < 0.001_RKIND*dt) - & itmask(i) = .false. - if (ttot(i) itmax) then - write(0,*) 'inside if statement solve rate cool:',is,ie - write(6,*) 'MULTI_COOL iter > ',itmax,' at j,k =',j,k - write(0,*) 'FATAL error (2) in MULTI_COOL' - write(0,'(" dt = ",1pe10.3," ttmin = ",1pe10.3)') dt, ttmin - write(0,'((16(1pe8.1)))') (dtit(i),i=is+1,ie+1) - write(0,'((16(1pe8.1)))') (ttot(i),i=is+1,ie+1) - write(0,'((16(1pe8.1)))') (edot(i),i=is+1,ie+1) - write(0,'((16(l3)))') (itmask(i),i=is+1,ie+1) - WARNING_MESSAGE - endif - - if (iter > itmax/2) then - write(6,*) 'MULTI_COOL iter,j,k =',iter,j,k - end if -! -! Next j,k -! - enddo - enddo - -! Convert densities back to comoving from proper - - call scale_fields(d, de, HI, HII, HeI, HeII, HeIII, - & HM, H2I, H2II, DI, DII, HDI, metal, - & is, ie, js, je, ks, ke, - & in, jn, kn, ispecies, imetal, aye**3) - -! Correct the species to ensure consistency (i.e. type conservation) - - call make_consistent(de, HI, HII, HeI, HeII, HeIII, - & HM, H2I, H2II, DI, DII, HDI, metal, - & d, is, ie, js, je, ks, ke, - & in, jn, kn, ispecies, imetal, fh, dtoh) - - return - end - c ----------------------------------------------------------- ! This routine scales the density fields from comoving to ! proper densities (and back again). @@ -758,7 +44,7 @@ subroutine scale_fields(d, de, HI, HII, HeI, HeII, HeIII, enddo enddo enddo - if (ispecies > 1) then + if (ispecies .gt. 1) then do k = ks+1, ke+1 do j = js+1, je+1 do i = is+1, ie+1 @@ -769,7 +55,7 @@ subroutine scale_fields(d, de, HI, HII, HeI, HeII, HeIII, enddo enddo endif - if (ispecies > 2) then + if (ispecies .gt. 2) then do k = ks+1, ke+1 do j = js+1, je+1 do i = is+1, ie+1 @@ -780,7 +66,7 @@ subroutine scale_fields(d, de, HI, HII, HeI, HeII, HeIII, enddo enddo endif - if (imetal == 1) then + if (imetal .eq. 1) then do k = ks+1, ke+1 do j = js+1, je+1 do i = is+1, ie+1 @@ -833,7 +119,7 @@ subroutine ceiling_species(d, de, HI, HII, HeI, HeII, HeIII, enddo enddo enddo - if (ispecies > 1) then + if (ispecies .gt. 1) then do k = ks+1, ke+1 do j = js+1, je+1 do i = is+1, ie+1 @@ -844,7 +130,7 @@ subroutine ceiling_species(d, de, HI, HII, HeI, HeII, HeIII, enddo enddo endif - if (ispecies > 2) then + if (ispecies .gt. 2) then do k = ks+1, ke+1 do j = js+1, je+1 do i = is+1, ie+1 @@ -855,12 +141,12 @@ subroutine ceiling_species(d, de, HI, HII, HeI, HeII, HeIII, enddo enddo endif - if (imetal == 1) then + if (imetal .eq. 1) then do k = ks+1, ke+1 do j = js+1, je+1 do i = is+1, ie+1 - metal(i,j,k) = min(max(metal(i,j,k), - & tiny), 0.9_RKIND*d(i,j,k)) + metal(i,j,k) = min(max(metal(i,j,k), tiny), + $ 0.9_RKIND*d(i,j,k)) enddo enddo enddo @@ -877,7 +163,7 @@ subroutine ceiling_species(d, de, HI, HII, HeI, HeII, HeIII, ! of temperature. subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, - & is, ie, ijk, iradtype, iradshield, ithreebody, + & is, ie, imax, iradtype, iradshield, ithreebody, & in, jn, kn, ispecies, idust, tgas1d, d, HI, HII, & HeI, HeII, H2I, tdust, metallicity, & k1a, k2a, k3a, k4a, k5a, k6a, k7a, k8a, k9a, k10a, @@ -903,13 +189,13 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, ! Arguments - INTG_PREC is, ie, ijk, iradtype, iradshield, nratec, + INTG_PREC is, ie, imax, iradtype, iradshield, nratec, & in, jn, kn, ispecies, ithreebody, j, k, & idust, ndratec, iradtrans R_PREC temstart, temend, tgas1d(in), dom, & dtemstart, dtemend real*8 coolunit, tbase1, xbase1, dx_cgs - LOGIC_PREC itmask(ijk) + LOGIC_PREC itmask(imax) ! Chemistry rates as a function of temperature @@ -936,27 +222,27 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, ! Returned rate values - R_PREC k1 (ijk), k2 (ijk), k3 (ijk), k4 (ijk), k5 (ijk), - & k6 (ijk), k7 (ijk), k8 (ijk), k9 (ijk), k10(ijk), - & k11(ijk), k12(ijk), k13(ijk), k14(ijk), k15(ijk), - & k16(ijk), k17(ijk), k18(ijk), k19(ijk), k22(ijk), - & k50(ijk), k51(ijk), k52(ijk), k53(ijk), k54(ijk), - & k55(ijk), k56(ijk), k13dd(ijk, 7), h2dust(ijk), - & ncrn(ijk), ncrd1(ijk), ncrd2(ijk), - & k24shield(ijk), k25shield(ijk), k26shield(ijk), - & k31shield(ijk) + R_PREC k1 (imax), k2 (imax), k3 (imax), k4 (imax), k5 (imax), + & k6 (imax), k7 (imax), k8 (imax), k9 (imax), k10(imax), + & k11(imax), k12(imax), k13(imax), k14(imax), k15(imax), + & k16(imax), k17(imax), k18(imax), k19(imax), k22(imax), + & k50(imax), k51(imax), k52(imax), k53(imax), k54(imax), + & k55(imax), k56(imax), k13dd(imax, 7), h2dust(imax), + & ncrn(imax), ncrd1(imax), ncrd2(imax), + & k24shield(imax), k25shield(imax), k26shield(imax), + & k31shield(imax) ! 1D temporaries (passed in) - INTG_PREC indixe(ijk) - R_PREC t1(ijk), t2(ijk), logtem(ijk), tdef(ijk), - & tdust(ijk), metallicity(ijk) + INTG_PREC indixe(imax) + R_PREC t1(imax), t2(imax), logtem(imax), tdef(imax), + & tdust(imax), metallicity(imax) ! 1D temporaries (not passed in) - INTG_PREC d_indixe(ijk) - R_PREC d_t1(ijk), d_t2(ijk), d_logtem(ijk), d_tdef(ijk), - & dusti1(ijk), dusti2(ijk), divrhoa(6) + INTG_PREC d_indixe(imax) + R_PREC d_t1(imax), d_t2(imax), d_logtem(imax), d_tdef(imax), + & dusti1(imax), dusti2(imax), divrhoa(6) ! Parameters @@ -975,7 +261,7 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, logtem0 = log(temstart) logtem9 = log(temend) - dlogtem = (log(temend) - log(temstart))/REAL(nratec-1,RKIND) + dlogtem = (log(temend) - log(temstart))/real(nratec-1, RKIND) do i = is+1, ie+1 if (itmask(i)) then @@ -988,8 +274,8 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, ! Find index into tble and precompute interpolation values - indixe(i) = min(nratec-1, max(1, - & int((logtem(i)-logtem0)/dlogtem,IKIND)+1)) + indixe(i) = min(nratec-1, + & max(1,int((logtem(i)-logtem0)/dlogtem)+1)) t1(i) = (logtem0 + (indixe(i) - 1)*dlogtem) t2(i) = (logtem0 + (indixe(i) )*dlogtem) tdef(i) = (logtem(i) - t1(i)) / (t2(i) - t1(i)) @@ -1013,7 +299,7 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, ! Look-up for 9-species model - if (ispecies > 1) then + if (ispecies .gt. 1) then do i = is+1, ie+1 if (itmask(i)) then k7(i) = k7a(indixe(i)) + @@ -1071,7 +357,7 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, ! Look-up for 12-species model - if (ispecies > 2) then + if (ispecies .gt. 2) then do i = is+1, ie+1 if (itmask(i)) then k50(i) = k50a(indixe(i)) + @@ -1094,18 +380,19 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, ! Look-up for H2 formation on dust - if (idust > 0) then + if (idust .gt. 0) then d_logtem0 = log(dtemstart) d_logtem9 = log(dtemend) - d_dlogtem = (log(dtemend) - log(dtemstart))/real(ndratec-1) + d_dlogtem = (log(dtemend) - log(dtemstart))/ + & real(ndratec-1,RKIND) do i = is+1, ie+1 if (itmask(i)) then ! Assume dust melting at T > 1500 K - if (tdust(i) > dtemend) then + if (tdust(i) .gt. dtemend) then h2dust(i) = tiny else @@ -1117,8 +404,8 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, ! Find index into table and precompute interpolation values - d_indixe(i) = min(ndratec-1, max(1, - & int((d_logtem(i)-d_logtem0)/d_dlogtem,IKIND)+1)) + d_indixe(i) = min(ndratec-1, + & max(1,int((d_logtem(i)-d_logtem0)/d_dlogtem)+1)) d_t1(i) = (d_logtem0 + (d_indixe(i) - 1)*d_dlogtem) d_t2(i) = (d_logtem0 + (d_indixe(i) )*d_dlogtem) d_tdef(i) = (d_logtem(i) - d_t1(i)) / @@ -1154,7 +441,7 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, k26shield(i) = k26 endif enddo - if (iradshield == 1) then + if (iradshield .eq. 1) then do i = is+1, ie+1 if (itmask(i)) then k24shield(i) = k24shield(i)*exp(-HI(i,j,k)*avgsighp*dom) @@ -1235,7 +522,7 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, ! effects of secondary elections (Shull * Steenberg 1985) ! (see calc_rate.src) - if (iradtype == 8) then + if (iradtype .eq. 8) then do i = is+1, ie+1 if (itmask(i)) then x = max(HII(i,j,k)/(HI(i,j,k)+HII(i,j,k)), 1.e-4_RKIND) @@ -1261,12 +548,13 @@ subroutine lookup_cool_rates1d(temstart, temend, nratec, j, k, #define USE_DENSITY_DEPENDENT_H2_DISSOCIATION_RATE #ifdef USE_DENSITY_DEPENDENT_H2_DISSOCIATION_RATE - if (ispecies > 1 .and. ithreebody == 0) then + if (ispecies .gt. 1 .and. ithreebody .eq. 0) then do i = is+1, ie+1 if (itmask(i)) then - nh = min(HI(i,j,k)*dom, 1.e9_RKIND) + nh = min(HI(i,j,k)*dom, 1.0d9) k13(i) = tiny - if (tgas1d(i) >= 500.0 .and. tgas1d(i) < 1.e6) then + if (tgas1d(i) .ge. 500._RKIND .and. + & tgas1d(i) .lt. 1.0d6) then k13(i) = k13dd(i,1)-k13dd(i,2)/ & (1._RKIND+(nh/k13dd(i,5))**k13dd(i,7)) & + k13dd(i,3)-k13dd(i,4)/ @@ -1342,7 +630,7 @@ subroutine rate_timestep(dedot, HIdot, ispecies, idust, INTG_PREC i real*8 h2heatfac(in), H2delta(in), H2dmag, atten, tau - if (ispecies == 1) then + if (ispecies .eq. 1) then do i = is+1, ie+1 if (itmask(i)) then @@ -1401,9 +689,9 @@ subroutine rate_timestep(dedot, HIdot, ispecies, idust, ! Add H2 formation on dust grains - if (idust > 0) then + if (idust .gt. 0) then HIdot(i) = HIdot(i) - & - 2.d0 * h2dust(i) * rhoH(i) + & - 2._RKIND * h2dust(i) * rhoH(i) endif ! Compute the electron density rate-of-change @@ -1424,8 +712,8 @@ subroutine rate_timestep(dedot, HIdot, ispecies, idust, #ifdef RADIATION & + (k24shield(i)*HI(i,j,k) - & + k25shield(i)*HeII(i,j,k)/4.e0 - & + k26shield(i)*HeI(i,j,k)/4.e0) + & + k25shield(i)*HeII(i,j,k)/4._RKIND + & + k26shield(i)*HeI(i,j,k)/4._RKIND) #endif /* RADIATION */ ! H2 formation heating @@ -1433,20 +721,20 @@ subroutine rate_timestep(dedot, HIdot, ispecies, idust, ! Equation 23 from Omukai (2000) h2heatfac(i) = (1._RKIND + (ncrn(i) / (dom * & (HI(i,j,k) * ncrd1(i) + - & H2I(i,j,k) * 0.5_RKIND* ncrd2(i)))))**(-1._RKIND) + & H2I(i,j,k) * 0.5_RKIND * ncrd2(i)))))**(-1._RKIND) H2delta(i) = & HI(i,j,k) * - & ( 4.48_RKIND * k22(i)*HI(i,j,k)**2._RKIND + & ( 4.48_RKIND * k22(i) * HI(i,j,k)**2._RKIND & - 4.48_RKIND * k13(i) * H2I(i,j,k)/2._RKIND) ! We only want to apply this if the formation dominates, but we ! need to apply it outside the delta calculation. - if(H2delta(i) > 0.0) then + if(H2delta(i).gt.0.0) then H2delta(i) = H2delta(i) * h2heatfac(i) endif - if (idust > 0) then + if (idust .gt. 0) then H2delta(i) = H2delta(i) + & h2dust(i) * HI(i,j,k) * rhoH(i) * & (0.2_RKIND + 4.2_RKIND * h2heatfac(i)) @@ -1455,12 +743,12 @@ subroutine rate_timestep(dedot, HIdot, ispecies, idust, ! H2dmag = abs(H2delta)/( ! & HI(i,j,k)*( k22(i) * HI(i,j,k)**2._RKIND ! & + k13(i) * H2I(i,j,k)/2._RKIND)) -! tau = (H2dmag/1.e-5)**-1._RKIND +! tau = (H2dmag/1e-5)**-1.0_RKIND ! tau = max(tau, 1.e-5) ! atten = min((1.-exp(-tau))/tau,1.0) atten = 1._RKIND edot(i) = edot(i) + chunit * H2delta(i) * atten -! & + H2I(i,j,k)*( k21(i) * HI(i,j,k)**2._RKIND +! & + H2I(i,j,k)*( k21(i) * HI(i,j,k)**2.0_RKIND ! & - k23(i) * H2I(i,j,k)) !H * (k22 * H^2 - k13 * H_2) + H_2 * (k21 * H^2 - k23 * H_2) */ endif ! itmask @@ -1470,8 +758,8 @@ subroutine rate_timestep(dedot, HIdot, ispecies, idust, ! Add photo-ionization rates if needed #ifdef RADIATION - if (iradtrans == 1) then - if (irt_honly == 0) then + if (iradtrans .eq. 1) then + if (irt_honly .eq. 0) then do i = is+1, ie+1 if (itmask(i)) then HIdot(i) = HIdot(i) - kphHI(i,j,k)*HI(i,j,k) @@ -1562,7 +850,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, ! A) the 6-species integrator ! - if (ispecies == 1) then + if (ispecies .eq. 1) then do i = is+1, ie+1 if (itmask(i)) then @@ -1573,10 +861,9 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, acoef = k1(i)*de(i,j,k) #ifdef RADIATION & + k24shield(i) - if (iradtrans == 1) acoef = acoef + kphHI(i,j,k) + if (iradtrans .eq. 1) acoef = acoef + kphHI(i,j,k) #endif /* RADIATION */ - HIp(i) = (scoef*dtit(i) + HI(i,j,k)) / - $ (1._RKIND + acoef*dtit(i)) + HIp(i) = (scoef*dtit(i) + HI(i,j,k))/(1._RKIND + acoef*dtit(i)) if (HIp(i) .ne. HIp(i)) then write(*,*) '[0]HUGE HIp! :: ', i, j, k, HIp(i), $ HI(i,j,k), HII(i,j,k), de(i,j,k), kphHI(i,j,k), @@ -1589,14 +876,12 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, scoef = k1(i)*HIp(i)*de(i,j,k) #ifdef RADIATION & + k24shield(i)*HIp(i) - if (iradtrans == 1) - & scoef = scoef + kphHI(i,j,k)*HIp(i) + if (iradtrans .eq. 1) scoef = scoef + kphHI(i,j,k)*HIp(i) #endif /* RADIATION */ acoef = k2(i)*de (i,j,k) - HIIp(i) = (scoef*dtit(i) + HII(i,j,k)) / - $ (1._RKIND +acoef*dtit(i)) + HIIp(i) = (scoef*dtit(i) + HII(i,j,k))/(1._RKIND +acoef*dtit(i)) ! - if (HIIp(i) <= 0.0) then !##### + if (HIIp(i) .le. 0.0) then !##### write(*,*) 'negative HIIp! :: ', i, j, k, HIIp(i), $ scoef, dtit(i), HII(i,j,k), acoef, $ k2(i), de(i,j,k), @@ -1611,25 +896,23 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, & + k24shield(i)*HI(i,j,k) & + k25shield(i)*HeII(i,j,k)/4._RKIND & + k26shield(i)*HeI(i,j,k)/4._RKIND - if (iradtrans == 1 .and. irt_honly == 0) + if (iradtrans .eq. 1 .and. irt_honly .eq. 0) & scoef = scoef + kphHI(i,j,k) * HI(i,j,k) & + kphHeI(i,j,k) * HeI(i,j,k)/4._RKIND & + kphHeII(i,j,k) * HeII(i,j,k)/4._RKIND - if (iradtrans == 1 .and. irt_honly == 1) + if (iradtrans .eq. 1 .and. irt_honly .eq. 1) & scoef = scoef + kphHI(i,j,k) * HI(i,j,k) #endif /* RADIATION */ acoef = -(k1(i)*HI(i,j,k) - k2(i)*HII(i,j,k) - & + k3(i)*HeI(i,j,k)/4._RKIND - & - k6(i)*HeIII(i,j,k)/4._RKIND - & + k5(i)*HeII(i,j,k)/4._RKIND - & - k4(i)*HeII(i,j,k)/4._RKIND) + & + k3(i)*HeI(i,j,k)/4._RKIND - k6(i)*HeIII(i,j,k)/4._RKIND + & + k5(i)*HeII(i,j,k)/4._RKIND - k4(i)*HeII(i,j,k)/4._RKIND) dep(i) = (scoef*dtit(i) + de(i,j,k)) & / (1._RKIND + acoef*dtit(i)) endif ! itmask enddo - endif ! (ispecies == 1) + endif ! (ispecies .eq. 1) ! --- (B) Do helium chemistry in any case: (for all ispecies values) --- @@ -1642,7 +925,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, acoef = k3(i)*de(i,j,k) #ifdef RADIATION & + k26shield(i) - if (iradtrans == 1 .and. irt_honly == 0) + if (iradtrans.eq.1 .and. irt_honly.eq.0) $ acoef = acoef + kphHeI(i,j,k) #endif /* RADIATION */ HeIp(i) = ( scoef*dtit(i) + HeI(i,j,k) ) @@ -1654,13 +937,13 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, & + k6(i)*HeIII(i,j,k)*de(i,j,k) #ifdef RADIATION & + k26shield(i)*HeIp(i) - if (iradtrans == 1 .and. irt_honly == 0) + if (iradtrans.eq.1 .and. irt_honly.eq.0) $ scoef = scoef + kphHeI(i,j,k)*HeIp(i) #endif /* RADIATION */ acoef = k4(i)*de(i,j,k) + k5(i)*de(i,j,k) #ifdef RADIATION & + k25shield(i) - if (iradtrans == 1 .and. irt_honly == 0) + if (iradtrans.eq.1 .and. irt_honly.eq.0) $ acoef = acoef + kphHeII(i,j,k) #endif /* RADIATION */ HeIIp(i) = ( scoef*dtit(i) + HeII(i,j,k) ) @@ -1671,7 +954,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, scoef = k5(i)*HeIIp(i)*de(i,j,k) #ifdef RADIATION & + k25shield(i)*HeIIp(i) - if (iradtrans == 1 .and. irt_honly == 0) + if (iradtrans.eq.1 .and. irt_honly.eq.0) $ scoef = scoef + kphHeII(i,j,k) * HeIIp(i) #endif /* RADIATION */ acoef = k6(i)*de(i,j,k) @@ -1683,7 +966,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, c --- (C) Now do extra 3-species for molecular hydrogen --- - if (ispecies > 1) then + if (ispecies .gt. 1) then ! First, do HI/HII with molecular hydrogen terms @@ -1712,15 +995,15 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, & + 2._RKIND*k22(i)* HI(i,j,k)**2 #ifdef RADIATION & + k24shield(i) - if (iradtrans == 1) acoef = acoef + kphHI(i,j,k) + if (iradtrans .eq. 1) acoef = acoef + kphHI(i,j,k) #endif /* RADIATION */ - if (idust > 0) then - acoef = acoef + 2.d0 * h2dust(i) * rhoH(i) + if (idust .gt. 0) then + acoef = acoef + 2._RKIND * h2dust(i) * rhoH(i) endif HIp(i) = ( scoef*dtit(i) + HI(i,j,k) ) / - & ( 1._RKIND + acoef*dtit(i) ) + & ( 1. + acoef*dtit(i) ) if (HIp(i) .ne. HIp(i)) then write(*,*) '[1]HUGE HIp! :: ', i, j, k, HIp(i), $ HI(i,j,k), HII(i,j,k), de(i,j,k), H2I(i,j,k), @@ -1738,8 +1021,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, & + k10(i) * H2II(i,j,k)*HI(i,j,k)/2._RKIND #ifdef RADIATION & + k24shield(i)*HI(i,j,k) - if (iradtrans == 1) - & scoef = scoef + kphHI(i,j,k)*HI(i,j,k) + if (iradtrans .eq. 1) scoef = scoef + kphHI(i,j,k)*HI(i,j,k) #endif /* RADIATION */ acoef = k2(i) * de(i,j,k) & + k9(i) * HI(i,j,k) @@ -1759,18 +1041,16 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, & + k24shield(i)*HIp(i) & + k25shield(i)*HeIIp(i)/4._RKIND & + k26shield(i)*HeIp(i)/4._RKIND - if (iradtrans == 1 .and. irt_honly == 0) + if (iradtrans .eq. 1 .and. irt_honly.eq.0) & scoef = scoef + kphHI(i,j,k) * HIp(i) & + kphHeI(i,j,k) * HeIp(i)/4._RKIND & + kphHeII(i,j,k) * HeIIp(i)/4._RKIND - if (iradtrans == 1 .and. irt_honly == 1) + if (iradtrans .eq. 1 .and. irt_honly.eq.1) & scoef = scoef + kphHI(i,j,k) * HIp(i) #endif /* RADIATION */ acoef = - (k1(i) *HI(i,j,k) - k2(i)*HII(i,j,k) - & + k3(i) *HeI(i,j,k)/4._RKIND - & - k6(i)*HeIII(i,j,k)/4._RKIND - & + k5(i) *HeII(i,j,k)/4._RKIND - & - k4(i)*HeII(i,j,k)/4._RKIND + & + k3(i) *HeI(i,j,k)/4._RKIND - k6(i)*HeIII(i,j,k)/4._RKIND + & + k5(i) *HeII(i,j,k)/4._RKIND- k4(i)*HeII(i,j,k)/4._RKIND & + k14(i)*HM(i,j,k) & - k7(i) *HI(i,j,k) & - k18(i)*H2II(i,j,k)/2._RKIND) @@ -1789,8 +1069,8 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, & + k29 + k31shield(i) #endif /* RADIATION */ - if (idust > 0) then - scoef = scoef + 2.d0 * h2dust(i) * HI(i,j,k) * rhoH(i) + if (idust .gt. 0) then + scoef = scoef + 2._RKIND * h2dust(i) * HI(i,j,k) * rhoH(i) endif H2Ip(i) = ( scoef*dtit(i) + H2I(i,j,k) ) @@ -1829,7 +1109,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, ! --- (D) Now do extra 3-species for molecular HD --- ! - if (ispecies > 2) then + if (ispecies .gt. 2) then do i = is+1, ie+1 if (itmask(i)) then ! @@ -1837,7 +1117,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, ! scoef = ( k2(i) * DII(i,j,k) * de(i,j,k) & + k51(i)* DII(i,j,k) * HI(i,j,k) - & + 2._RKIND*k55(i)* HDI(i,j,k) *HI(i,j,k)/3._RKIND + & + 2._RKIND*k55(i)* HDI(i,j,k) * HI(i,j,k)/3._RKIND & ) acoef = k1(i) * de(i,j,k) & + k50(i) * HII(i,j,k) @@ -1845,7 +1125,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, & + k56(i) * HM(i,j,k) #ifdef RADIATION & + k24shield(i) - if (iradtrans == 1) acoef = acoef + kphHI(i,j,k) + if (iradtrans .eq. 1) acoef = acoef + kphHI(i,j,k) #endif /* RADIATION */ DIp(i) = ( scoef*dtit(i) + DI(i,j,k) ) / & ( 1._RKIND + acoef*dtit(i) ) @@ -1858,8 +1138,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, & ) #ifdef RADIATION & + k24shield(i)*DI(i,j,k) - if (iradtrans == 1) - & scoef = scoef + kphHI(i,j,k)*DI(i,j,k) + if (iradtrans .eq. 1) scoef = scoef + kphHI(i,j,k)*DI(i,j,k) #endif /* RADIATION */ acoef = k2(i) * de(i,j,k) & + k51(i) * HI(i,j,k) @@ -1870,8 +1149,8 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, ! 3) HDI c - scoef = 3._RKIND*(k52(i) * DII(i,j,k)* H2I(i,j,k)/4._RKIND - & + k54(i) * DI(i,j,k) * H2I(i,j,k)/4._RKIND + scoef = 3._RKIND*(k52(i) * DII(i,j,k)* H2I(i,j,k)/2._RKIND/2._RKIND + & + k54(i) * DI(i,j,k) * H2I(i,j,k)/2._RKIND/2._RKIND & + 2._RKIND*k56(i) * DI(i,j,k) * HM(i,j,k)/2._RKIND & ) acoef = k53(i) * HII(i,j,k) @@ -1888,7 +1167,7 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, do i = is+1, ie+1 if (itmask(i)) then - HIdot_prev(i) = abs(HI(i,j,k)-HIp(i))/max(dtit(i), tiny) + HIdot_prev(i) = abs(HI(i,j,k)-HIp(i))/max(dtit(i),tiny) HI(i,j,k) = max(HIp(i), tiny) HII(i,j,k) = max(HIIp(i), tiny) HeI(i,j,k) = max(HeIp(i), tiny) @@ -1900,20 +1179,19 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, ! Use charge conservation to determine electron fraction dedot_prev(i) = de(i,j,k) - de(i,j,k) = HII(i,j,k) + HeII(i,j,k)/4._RKIND + - & HeIII(i,j,k)/2._RKIND - if (ispecies > 1) + de(i,j,k) = HII(i,j,k) + HeII(i,j,k)/4._RKIND + HeIII(i,j,k)/2._RKIND + if (ispecies .gt. 1) & de(i,j,k) = de(i,j,k) - HM(i,j,k) + H2II(i,j,k)/2._RKIND dedot_prev(i) = abs(de(i,j,k)-dedot_prev(i))/ & max(dtit(i),tiny) - if (ispecies > 1) then + if (ispecies .gt. 1) then HM(i,j,k) = max(HMp(i), tiny) H2I(i,j,k) = max(H2Ip(i), tiny) H2II(i,j,k) = max(H2IIp(i), tiny) endif - if (ispecies > 2) then + if (ispecies .gt. 2) then DI(i,j,k) = max(DIp(i), tiny) DII(i,j,k) = max(DIIp(i), tiny) HDI(i,j,k) = max(HDIp(i), tiny) @@ -1937,7 +1215,8 @@ subroutine step_rate(de, HI, HII, HeI, HeII, HeIII, d, subroutine make_consistent(de, HI, HII, HeI, HeII, HeIII, & HM, H2I, H2II, DI, DII, HDI, metal, d, & is, ie, js, je, ks, ke, - & in, jn, kn, ispecies, imetal, fh, dtoh) + & in, jn, kn, imax, ispecies, imetal, fh, + & dtoh) ! ------------------------------------------------------------------- implicit NONE @@ -1945,7 +1224,8 @@ subroutine make_consistent(de, HI, HII, HeI, HeII, HeIII, ! Arguments - INTG_PREC in, jn, kn, is, ie, js, je, ks, ke, ispecies, imetal + INTG_PREC in, jn, kn, is, ie, js, je, ks, ke, ispecies, imetal, + & imax R_PREC de(in,jn,kn), HI(in,jn,kn), HII(in,jn,kn), & HeI(in,jn,kn), HeII(in,jn,kn), HeIII(in,jn,kn), & d(in,jn,kn), metal(in,jn,kn) @@ -1953,17 +1233,12 @@ subroutine make_consistent(de, HI, HII, HeI, HeII, HeIII, R_PREC DI(in,jn,kn), DII(in,jn,kn), HDI(in,jn,kn) R_PREC fh, dtoh -! Parameters - - INTG_PREC ijk - parameter (ijk = MAX_ANY_SINGLE_DIRECTION) - ! locals INTG_PREC i, j, k - R_PREC totalH(ijk), totalHe(ijk), + R_PREC totalH(imax), totalHe(imax), & totalD, correctH, correctHe, correctD - R_PREC metalfree(ijk) + R_PREC metalfree(imax) ! Loop over all zones @@ -1973,7 +1248,7 @@ subroutine make_consistent(de, HI, HII, HeI, HeII, HeIII, ! Compute total densities of H and He ! (ensure non-negativity) - if (imetal == 1) then + if (imetal .eq. 1) then do i = is+1, ie+1 metalfree(i) = d(i,j,k) - metal(i,j,k) enddo @@ -1995,7 +1270,7 @@ subroutine make_consistent(de, HI, HII, HeI, HeII, HeIII, ! include molecular hydrogen - if (ispecies > 1) then + if (ispecies .gt. 1) then do i = is+1, ie+1 HM (i,j,k) = abs(HM (i,j,k)) H2II (i,j,k) = abs(H2II (i,j,k)) @@ -2018,7 +1293,7 @@ subroutine make_consistent(de, HI, HII, HeI, HeII, HeIII, ! Correct molecular hydrogen-related fractions - if (ispecies > 1) then + if (ispecies .gt. 1) then HM (i,j,k) = HM(i,j,k)*correctH H2II (i,j,k) = H2II(i,j,k)*correctH H2I (i,j,k) = H2I(i,j,k)*correctH @@ -2027,13 +1302,12 @@ subroutine make_consistent(de, HI, HII, HeI, HeII, HeIII, ! Do the same thing for deuterium (ignore HD) Assumes dtoh is small - if (ispecies > 2) then + if (ispecies .gt. 2) then do i = is+1, ie+1 DI (i,j,k) = abs(DI (i,j,k)) DII (i,j,k) = abs(DII (i,j,k)) HDI (i,j,k) = abs(HDI (i,j,k)) - totalD = DI(i,j,k) + DII(i,j,k) + - & 2._RKIND/3._RKIND*HDI(i,j,k) + totalD = DI(i,j,k) + DII(i,j,k) + 2._RKIND/3._RKIND*HDI(i,j,k) correctD = fh*dtoh*metalfree(i)/totalD DI (i,j,k) = DI (i,j,k)*correctD DII (i,j,k) = DII(i,j,k)*correctD @@ -2044,9 +1318,8 @@ subroutine make_consistent(de, HI, HII, HeI, HeII, HeIII, ! Set the electron density do i = is+1, ie+1 - de (i,j,k) = HII(i,j,k) + HeII(i,j,k)/4._RKIND + - & HeIII(i,j,k)/2._RKIND - if (ispecies > 1) de(i,j,k) = de(i,j,k) + de (i,j,k) = HII(i,j,k) + HeII(i,j,k)/4._RKIND + HeIII(i,j,k)/2._RKIND + if (ispecies .gt. 1) de(i,j,k) = de(i,j,k) & - HM(i,j,k) + H2II(i,j,k)/2._RKIND enddo @@ -2055,3 +1328,4 @@ subroutine make_consistent(de, HI, HII, HeI, HeII, HeIII, return end + diff --git a/src/enzo/rotate2d.F b/src/enzo/rotate2d.F index fa9588c1c..ea56e72f1 100644 --- a/src/enzo/rotate2d.F +++ b/src/enzo/rotate2d.F @@ -24,6 +24,8 @@ subroutine rotate2d(x,n1,n2,y) ! go to 666 +!$omp parallel +!$omp do private(i,j,ii,jj) schedule(static) do ii=1,n1,ib do jj=1,n2,jb @@ -35,6 +37,8 @@ subroutine rotate2d(x,n1,n2,y) end do end do +!$omp end do +!$omp end parallel 666 continue diff --git a/src/enzo/rotate3d.F b/src/enzo/rotate3d.F index bc883966b..cfd0c4c6c 100644 --- a/src/enzo/rotate3d.F +++ b/src/enzo/rotate3d.F @@ -27,6 +27,8 @@ subroutine rotate3d(x,n1,n2,n3,y) ! end do ! go to 666 +!$omp parallel +!$omp do collapse(2) private(i,j,k,ii,jj,kk) schedule(static) do ii=1,n1,ib do kk=1,n3,kb do jj=1,n2,jb @@ -42,6 +44,8 @@ subroutine rotate3d(x,n1,n2,n3,y) end do end do end do +!$omp end do +!$omp end parallel 666 continue diff --git a/src/enzo/solve_cool.F b/src/enzo/solve_cool.F index ec63bbf3b..b20cfeee6 100644 --- a/src/enzo/solve_cool.F +++ b/src/enzo/solve_cool.F @@ -8,7 +8,7 @@ subroutine solve_cool( & d, e, ge, u, v, w, & in, jn, kn, nratec, iexpand, imethod, cool_method, & idual, idim, igammah, - & is, js, ks, ie, je, ke, + & is, js, ks, ie, je, ke, & dt, aye, temstart, temend, fh, & utem, uxyz, urho, utim, & eta1, eta2, gamma, coola, gammaha, mu) diff --git a/src/enzo/solve_rate_cool.F90 b/src/enzo/solve_rate_cool.F90 new file mode 100644 index 000000000..053b1d506 --- /dev/null +++ b/src/enzo/solve_rate_cool.F90 @@ -0,0 +1,890 @@ +#include "fortran.def" +#include "phys_const.def" +#include "error.def" + +!======================================================================= +!///////////////////// SUBROUTINE SOLVE_RATE \\\\\\\\\\\\\\\\\\\\\\\\\ + + subroutine solve_rate_cool( & + d, e, ge, u, v, w, de, & + HI, HII, HeI, HeII, HeIII, & + in, jn, kn, nratec, iexpand, imethod, & + idual, ispecies, imetal, imcool, idust, idim, & + is, js, ks, ie, je, ke, imax, ih2co, ipiht, igammah, & + dx, dt, aye, redshift, temstart, temend, & + utem, uxyz, uaye, urho, utim, & + eta1, eta2, gamma, fh, dtoh, z_solar, & + k1a, k2a, k3a, k4a, k5a, k6a, k7a, k8a, k9a, k10a, & + k11a, k12a, k13a, k13dda, k14a, k15a, & + k16a, k17a, k18a, k19a, k22a, & + k24, k25, k26, k27, k28, k29, k30, k31, & + k50a, k51a, k52a, k53a, k54a, k55a, k56a, & + ndratec, dtemstart, dtemend, h2dusta, & + ncrna, ncrd1a, ncrd2a, & + ceHIa, ceHeIa, ceHeIIa, ciHIa, ciHeIa, & + ciHeISa, ciHeIIa, reHIIa, reHeII1a, & + reHeII2a, reHeIIIa, brema, compa, gammaha, & + comp_xraya, comp_temp, piHI, piHeI, piHeII, & + HM, H2I, H2II, DI, DII, HDI, metal, & + hyd01ka, h2k01a, vibha, rotha, rotla, & + gpldla, gphdla, hdltea, hdlowa, & + gaHIa, gaH2a, gaHea, gaHpa, gaela, & + gasgra, metala, n_xe, xe_start, xe_end, & + inutot, iradtype, nfreq, imetalregen, & + iradshield, avgsighp, avgsighep, avgsighe2p, & + iradtrans, iradcoupled, iradstep, ierr, irt_honly, & + kphHI, kphHeI, kphHeII, kdissH2I, photogamma, & + ih2optical, iciecool, ithreebody, ciecoa, & + icmbTfloor, iClHeat, & + clEleFra, clGridRank, clGridDim, & + clPar1, clPar2, clPar3, clPar4, clPar5, & + clDataSize, clCooling, clHeating) +! +! SOLVE MULTI-SPECIES RATE EQUATIONS AND RADIATIVE COOLING +! +! written by: Yu Zhang, Peter Anninos and Tom Abel +! date: +! modified1: January, 1996 by Greg Bryan; converted to KRONOS +! modified2: October, 1996 by GB; adapted to AMR +! modified3: May, 1999 by GB and Tom Abel, 3bodyH2, solver, HD +! modified4: June, 2005 by GB to solve rate & cool at same time +! modified5: April, 2009 by JHW to include radiative transfer +! modified6: September, 2009 by BDS to include cloudy cooling +! modified7: June, 2011 by JHW conversion to F90 +! +! PURPOSE: +! Solve the multi-species rate and cool equations. +! +! INPUTS: +! in,jn,kn - dimensions of 3D fields +! +! d - total density field +! de - electron density field +! HI,HII - H density fields (neutral & ionized) +! HeI/II/III - He density fields +! DI/II - D density fields (neutral & ionized) +! HDI - neutral HD molecule density field +! HM - H- density field +! H2I - H_2 (molecular H) density field +! H2II - H_2+ density field +! kph* - photoionization fields +! gamma* - photoheating fields +! +! is,ie - start and end indices of active region (zero based) +! idual - dual energy formalism flag (0 = off, 1 = on) +! iexpand - comoving coordinates flag (0 = off, 1 = on) +! idim - dimensionality (rank) of problem +! ispecies - chemistry module (1 - H/He only, 2 - molecular H, 3 - D) +! iradshield - flag for crude radiative shielding correction +! iradtype - type of radiative field (only used if = 8) +! imetal - flag if metal field is active (0 = no, 1 = yes) +! imcool - flag if there is metal cooling +! idust - flag for H2 formation on dust grains +! imethod - Hydro method (0 = PPMDE, 2 = ZEUS-type) +! ih2co - flag to include H2 cooling (1 = on, 0 = off) +! ipiht - flag to include photoionization heating (1 = on, 0 = off) +! iradtrans - flag to include radiative transfer (1 = on, 0 = off) +! iradcoupled - flag to indicate coupled radiative transfer +! iradstep - flag to indicate intermediate coupled radiative transfer timestep +! +! fh - Hydrogen mass fraction (typically 0.76) +! dtoh - Deuterium to H mass ratio +! z_solar - Solar metal mass fraction +! dt - timestep to integrate over +! aye - expansion factor (in code units) +! +! utim - time units (i.e. code units to CGS conversion factor) +! uaye - expansion factor conversion factor (uaye = 1/(1+zinit)) +! urho - density units +! uxyz - length units +! utem - temperature(-like) units +! +! temstart, temend - start and end of temperature range for rate table +! nratec - dimensions of chemical rate arrays (functions of temperature) +! dtemstart, dtemend - start and end of dust temperature range +! ndratec - extra dimension for H2 formation on dust rate (dust temperature) +! +! icmbTfloor - flag to include temperature floor from cmb +! iClHeat - flag to include cloudy heating +! clEleFra - parameter to account for additional electrons from metals +! clGridRank - rank of cloudy cooling data grid +! clGridDim - array containing dimensions of cloudy data +! clPar1, clPar2, clPar3, clPar4, clPar5 - arrays containing cloudy grid parameter values +! clDataSize - total size of flattened 1D cooling data array +! clCooling - cloudy cooling data +! clHeating - cloudy heating data +! +! OUTPUTS: +! update chemical rate densities (HI, HII, etc) +! +! PARAMETERS: +! itmax - maximum allowed sub-cycle iterations +! mh - H mass in cgs units +! +!----------------------------------------------------------------------- + + implicit NONE +#include "fortran_types.def" + +! General Arguments + + INTG_PREC, intent(in) :: in, jn, kn, is, js, ks, ie, je, ke, nratec, & + imethod, idual, iexpand, ih2co, ipiht, ispecies, imetal, idim,& + iradtype, nfreq, imetalregen, iradshield, iradtrans, & + iradcoupled, iradstep, n_xe, imcool, idust, irt_honly, & + igammah, ih2optical, iciecool, ithreebody, imax, & + ndratec + R_PREC, intent(in) :: dx(*) + R_PREC, intent(in) :: dt, aye, temstart, temend, eta1, eta2, gamma, & + utim, uxyz, uaye, urho, utem, fh, dtoh, xe_start, xe_end, & + dtemstart, dtemend, z_solar, redshift + INTG_PREC, intent(out) :: ierr + +! Density, energy and velocity fields fields + + R_PREC, intent(inout), dimension(in,jn,kn) :: & + de, HI, HII, HeI, HeII, HeIII, HM, H2I, H2II, DI, DII, HDI, & + d, ge, e, u, v, w, metal + +! Radiation fields + + R_PREC, intent(in), dimension(in,jn,kn) :: & + kphHI, kphHeI, kphHeII, kdissH2I, photogamma + +! Cooling tables (coolings rates as a function of temperature) + + R_PREC, intent(in), dimension(nratec) :: & + hyd01ka, h2k01a, vibha, rotha, rotla, gpldla, gphdla, hdltea, & + hdlowa, gaHIa, gaH2a, gaHea, gaHpa, gaela, ciecoa, ceHIa, & + ceHeIa, ceHeIIa, ciHIa, ciHeIa, ciHeISa, ciHeIIa, reHIIa, & + reHeII1a, reHeII2a, reHeIIIa, brema, gasgra + R_PREC, intent(in), dimension(nratec, n_xe) :: metala + R_PREC, intent(in) :: inutot(nfreq) + R_PREC, intent(in) :: compa, piHI, piHeI, piHeII, comp_xraya, comp_temp, & + avgsighp, avgsighep, avgsighe2p, gammaha + +! Chemistry tables (rates as a function of temperature) + + R_PREC, intent(in), dimension(nratec) :: & + k1a , k2a , k3a , k4a , k5a , k6a , k7a , k8a , k9a , & + k10a, k11a, k12a, k13a, k14a, k15a, k16a, k17a, k18a, & + k19a, k22a, k50a, k51a, k52a, k53a, k54a, k55a, k56a, & + ncrna, ncrd1a, ncrd2a + R_PREC, intent(in) :: k13dda(nratec, 7) + R_PREC, intent(in) :: k24, k25, k26, k27, k28, k29, k30, k31 + R_PREC, intent(in) :: h2dusta(nratec, ndratec) + +! Cloudy cooling data + + INTG_PREC, intent(in) :: icmbTfloor, iClHeat, clGridRank, clDataSize + INTG_PREC, intent(in) :: clGridDim(clGridRank) + R_PREC, intent(in) :: clEleFra + R_PREC, intent(in) :: clPar1(clGridDim(1)), clPar2(clGridDim(2)), & + clPar3(clGridDim(3)), clPar4(clGridDim(4)), & + clPar5(clGridDim(5)) + R_PREC, intent(in), dimension(clDataSize) :: clCooling, clHeating + +! Parameters + + INTG_PREC :: itmax + parameter (itmax = 10000) + +#ifdef CONFIG_BFLOAT_4 + R_PREC :: tolerance + parameter (tolerance = 1.e-5_RKIND) +#endif + +#ifdef CONFIG_BFLOAT_8 + R_PREC :: tolerance + parameter (tolerance = 1.e-10_RKIND) +#endif + + real*8 :: mh + parameter (mh = mass_h) + +! Locals + + INTG_PREC :: i, j, k, iter + INTG_PREC :: clGridDim1, clGridDim2, clGridDim3, clGridDim4, clGridDim5 + R_PREC :: ttmin, dom, energy, comp1, comp2, olddtit, dx_cgs + real*8 :: coolunit, dbase1, tbase1, xbase1, chunit, uvel + real*8 :: heq1, heq2, eqk221, eqk222, eqk131, eqk132, & + eqt1, eqt2, eqtdef, dheq, heq, dlogtem + + ! row temporaries + + INTG_PREC, dimension(:), allocatable :: indixe + R_PREC, dimension(:), allocatable :: & + t1, t2, logtem, tdef, dtit, ttot, p2d, tgas, tgasold, & + tdust, metallicity, rhoH + + ! Rate equation row temporaries + + R_PREC, dimension(:), allocatable :: & + HIp, HIIp, HeIp, HeIIp, HeIIIp, HMp, H2Ip, H2IIp, dep, & + dedot, HIdot, dedot_prev, DIp, DIIp, HDIp, HIdot_prev, & + k24shield, k25shield, k26shield, k31shield, & + h2dust, ncrn, ncrd1, ncrd2 + R_PREC, dimension(:), allocatable :: & + k1 , k2 , k3 , k4 , k5 , k6 , k7 , k8 , k9 , k10, k11, & + k12, k13, k14, k15, k16, k17, k18, k19, k22, k50, k51, & + k52, k53, k54, k55, k56 + R_PREC, allocatable :: k13dd(:, :) + + ! Cooling/heating row locals + + real*8, dimension(:), allocatable :: & + ceHI, ceHeI, ceHeII, ciHI, ciHeI, ciHeIS, ciHeII, reHII, & + reHeII1, reHeII2, reHeIII, brem, edot, cieco + R_PREC, dimension(:), allocatable :: & + hyd01k, h2k01, vibh, roth, rotl, gpldl, gphdl, hdlte, & + hdlow + + ! Iteration mask + + LOGIC_PREC, allocatable :: itmask(:) +! +!\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\///////////////////////////////// +!======================================================================= +! Allocations +!======================================================================= + allocate(indixe(imax)) + allocate(t1(imax)) + allocate(t2(imax)) + allocate(logtem(imax)) + allocate(tdef(imax)) + allocate(dtit(imax)) + allocate(ttot(imax)) + allocate(p2d(imax)) + allocate(tgas(imax)) + allocate(tgasold(imax)) + allocate(HIp(imax)) + allocate(HIIp(imax)) + allocate(HeIp(imax)) + allocate(HeIIp(imax)) + allocate(HeIIIp(imax)) + allocate(HMp(imax)) + allocate(H2Ip(imax)) + allocate(H2IIp(imax)) + allocate(dep(imax)) + allocate(dedot(imax)) + allocate(HIdot(imax)) + allocate(dedot_prev(imax)) + allocate(DIp(imax)) + allocate(DIIp(imax)) + allocate(HDIp(imax)) + allocate(HIdot_prev(imax)) + allocate(k24shield(imax)) + allocate(k25shield(imax)) + allocate(k26shield(imax)) + allocate(k31shield(imax)) + allocate(k1(imax)) + allocate(k2(imax)) + allocate(k3(imax)) + allocate(k4(imax)) + allocate(k5(imax)) + allocate(k6(imax)) + allocate(k7(imax)) + allocate(k8(imax)) + allocate(k9(imax)) + allocate(k10(imax)) + allocate(k11(imax)) + allocate(k12(imax)) + allocate(k13(imax)) + allocate(k14(imax)) + allocate(k15(imax)) + allocate(k16(imax)) + allocate(k17(imax)) + allocate(k18(imax)) + allocate(k19(imax)) + allocate(k22(imax)) + allocate(k50(imax)) + allocate(k51(imax)) + allocate(k52(imax)) + allocate(k53(imax)) + allocate(k54(imax)) + allocate(k55(imax)) + allocate(k56(imax)) + allocate(k13dd(imax,7)) + allocate(ceHI(imax)) + allocate(ceHeI(imax)) + allocate(ceHeII(imax)) + allocate(ciHI(imax)) + allocate(ciHeI(imax)) + allocate(ciHeIS(imax)) + allocate(ciHeII(imax)) + allocate(reHII(imax)) + allocate(reHeII1(imax)) + allocate(reHeII2(imax)) + allocate(reHeIII(imax)) + allocate(brem(imax)) + allocate(edot(imax)) + allocate(hyd01k(imax)) + allocate(h2k01(imax)) + allocate(vibh(imax)) + allocate(roth(imax)) + allocate(rotl(imax)) + allocate(gpldl(imax)) + allocate(cieco(imax)) + allocate(gphdl(imax)) + allocate(hdlte(imax)) + allocate(hdlow(imax)) + allocate(itmask(imax)) + allocate(tdust(imax)) + allocate(metallicity(imax)) + allocate(rhoH(imax)) + allocate(h2dust(imax)) + allocate(ncrn(imax)) + allocate(ncrd1(imax)) + allocate(ncrd2(imax)) +! +!\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\///////////////////////////////// +!======================================================================= + +! Set error indicator + + ierr = 0 + +! Set units + + dom = urho*(aye**3)/mh + tbase1 = utim + xbase1 = uxyz/(aye*uaye) ! uxyz is [x]*a = [x]*[a]*a' ' + dx_cgs = dx(is+1) * xbase1 + dbase1 = urho*(aye*uaye)**3 ! urho is [dens]/a^3 = [dens]/([a]*a')^3 ' + coolunit = (uaye**5 * xbase1**2 * mh**2) / (tbase1**3 * dbase1) + uvel = uxyz / utim +! chunit = (7.17775e-12_RKIND)/(2._RKIND*uvel*uvel*mh) ! 4.5 eV per H2 formed + chunit = (1.60218e-12_RKIND)/(2._RKIND*uvel*uvel*mh) ! 1 eV per H2 formed + + dlogtem = (log(temend) - log(temstart))/real(nratec-1,RKIND) + +! Convert densities from comoving to proper + + call scale_fields(d, de, HI, HII, HeI, HeII, HeIII, & + HM, H2I, H2II, DI, DII, HDI, metal, & + is, ie, js, je, ks, ke, & + in, jn, kn, ispecies, imetal, aye**(-3)) + + call ceiling_species(d, de, HI, HII, HeI, HeII, HeIII,& + HM, H2I, H2II, DI, DII, HDI, metal,& + is, ie, js, je, ks, ke,& + in, jn, kn, ispecies, imetal) + +! Loop over zones, and do an entire i-column in one go + + do k = ks+1, ke+1 + do j = js+1, je+1 + +! tolerance = 1.e-6_RKIND * dt + +! Set iteration mask to include only cells with radiation in the +! intermediate coupled chemistry / energy step + + if (iradcoupled .eq. 1 .and. iradstep .eq. 1) then + do i = is+1, ie+1 + if (kphHI(i,j,k) .gt. 0._RKIND) then + itmask(i) = .true. + else + itmask(i) = .false. + endif + enddo + endif + +! Normal rate solver, but don't double-count the cells with radiation + + if (iradcoupled .eq. 1 .and. iradstep .eq. 0) then + do i = is+1, ie+1 + if (kphHI(i,j,k) .gt. 0) then + itmask(i) = .false. + else + itmask(i) = .true. + endif + enddo + endif + +! No radiation timestep coupling + + if (iradcoupled .eq. 0 .or. iradtrans .eq. 0) then + do i = is+1, ie+1 + itmask(i) = .true. + enddo + endif + +! Set time elapsed to zero for each cell in 1D section + + do i = is+1, ie+1 + ttot(i) = 0._RKIND + enddo + +! ------------------ Loop over subcycles ---------------- + + do iter = 1, itmax + +! Compute the cooling rate, tgas, tdust, and metallicity for this row + + call cool1d_multi( & + d, e, ge, u, v, w, de, HI, HII, HeI, HeII, HeIII,& + in, jn, kn, nratec, idual, imethod, & + iexpand, ispecies, imetal, imcool, idust, idim, & + is, ie, j, k, ih2co, ipiht, iter, igammah, & + aye, redshift, temstart, temend, z_solar, & + utem, uxyz, uaye, urho, utim, & + eta1, eta2, gamma, & + ceHIa, ceHeIa, ceHeIIa, ciHIa, ciHeIa, & + ciHeISa, ciHeIIa, reHIIa, reHeII1a, & + reHeII2a, reHeIIIa, brema, compa, gammaha, & + comp_xraya, comp_temp, & + piHI, piHeI, piHeII, comp1, comp2, & + HM, H2I, H2II, DI, DII, HDI, metal, & + hyd01ka, h2k01a, vibha, rotha, rotla, & + hyd01k, h2k01, vibh, roth, rotl, & + gpldla, gphdla, gpldl, gphdl, & + hdltea, hdlowa, hdlte, hdlow, & + gaHIa, gaH2a, gaHea, gaHpa, gaela, & + gasgra, metala, n_xe, xe_start, xe_end, & + ceHI, ceHeI, ceHeII, ciHI, ciHeI, ciHeIS, ciHeII,& + reHII, reHeII1, reHeII2, reHeIII, brem, & + indixe, t1, t2, logtem, tdef, edot, & + tgas, tgasold, p2d, tdust, metallicity, rhoH, & + inutot, iradtype, nfreq, imetalregen, & + iradshield, avgsighp, avgsighep, avgsighe2p, & + iradtrans, photogamma, & + ih2optical, iciecool, ciecoa, cieco, & + icmbTfloor, iClHeat, & + clEleFra, clGridRank, clGridDim, & + clPar1, clPar2, clPar3, clPar4, clPar5, & + clDataSize, clCooling, clHeating, & + itmask) + +! Look-up rates as a function of temperature for 1D set of zones +! (maybe should add itmask to this call) + + call lookup_cool_rates1d(temstart, temend, nratec, j, k, & + is, ie, imax, iradtype, iradshield, ithreebody, & + in, jn, kn, ispecies, idust, & + tgas, d, HI, HII, HeI, HeII, H2I, tdust, metallicity, & + k1a, k2a, k3a, k4a, k5a, k6a, k7a, k8a, k9a, k10a, & + k11a, k12a, k13a, k13dda, k14a, k15a, k16a, & + k17a, k18a, k19a, k22a, & + k50a, k51a, k52a, k53a, k54a, k55a, k56a, & + ndratec, dtemstart, dtemend, h2dusta, & + ncrna, ncrd1a, ncrd2a, & + avgsighp, avgsighep, avgsighe2p, piHI, piHeI, & + k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, & + k11, k12, k13, k14, k15, k16, k17, k18, & + k19, k22, k24, k25, k26, k31, & + k50, k51, k52, k53, k54, k55, & + k56, k13dd, k24shield, k25shield, k26shield, & + k31shield, h2dust, ncrn, ncrd1, ncrd2, & + t1, t2, tdef, logtem, indixe, & + dom, coolunit, tbase1, xbase1, dx_cgs, iradtrans, & + kdissH2I, itmask) + +! Compute dedot and HIdot, the rates of change of de and HI +! (should add itmask to this call) + + call rate_timestep(dedot, HIdot, ispecies, idust, & + de, HI, HII, HeI, HeII, HeIII, d, & + HM, H2I, H2II, & + in, jn, kn, is, ie, j, k, & + k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, & + k12, k13, k14, k15, k16, k17, k18, k19, k22, & + k24, k25, k26, k27, k28, k29, k30, & + k50, k51, k52, k53, k54, k55, k56, & + h2dust, ncrn, ncrd1, ncrd2, rhoH, & + k24shield, k25shield, k26shield, k31shield, & + iradtrans, irt_honly, kphHI, kphHeI, kphHeII, & + itmask, edot, chunit, dom) + +! Find timestep that keeps relative chemical changes below 10% + + do i = is+1, ie+1 + if (itmask(i)) then +! Bound from below to prevent numerical errors + + if (abs(dedot(i)) .lt. tiny) & + dedot(i) = min(tiny,de(i,j,k)) + if (abs(HIdot(i)) .lt. tiny) & + HIdot(i) = min(tiny,HI(i,j,k)) + +! If the net rate is almost perfectly balanced then set +! it to zero (since it is zero to available precision) + + if (min(abs(k1(i)* de(i,j,k)*HI(i,j,k)), & + abs(k2(i)*HII(i,j,k)*de(i,j,k)))/& + max(abs(dedot(i)),abs(HIdot(i))) .gt. 1.e6_RKIND) then + dedot(i) = tiny + HIdot(i) = tiny + endif + +! If the iteration count is high then take the smaller of +! the calculated dedot and last time step's actual dedot. +! This is intended to get around the problem of a low +! electron or HI fraction which is in equilibrium with high +! individual terms (which all nearly cancel). + + if (iter .gt. 50) then + dedot(i) = min(abs(dedot(i)), abs(dedot_prev(i))) + HIdot(i) = min(abs(HIdot(i)), abs(HIdot_prev(i))) + endif + +! compute minimum rate timestep + + olddtit = dtit(i) + dtit(i) = min(abs(0.1_RKIND*de(i,j,k)/dedot(i)), & + abs(0.1_RKIND*HI(i,j,k)/HIdot(i)), & + dt-ttot(i), 0.5_RKIND*dt) + + if (d(i,j,k)*dom .gt. 1.e8_RKIND .and. edot(i) .gt. 0._RKIND)then + ! Equilibrium value for H is: + ! H = (-1.0 / (4*k22)) * (k13 - sqrt(8 k13 k22 rho + k13^2)) + ! We now want this to change by 10% or less, but we're only + ! differentiating by dT. We have de/dt. We need dT/de. + ! T = (g-1)*p2d*utem/N; tgas == (g-1)(p2d*utem/N) + ! dH_eq / dt = (dH_eq/dT) * (dT/de) * (de/dt) + ! dH_eq / dT (see above; we can calculate the derivative here) + ! dT / de = utem * (gamma - 1.0) / N == tgas / p2d + ! de / dt = edot + ! Now we use our estimate of dT/de to get the estimated + ! difference in the equilibrium + eqt2 = min(log(tgas(i)) + 0.1_RKIND*dlogtem, t2(i)) + eqtdef = (eqt2 - t1(i))/(t2(i) - t1(i)) + eqk222 = k22a(indixe(i)) + & + (k22a(indixe(i)+1) -k22a(indixe(i)))*eqtdef + eqk132 = k13a(indixe(i)) + & + (k13a(indixe(i)+1) -k13a(indixe(i)))*eqtdef + heq2 = (-1._RKIND / (4._RKIND*eqk222)) * (eqk132- & + sqrt(8._RKIND*eqk132*eqk222*fh*d(i,j,k)+eqk132**2._RKIND)) + + eqt1 = max(log(tgas(i)) - 0.1_RKIND*dlogtem, t1(i)) + eqtdef = (eqt1 - t1(i))/(t2(i) - t1(i)) + eqk221 = k22a(indixe(i)) + & + (k22a(indixe(i)+1) -k22a(indixe(i)))*eqtdef + eqk131 = k13a(indixe(i)) + & + (k13a(indixe(i)+1) -k13a(indixe(i)))*eqtdef + heq1 = (-1._RKIND / (4._RKIND*eqk221)) * (eqk131- & + sqrt(8._RKIND*eqk131*eqk221*fh*d(i,j,k)+eqk131**2._RKIND)) + + dheq = (abs(heq2-heq1)/(exp(eqt2) - exp(eqt1))) & + * (tgas(i)/p2d(i)) * edot(i) + heq = (-1._RKIND / (4._RKIND*k22(i))) * (k13(i)- & + sqrt(8._RKIND*k13(i)*k22(i)*fh*d(i,j,k)+k13(i)**2._RKIND)) + !write(0,*) heq2, heq1, eqt2, eqt1, tgas(i), p2d(i), +! & edot(i) + if(d(i,j,k)*dom .gt. 1.e18_RKIND .and. i.eq.4) write(0, *) & + HI(i,j,k)/heq, edot(i),tgas(i) + dtit(i) = min(dtit(i), 0.1_RKIND*heq/dheq) + endif + if (iter .gt. 10) dtit(i) = min(olddtit*1.5_RKIND, dtit(i)) + +#define DONT_WRITE_COOLING_DEBUG +#ifdef WRITE_COOLING_DEBUG +! Output some debugging information if required +!#ifndef _OPENMP +!$omp critical + abs((dt-ttot(i))/dt) .gt. 1.e-3_RKIND) then + write(4,1000) iter,i,j,k,dtit(i), & + ttot(i),dt,de(i,j,k),dedot(i),HI(i,j,k),HIdot(i), & + tgas(i), dedot_prev(i), HIdot_prev(i) + write(4,1100) HI(i,j,k),HII(i,j,k), & + HeI(i,j,k),HeII(i,j,k),HeIII(i,j,k), & + HM(i,j,k),H2I(i,j,k),H2II(i,j,k),de(i,j,k) + write(4,1100) & + - k1(i) *de(i,j,k) *HI(i,j,k), & + - k7(i) *de(i,j,k) *HI(i,j,k), & + - k8(i) *HM(i,j,k) *HI(i,j,k), & + - k9(i) *HII(i,j,k) *HI(i,j,k), & + - k10(i)*H2II(i,j,k) *HI(i,j,k)/2._RKIND, & + - 2._RKIND*k22(i)*HI(i,j,k)**2 *HI(i,j,k), & + + k2(i) *HII(i,j,k) *de(i,j,k) , & + + 2._RKIND*k13(i)*HI(i,j,k) *H2I(i,j,k)/2._RKIND, & + + k11(i)*HII(i,j,k) *H2I(i,j,k)/2._RKIND, & + + 2._RKIND*k12(i)*de(i,j,k) *H2I(i,j,k)/2._RKIND, & + + k14(i)*HM(i,j,k) *de(i,j,k), & + + k15(i)*HM(i,j,k) *HI(i,j,k), & + + 2._RKIND*k16(i)*HM(i,j,k) *HII(i,j,k), & + + 2._RKIND*k18(i)*H2II(i,j,k) *de(i,j,k)/2._RKIND, & + + k19(i)*H2II(i,j,k) *HM(i,j,k)/2._RKIND + endif +!$omp end critical +!#endif /* _OPENMP */ + + 1000 format(i5,3(i3,1x),1p,11(e11.3)) + 1100 format(1p,20(e11.3)) +#endif /* WRITE_COOLING_DEBUG */ + else ! itmask + dtit(i) = dt; + endif + enddo ! end loop over i + +! Compute maximum timestep for cooling/heating + + do i = is+1, ie+1 + if (itmask(i)) then +! Set energy per unit volume of this cell based in the pressure +! (the gamma used here is the right one even for H2 since p2d +! is calculated with this gamma). + + energy = max(p2d(i)/(gamma-1._RKIND), tiny) + +! This is an alternate energy calculation, based directly on +! the code's specific energy field, which differs from the above +! only if using the dual energy formalism. + +! energy = max(ge(i,j,k)*d(i,j,k), p2d(i)/(gamma-1._RKIND), +! & tiny) +! if (energy .lt. tiny) energy = d(i,j,k)*(e(i,j,k) - +! & 0.5_RKIND*(u(i,j,k)**2 + v(i,j,k)**2 + w(i,j,k)**2)) + +! If the temperature is at the bottom of the temperature look-up +! table and edot < 0, then shut off the cooling. + + if (tgas(i) .le. 1.01_RKIND*temstart .and. edot(i) .lt. 0._RKIND)& + edot(i) = tiny + if (abs(edot(i)) .lt. tiny) edot(i) = tiny +! +! Compute timestep for 10% change + +! if (iter .gt. 100) then +! dtit(i) = min(real(abs(0.1_RKIND*energy/edot(i))), +! & dt-ttot(i), dtit(i)) +! else + dtit(i) = min(real(abs(0.1_RKIND*energy/edot(i)),RKIND), & + dt-ttot(i), dtit(i)) +! endif + + if (dtit(i) .ne. dtit(i)) & !##### + write(6,*) 'HUGE dtit :: ', energy, edot(i), dtit(i), & + dt, ttot(i), abs(0.1_RKIND*energy/edot(i)), & + real(abs(0.1_RKIND*energy/edot(i)),RKIND) + +#define FORTRAN_DEBUG +#ifdef FORTRAN_DEBUG + if (ge(i,j,k) .le. 0._RKIND .and. idual .eq. 1) & + write(6,*) 'a',ge(i,j,k),energy,d(i,j,k),e(i,j,k),iter + if (idual .eq. 1 .and. & + ge(i,j,k)+edot(i)/d(i,j,k)*dtit(i) .le. 0._RKIND) & + write(6,*) i,j,k,iter,ge(i,j,k),edot(i),tgas(i), & + energy,de(i,j,k),ttot(i),d(i,j,k),e(i,j,k) +#endif /* FORTRAN_DEBUG */ + +#ifdef WRITE_COOLING_DEBUG +! If the timestep is too small, then output some debugging info + +!#ifndef _OPENMP +!$omp critical + .or. iter .gt. itmax-100) .and. & + abs((dt-ttot(i))/dt) .gt. 1.e-3_RKIND) & + write(3,2000) i,j,k,iter,ge(i,j,k),edot(i),tgas(i), & + energy,de(i,j,k),ttot(i),d(i,j,k),e(i,j,k),dtit(i) +!$omp end critical +!#endif /* _OPENMP */ + 2000 format(4(i4,1x),1p,10(e14.3)) +#endif /* WRITE_COOLING_DEBUG */ + endif ! itmask + enddo ! end loop over i + +! Update total and gas energy + + do i = is+1, ie+1 + if (itmask(i)) then + e(i,j,k) = e(i,j,k) + edot(i)/d(i,j,k)*dtit(i) +#ifdef WRITE_COOLING_DEBUG + if (e(i,j,k) .ne. e(i,j,k)) & + write(3,*) edot(i),d(i,j,k),dtit(i) +#endif /* WRITE_COOLING_DEBUG */ + +! If using the dual energy formalism, there are 2 energy fields + + if (idual .eq. 1) then + ge(i,j,k) = ge(i,j,k) + edot(i)/d(i,j,k)*dtit(i) + +! Alternate energy update schemes (not currently used) + +! ge(i,j,k) = max(ge(i,j,k) + edot(i)/d(i,j,k)*dtit(i), +! & 0.5_RKIND*ge(i,j,k)) +! if (ge(i,j,k) .le. tiny) ge(i,j,k) = (energy + +! & edot(i)*dtit(i))/d(i,j,k) +#ifdef WRITE_COOLING_DEBUG + if (ge(i,j,k) .le. 0._RKIND) write(3,*) & + 'a',ge(i,j,k),energy,d(i,j,k),e(i,j,k),iter +#endif /* WRITE_COOLING_DEBUG */ + endif + endif ! itmask + enddo + +! Solve rate equations with one linearly implicit Gauss-Seidel +! sweep of a backward Euler method --- + + call step_rate(de, HI, HII, HeI, HeII, HeIII, d, & + HM, H2I, H2II, DI, DII, HDI, dtit, & + in, jn, kn, is, ie, j, k, ispecies, idust, & + k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, & + k12, k13, k14, k15, k16, k17, k18, k19, k22, & + k24, k25, k26, k27, k28, k29, k30, & + k50, k51, k52, k53, k54, k55, k56, & + h2dust, rhoH, & + k24shield, k25shield, k26shield, k31shield, & + HIp, HIIp, HeIp, HeIIp, HeIIIp, dep, & + HMp, H2Ip, H2IIp, DIp, DIIp, HDIp, & + dedot_prev, HIdot_prev, & + iradtrans, irt_honly, kphHI, kphHeI, kphHeII, & + itmask) + +! Add the timestep to the elapsed time for each cell and find +! minimum elapsed time step in this row + + ttmin = huge + do i = is+1, ie+1 + ttot(i) = min(ttot(i) + dtit(i), dt) + if (abs(dt-ttot(i)) .lt. 0.001_RKIND*dt) itmask(i) = .false. + if (ttot(i).lt.ttmin) ttmin = ttot(i) + enddo + +! If all cells are done (on this slice), then exit + + if (abs(dt-ttmin) .lt. tolerance*dt) go to 9999 + +! Next subcycle iteration + + enddo + + 9999 continue + +! Abort if iteration count exceeds maximum + + if (iter .gt. itmax) then + write(0,*) 'inside if statement solve rate cool:',is,ie + write(6,*) 'MULTI_COOL iter > ',itmax,' at j,k =',j,k + write(0,*) 'FATAL error (2) in MULTI_COOL' + write(0,'(" dt = ",1pe10.3," ttmin = ",1pe10.3)') dt, ttmin + write(0,'((16(1pe8.1)))') (dtit(i),i=is+1,ie+1) + write(0,'((16(1pe8.1)))') (ttot(i),i=is+1,ie+1) + write(0,'((16(1pe8.1)))') (edot(i),i=is+1,ie+1) + write(0,'((16(l3)))') (itmask(i),i=is+1,ie+1) + WARNING_MESSAGE + endif + + if (iter .gt. itmax/2_IKIND) then + write(6,*) 'MULTI_COOL iter,j,k =',iter,j,k + end if +! +! Next j,k +! + enddo + enddo + +! Convert densities back to comoving from proper + + call scale_fields(d, de, HI, HII, HeI, HeII, HeIII, & + HM, H2I, H2II, DI, DII, HDI, metal, & + is, ie, js, je, ks, ke, & + in, jn, kn, ispecies, imetal, aye**3) + +! Correct the species to ensure consistency (i.e. type conservation) + + call make_consistent(de, HI, HII, HeI, HeII, HeIII, & + HM, H2I, H2II, DI, DII, HDI, metal, & + d, is, ie, js, je, ks, ke, & + in, jn, kn, imax, ispecies, imetal, fh, dtoh) + +! +!\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\///////////////////////////////// +!======================================================================= +! Deallocations +!======================================================================= + + deallocate(indixe) + deallocate(t1) + deallocate(t2) + deallocate(logtem) + deallocate(tdef) + deallocate(dtit) + deallocate(ttot) + deallocate(p2d) + deallocate(tgas) + deallocate(tgasold) + deallocate(HIp) + deallocate(HIIp) + deallocate(HeIp) + deallocate(HeIIp) + deallocate(HeIIIp) + deallocate(HMp) + deallocate(H2Ip) + deallocate(H2IIp) + deallocate(dep) + deallocate(dedot) + deallocate(HIdot) + deallocate(dedot_prev) + deallocate(DIp) + deallocate(DIIp) + deallocate(HDIp) + deallocate(HIdot_prev) + deallocate(k24shield) + deallocate(k25shield) + deallocate(k26shield) + deallocate(k31shield) + deallocate(k1) + deallocate(k2) + deallocate(k3) + deallocate(k4) + deallocate(k5) + deallocate(k6) + deallocate(k7) + deallocate(k8) + deallocate(k9) + deallocate(k10) + deallocate(k11) + deallocate(k12) + deallocate(k13) + deallocate(k14) + deallocate(k15) + deallocate(k16) + deallocate(k17) + deallocate(k18) + deallocate(k19) + deallocate(k22) + deallocate(k50) + deallocate(k51) + deallocate(k52) + deallocate(k53) + deallocate(k54) + deallocate(k55) + deallocate(k56) + deallocate(k13dd) + deallocate(ceHI) + deallocate(ceHeI) + deallocate(ceHeII) + deallocate(ciHI) + deallocate(ciHeI) + deallocate(ciHeIS) + deallocate(ciHeII) + deallocate(reHII) + deallocate(reHeII1) + deallocate(reHeII2) + deallocate(reHeIII) + deallocate(brem) + deallocate(edot) + deallocate(hyd01k) + deallocate(h2k01) + deallocate(vibh) + deallocate(roth) + deallocate(rotl) + deallocate(cieco) + deallocate(gpldl) + deallocate(gphdl) + deallocate(hdlte) + deallocate(hdlow) + deallocate(itmask) + deallocate(tdust) + deallocate(metallicity) + deallocate(rhoH) + deallocate(h2dust) + deallocate(ncrn) + deallocate(ncrd1) + deallocate(ncrd2) + + + return + end subroutine solve_rate_cool diff --git a/src/enzo/utilities.F b/src/enzo/utilities.F index bfbb09129..7b719a9b1 100644 --- a/src/enzo/utilities.F +++ b/src/enzo/utilities.F @@ -59,6 +59,7 @@ subroutine copy3d(source, dest, sdim1, sdim2, sdim3, end2 = min(sstart2+sdim2, dstart2+ddim2) - 1 end3 = min(sstart3+sdim3, dstart3+ddim3) - 1 c +c !$omp parallel do private(i,j,k) schedule(static) do k = start3, end3 do j = start2, end2 do i = start1, end1 @@ -67,6 +68,7 @@ subroutine copy3d(source, dest, sdim1, sdim2, sdim3, enddo enddo enddo +c !$omp end parallel do c return end @@ -125,6 +127,7 @@ subroutine copy3drel(source, dest, c c determine the overlap area in global coordinates c +c!$omp parallel do private(i,j,k) do k = 1, dim3 do j = 1, dim2 do i = 1, dim1 @@ -133,6 +136,7 @@ subroutine copy3drel(source, dest, enddo enddo enddo +c!$omp end parallel do c return end @@ -198,6 +202,7 @@ subroutine copy3dint(source, dest, sdim1, sdim2, sdim3, end2 = min(sstart2+sdim2, dstart2+ddim2) - 1 end3 = min(sstart3+sdim3, dstart3+ddim3) - 1 c +c !$omp parallel do private(i,j,k) schedule(static) do k = start3, end3 do j = start2, end2 do i = start1, end1 @@ -206,6 +211,7 @@ subroutine copy3dint(source, dest, sdim1, sdim2, sdim3, enddo enddo enddo +c !$omp end parallel do c return end @@ -235,7 +241,6 @@ subroutine copy3dbool(source, dest, sdim1, sdim2, sdim3, c c OUTPUT ARGUMENTS: c line - projected line -c c EXTERNALS: c c LOCALS: @@ -251,7 +256,7 @@ subroutine copy3dbool(source, dest, sdim1, sdim2, sdim3, c INTG_PREC ddim1, ddim2, ddim3, dstart1, dstart2, dstart3, & sdim1, sdim2, sdim3, sstart1, sstart2, sstart3 - logical*1 source(sdim1, sdim2, sdim3), dest(ddim1, ddim2, ddim3) + LOGIC_PREC source(sdim1, sdim2, sdim3), dest(ddim1, ddim2, ddim3) c c locals c @@ -270,6 +275,7 @@ subroutine copy3dbool(source, dest, sdim1, sdim2, sdim3, end2 = min(sstart2+sdim2, dstart2+ddim2) - 1 end3 = min(sstart3+sdim3, dstart3+ddim3) - 1 c +c !$omp parallel do private(i,j,k) schedule(static) do k = start3, end3 do j = start2, end2 do i = start1, end1 @@ -278,6 +284,7 @@ subroutine copy3dbool(source, dest, sdim1, sdim2, sdim3, enddo enddo enddo +c !$omp end parallel do c return end @@ -344,6 +351,7 @@ subroutine mult3d(source, dest, sdim1, sdim2, sdim3, end2 = min(sstart2+sdim2, dstart2+ddim2) - 1 end3 = min(sstart3+sdim3, dstart3+ddim3) - 1 c +c !$omp parallel do private(i,j,k) schedule(static) do k = start3, end3 do j = start2, end2 do i = start1, end1 @@ -353,6 +361,7 @@ subroutine mult3d(source, dest, sdim1, sdim2, sdim3, enddo enddo enddo +c !$omp end parallel do c return end @@ -423,6 +432,7 @@ subroutine div3d(source, dest, sdim1, sdim2, sdim3, end2 = min(sstart2+sdim2-1, dstart2+ddim2-1, rend2) end3 = min(sstart3+sdim3-1, dstart3+ddim3-1, rend3) c +c!$omp parallel do private(i,j,k) schedule(static) do k = start3, end3 do j = start2, end2 do i = start1, end1 @@ -432,6 +442,7 @@ subroutine div3d(source, dest, sdim1, sdim2, sdim3, enddo enddo enddo +c!$omp end parallel do c return end @@ -501,8 +512,12 @@ subroutine combine3d(source1, weight1, source2, weight2, end1 = min(sstart1+sdim1, dstart1+ddim1) - 1 end2 = min(sstart2+sdim2, dstart2+ddim2) - 1 end3 = min(sstart3+sdim3, dstart3+ddim3) - 1 + + fact1 = (real(irefine)+1.0)/(2.0*real(irefine)) + fact2 = (real(irefine)-1.0)/(2.0*real(irefine)) c if (ivel_shift .eq. 0) then +c!$omp parallel do private(i,j,k) schedule(static) do k = start3, end3 do j = start2, end2 do i = start1, end1 @@ -512,9 +527,11 @@ subroutine combine3d(source1, weight1, source2, weight2, enddo enddo enddo +c!$omp end parallel do endif c if (ivel_shift .eq. 1) then +c!$omp parallel do private(i,j,k,fact1,fact2) schedule(static) do k = start3, end3 do j = start2, end2 fact1 = (REAL(irefine,RKIND)+1.0)/(2.0*REAL(irefine,RKIND)) @@ -529,9 +546,11 @@ subroutine combine3d(source1, weight1, source2, weight2, enddo enddo enddo +c!$omp end parallel do endif c if (ivel_shift .eq. 2) then +c!$omp parallel do private(i,j,k,fact1,fact2) schedule(static) do k = start3, end3 do j = start2, end2 fact1 = (REAL(irefine,RKIND)+1.0)/(2.0*REAL(irefine,RKIND)) @@ -546,9 +565,11 @@ subroutine combine3d(source1, weight1, source2, weight2, enddo enddo enddo +c!$omp end parallel do endif c if (ivel_shift .eq. 3) then +c!$omp parallel do private(i,j,k,fact1,fact2) schedule(static) do k = start3, end3 do j = start2, end2 fact1 = (REAL(irefine,RKIND)+1.0)/(2.0*REAL(irefine,RKIND)) @@ -563,6 +584,7 @@ subroutine combine3d(source1, weight1, source2, weight2, enddo enddo enddo +c!$omp end parallel do endif c return diff --git a/src/enzo/wrapper2d.F90 b/src/enzo/wrapper2d.F90 index c16767887..1be55a0b3 100644 --- a/src/enzo/wrapper2d.F90 +++ b/src/enzo/wrapper2d.F90 @@ -28,18 +28,29 @@ subroutine wrapper2d(x, rank, n1, n2, n3, dir, method) n(2) = 1 n(3) = 1 +!$omp parallel do & +!$omp private(j) & +!$omp shared(n2, x, n, dir) & +!$omp default(none) do j=1,n2 call fftwrap2d( x(1,j), n, dir, method ) end do +!$omp end parallel do allocate( y(n2,n1) ) call rotate2d(x,n1,n2,y) n(1) = n2 + +!$omp parallel do & +!$omp private(i) & +!$omp shared(n1, y, n, dir) & +!$omp default(none) do i=1,n1 call fftwrap2d( y(1,i), n, dir, method ) end do +!$omp end parallel do call rotate2d(y,n2,n1,x) diff --git a/src/enzo/wrapper3d.F90 b/src/enzo/wrapper3d.F90 index 8b70fe81d..e05ccb29b 100644 --- a/src/enzo/wrapper3d.F90 +++ b/src/enzo/wrapper3d.F90 @@ -31,22 +31,35 @@ subroutine wrapper3d(x, rank, n1, n2, n3, dir, method) n(2) = 1 n(3) = 1 +!$omp parallel do & +!$omp collapse(2) & +!$omp private(j, k) & +!$omp shared(n2,n3, x, n, dir) & +!$omp default(none) do k=1,n3 do j=1,n2 call fftwrap3d( x(1,j,k), n, dir, method ) end do end do +!$omp end parallel do allocate( y(n2,n3,n1) ) call rotate3d(x,n1,n2,n3,y) n(1) = n2 + +!$omp parallel do & +!$omp collapse(2) & +!$omp private(i, k) & +!$omp shared(n1,n3, y, n, dir) & +!$omp default(none) do i=1,n1 do k=1,n3 call fftwrap3d( y(1,k,i), n, dir, method ) end do end do +!$omp end parallel do allocate( z(n3,n1,n2) ) @@ -55,11 +68,18 @@ subroutine wrapper3d(x, rank, n1, n2, n3, dir, method) deallocate( y) n(1) = n3 + +!$omp parallel do & +!$omp collapse(2) & +!$omp private(i, k) & +!$omp shared(n1,n2, z, n, dir) & +!$omp default(none) do j=1,n2 do i=1,n1 call fftwrap3d( z(1,i,j), n, dir, method ) end do end do +!$omp end parallel do call rotate3d(z,n3,n1,n2,x)