├── ACKNOWLEDGMENTS ├── COPYING ├── DEVELOPERS ├── INSTALL ├── README.md ├── channel_18 ├── 0 │ ├── phi0x │ ├── phi0y │ ├── phi0z │ ├── psi │ ├── ux │ ├── uy │ └── uz └── specs │ ├── decompose │ ├── flowControl │ ├── flowSolver │ ├── fstart_bc │ ├── c │ ├── psi │ └── u │ ├── initBubbles │ ├── initVelocity │ ├── mesh │ ├── parameters │ ├── pcg_solver │ ├── schemes │ └── timeControl ├── src ├── Makefile ├── VOF │ ├── VOF.f90 │ └── vofBlocks.f90 ├── allocateArrays │ └── allocateArrays.f90 ├── auxiliaryRoutines │ └── auxiliaryRoutines.f90 ├── createFields_H.f90 ├── errorHandler │ └── errorHandler.f90 ├── fastPoissonSolver │ └── fastPoissonSolver.f90 ├── fields │ ├── field │ │ ├── boundaryField_H.f90 │ │ ├── boundaryField_S.f90 │ │ └── field.f90 │ ├── formats.f90 │ ├── parFile.f90 │ └── vfield │ │ └── vfield.f90 ├── grid │ └── grid.f90 ├── initMpiGvar │ └── initMpiGvar.f90 ├── initialConditions │ └── initialConditions.f90 ├── interpolation │ └── interpolation.f90 ├── kinds │ └── kinds.f90 ├── main.f90 ├── momentumEqn │ └── momentumEqn.f90 ├── mpiControl │ └── mpiControl.f90 ├── multiGrid │ └── multiGrid.f90 ├── ompRoutines │ └── ompRoutines.f90 ├── pcg │ └── pcg.f90 ├── pencilDec │ └── pencilDec.f90 ├── poissMat │ └── poissMat.f90 ├── poissonEqn │ └── poissonEqn.f90 ├── rampUpProp │ └── rampUpProp.f90 ├── rbgs │ └── rbgs.f90 ├── solverTypes │ └── solverTypes.f90 ├── statistics │ └── statistics.f90 ├── time │ └── time.f90 └── writeFields_H.f90 └── user_guide └── user_guide.pdf /ACKNOWLEDGMENTS: -------------------------------------------------------------------------------- 1 | This work is part of the research programme 'Boiling flow regime maps for safe designing' 2 | with project number 12386, which was (partly) financed 3 | by the Netherlands Organisation for Scientific Research (NWO). 4 | 5 | This work was carried out on the Dutch national e-infrastructure 6 | with the support of SURF Cooperative. -------------------------------------------------------------------------------- /DEVELOPERS: -------------------------------------------------------------------------------- 1 | Developers: 2 | 3 | dr. Paolo Cifani 4 | 5 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | ------------------------------------ 2 | How to compile the solver: 3 | 4 | - go to directory TBFsolver 5 | - type `make' 6 | 7 | ------------------------------------ 8 | Dependencies: 9 | 10 | Set the dependencies for the following libraries (follow instruction in MakeFile): 11 | 12 | - LAPACK 13 | - FFTW3 (multi-threaded version) 14 | - MUMPS (parallel MPI version) 15 | 16 | Please refer to the websites of these libraries to download and link the relevant 17 | files. 18 | 19 | ------------------------------------ 20 | Compiler flags: 21 | 22 | - POIS_OPT: set to FAST_MODE to compile the fast-Poisson solver; 23 | set to MG_MODE to compile the multi-grid Poisson solver. 24 | 25 | 26 | The optimisation flag is set to -O2 by default. Uncomment debug or extended 27 | debug flags to activate the debugging mode. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # TBFsolver 2 | DNS Turbulent Bubbly Flow solver 3 | 4 | TBFsolver is a massively parallel solver for Direct Numerical Simulation (DNS) of turbulent bubble-laden channel flow. See [P. Cifani - Highly scalable DNS solver for turbulent bubble-laden channel flow](https://www.sciencedirect.com/science/article/pii/S0045793018303311) for more details. 5 | 6 | ## COPYING 7 | TBFsolver is distributed under the terms of the General Public License. See the file COPYING for details. 8 | 9 | ## INSTALLATION 10 | See file 'INSTALL' for instructions. 11 | 12 | ## USAGE 13 | TBFsolver is being continuously updated in order to fix possible bugs and add new features. Please, make sure you have downloaded the latest version of the code. An example of a test-case of a minimum turbulent channel flow, loaded with 18 deformable bubbles, is given in folder 'case_18'. Please refer to the [user guide](user_guide/user_guide.pdf) for an overview of the input parameters. 14 | 15 | ## FORUM 16 | If you would like to get support from the developer as well as from other users, or simply ask general questions and share ideas related to TBFsolver, please join the web forum. You can do so by sending an email to cifani.pl@gmail.com, after which you will receive an invitation to join the group. 17 | 18 | ### AWARD 19 | Wim Nieuwpoort Award 2107: Best numerical code in the Netherlands for serious applications on a significant part of a large High Performance Computing system. 20 | 21 | ### CITATION 22 | You can acknowledge the use of this code in any scientific publication/work using the following reference: 23 | 24 | [P. Cifani - Highly scalable DNS solver for turbulent bubble-laden channel flow](https://www.sciencedirect.com/science/article/pii/S0045793018303311) 25 | 26 | and the following DOI: 27 | 28 | [https://doi.org/10.5281/zenodo.1222098](https://doi.org/10.5281/zenodo.1222098) 29 | -------------------------------------------------------------------------------- /channel_18/0/ux: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cifanip/TBFsolver/1b595e017f2a7dfa0ca25528411a79d19ae34127/channel_18/0/ux -------------------------------------------------------------------------------- /channel_18/0/uy: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cifanip/TBFsolver/1b595e017f2a7dfa0ca25528411a79d19ae34127/channel_18/0/uy -------------------------------------------------------------------------------- /channel_18/0/uz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cifanip/TBFsolver/1b595e017f2a7dfa0ca25528411a79d19ae34127/channel_18/0/uz -------------------------------------------------------------------------------- /channel_18/specs/decompose: -------------------------------------------------------------------------------- 1 | 2 | ! ************************************************************************************** ! 3 | ! TBFsolver - DNS turbulent bubbly flow solver 4 | ! Copyright (C) 2018 University of Twente. 5 | ! 6 | ! This program is free software: you can redistribute it and/or modify 7 | ! it under the terms of the GNU General Public License as published by 8 | ! the Free Software Foundation, either version 3 of the License, or 9 | ! (at your option) any later version. 10 | ! 11 | ! This program is distributed in the hope that it will be useful, 12 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ! GNU General Public License for more details. 15 | ! 16 | ! You should have received a copy of the GNU General Public License 17 | ! along with this program. If not, see . 18 | ! ************************************************************************************** ! 19 | 20 | px 4 21 | py 1 22 | pz 2 23 | 24 | wrap_x .true. 25 | wrap_y .false. 26 | wrap_z .true. 27 | -------------------------------------------------------------------------------- /channel_18/specs/flowControl: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | ! <1 or >2 = switch off control 20 | !1 = fixed pressure gradient 21 | !2 = fixed flow rate 22 | !3 = balance gravity force - fully periodic box (g is along x) 23 | 24 | flowCtrl 1 25 | Ret 127.3d0 26 | 27 | 28 | -------------------------------------------------------------------------------- /channel_18/specs/flowSolver: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | !1 = single-phase flow mode 20 | !2 = two-phase flow mode 21 | 22 | flow_solver 2 23 | 24 | 25 | -------------------------------------------------------------------------------- /channel_18/specs/fstart_bc/c: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | grid_type cl 20 | 21 | !initial field: 22 | ! init_opt: 1 --> init field = iv 23 | ! 2 --> read init field from file 24 | init_opt 1 25 | iv 0.d0 26 | 27 | !b.c.: 1 --> fixedValue 28 | ! 2 --> normalGradient 29 | ! 3 --> periodicBC 30 | 31 | !boundary ordering: left,right,bottom,top,back,front 32 | 33 | b1 3 34 | b2 3 35 | b3 2 36 | b4 2 37 | b5 3 38 | b6 3 39 | 40 | bv1 0.d0 41 | bv2 0.d0 42 | bv3 0.d0 43 | bv4 0.d0 44 | bv5 0.d0 45 | bv6 0.d0 -------------------------------------------------------------------------------- /channel_18/specs/fstart_bc/psi: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | grid_type cl 20 | 21 | !initial field: 22 | ! init_opt: 1 --> init field = iv 23 | ! 2 --> read init field from file 24 | init_opt 2 25 | iv 0.d0 26 | 27 | !b.c.: 1 --> fixedValue 28 | ! 2 --> normalGradient 29 | ! 3 --> periodicBC 30 | 31 | !boundary ordering: left,right,bottom,top,back,front 32 | 33 | b1 3 34 | b2 3 35 | b3 2 36 | b4 2 37 | b5 3 38 | b6 3 39 | 40 | bv1 0.d0 41 | bv2 0.d0 42 | bv3 0.d0 43 | bv4 0.d0 44 | bv5 0.d0 45 | bv6 0.d0 -------------------------------------------------------------------------------- /channel_18/specs/fstart_bc/u: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | gridx_type sx 20 | gridy_type sy 21 | gridz_type sz 22 | 23 | !initial field: 24 | ! init_opt: 1 --> init field = ivx,ivy,ivz 25 | ! 2 --> read init field from file 26 | init_opt 2 27 | ivx 0.d0 28 | ivy 0.d0 29 | ivz 0.d0 30 | 31 | !b.c.: 1 --> fixedValue 32 | ! 2 --> normalGradient 33 | ! 3 --> periodicBC 34 | 35 | !boundary ordering: left,right,bottom,top,back,front 36 | 37 | ! ------- ux 38 | bx1 3 39 | bx2 3 40 | bx3 1 41 | bx4 1 42 | bx5 3 43 | bx6 3 44 | 45 | bvx1 0.d0 46 | bvx2 0.d0 47 | bvx3 0.d0 48 | bvx4 0.d0 49 | bvx5 0.d0 50 | bvx6 0.d0 51 | 52 | ! ------- uy 53 | by1 3 54 | by2 3 55 | by3 1 56 | by4 1 57 | by5 3 58 | by6 3 59 | 60 | bvy1 0.d0 61 | bvy2 0.d0 62 | bvy3 0.d0 63 | bvy4 0.d0 64 | bvy5 0.d0 65 | bvy6 0.d0 66 | 67 | ! ------- uz 68 | bz1 3 69 | bz2 3 70 | bz3 1 71 | bz4 1 72 | bz5 3 73 | bz6 3 74 | 75 | bvz1 0.d0 76 | bvz2 0.d0 77 | bvz3 0.d0 78 | bvz4 0.d0 79 | bvz5 0.d0 80 | bvz6 0.d0 81 | 82 | -------------------------------------------------------------------------------- /channel_18/specs/initBubbles: -------------------------------------------------------------------------------- 1 | 2 | ! ************************************************************************************** ! 3 | ! TBFsolver - DNS turbulent bubbly flow solver 4 | ! Copyright (C) 2018 University of Twente. 5 | ! 6 | ! This program is free software: you can redistribute it and/or modify 7 | ! it under the terms of the GNU General Public License as published by 8 | ! the Free Software Foundation, either version 3 of the License, or 9 | ! (at your option) any later version. 10 | ! 11 | ! This program is distributed in the hope that it will be useful, 12 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ! GNU General Public License for more details. 15 | ! 16 | ! You should have received a copy of the GNU General Public License 17 | ! along with this program. If not, see . 18 | ! ************************************************************************************** ! 19 | 20 | method 2 21 | nbx 6 22 | nby 1 23 | nbz 3 24 | R 0.125d0 25 | nref 50 26 | 27 | random_distr .FALSE. 28 | -------------------------------------------------------------------------------- /channel_18/specs/initVelocity: -------------------------------------------------------------------------------- 1 | 2 | ! ************************************************************************************** ! 3 | ! TBFsolver - DNS turbulent bubbly flow solver 4 | ! Copyright (C) 2018 University of Twente. 5 | ! 6 | ! This program is free software: you can redistribute it and/or modify 7 | ! it under the terms of the GNU General Public License as published by 8 | ! the Free Software Foundation, either version 3 of the License, or 9 | ! (at your option) any later version. 10 | ! 11 | ! This program is distributed in the hope that it will be useful, 12 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ! GNU General Public License for more details. 15 | ! 16 | ! You should have received a copy of the GNU General Public License 17 | ! along with this program. If not, see . 18 | ! ************************************************************************************** ! 19 | 20 | perturbed_parabolic .FALSE. 21 | icA 22.5d0 22 | -------------------------------------------------------------------------------- /channel_18/specs/mesh: -------------------------------------------------------------------------------- 1 | 2 | ! ************************************************************************************** ! 3 | ! TBFsolver - DNS turbulent bubbly flow solver 4 | ! Copyright (C) 2018 University of Twente. 5 | ! 6 | ! This program is free software: you can redistribute it and/or modify 7 | ! it under the terms of the GNU General Public License as published by 8 | ! the Free Software Foundation, either version 3 of the License, or 9 | ! (at your option) any later version. 10 | ! 11 | ! This program is distributed in the hope that it will be useful, 12 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ! GNU General Public License for more details. 15 | ! 16 | ! You should have received a copy of the GNU General Public License 17 | ! along with this program. If not, see . 18 | ! ************************************************************************************** ! 19 | 20 | Lx 3.141592653589793d0 21 | Ly 2.0d0 22 | Lz 1.570796326794897d0 23 | 24 | isXunif .TRUE. 25 | isYunif .TRUE. 26 | isZunif .TRUE. 27 | 28 | nx 192 29 | ny 160 30 | nz 96 31 | 32 | -------------------------------------------------------------------------------- /channel_18/specs/parameters: -------------------------------------------------------------------------------- 1 | 2 | ! ************************************************************************************** ! 3 | ! TBFsolver - DNS turbulent bubbly flow solver 4 | ! Copyright (C) 2018 University of Twente. 5 | ! 6 | ! This program is free software: you can redistribute it and/or modify 7 | ! it under the terms of the GNU General Public License as published by 8 | ! the Free Software Foundation, either version 3 of the License, or 9 | ! (at your option) any later version. 10 | ! 11 | ! This program is distributed in the hope that it will be useful, 12 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ! GNU General Public License for more details. 15 | ! 16 | ! You should have received a copy of the GNU General Public License 17 | ! along with this program. If not, see . 18 | ! ************************************************************************************** ! 19 | 20 | rhol 1.d0 21 | rhog 1.d-1 22 | mul 3.33333333333333d-04 23 | mug 3.33333333333333d-04 24 | sigma 5.d-3 25 | 26 | gCH 1.d-1 27 | g 0.d0 28 | -------------------------------------------------------------------------------- /channel_18/specs/pcg_solver: -------------------------------------------------------------------------------- 1 | 2 | ! ************************************************************************************** ! 3 | ! TBFsolver - DNS turbulent bubbly flow solver 4 | ! Copyright (C) 2018 University of Twente. 5 | ! 6 | ! This program is free software: you can redistribute it and/or modify 7 | ! it under the terms of the GNU General Public License as published by 8 | ! the Free Software Foundation, either version 3 of the License, or 9 | ! (at your option) any later version. 10 | ! 11 | ! This program is distributed in the hope that it will be useful, 12 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ! GNU General Public License for more details. 15 | ! 16 | ! You should have received a copy of the GNU General Public License 17 | ! along with this program. If not, see . 18 | ! ************************************************************************************** ! 19 | 20 | !************* multigrid 21 | nLevels 5 22 | nPreSweep 2 23 | nPostSweep 4 24 | 25 | tolMG 4.d-1 26 | maxIterMG 100 27 | fullInfoMG .F. 28 | 29 | !************* pcg 30 | tolPCG 1.d-10 31 | maxIterPCG 100 32 | fullInfoPCG .F. 33 | -------------------------------------------------------------------------------- /channel_18/specs/schemes: -------------------------------------------------------------------------------- 1 | 2 | ! ************************************************************************************** ! 3 | ! TBFsolver - DNS turbulent bubbly flow solver 4 | ! Copyright (C) 2018 University of Twente. 5 | ! 6 | ! This program is free software: you can redistribute it and/or modify 7 | ! it under the terms of the GNU General Public License as published by 8 | ! the Free Software Foundation, either version 3 of the License, or 9 | ! (at your option) any later version. 10 | ! 11 | ! This program is distributed in the hope that it will be useful, 12 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ! GNU General Public License for more details. 15 | ! 16 | ! You should have received a copy of the GNU General Public License 17 | ! along with this program. If not, see . 18 | ! ************************************************************************************** ! 19 | 20 | !select time integration scheme 21 | ! scheme 0 -> B2 22 | ! scheme 1 -> RK3 23 | time_scheme 0 24 | 25 | !select convection scheme 26 | ! scheme 0 -> CD 27 | ! scheme 1 -> UD 28 | ! scheme 2 -> QUICK 29 | ! scheme 3 -> Van Leer 30 | ! scheme 4 -> Superbee 31 | ! scheme 5 -> Local Superbee (based on grad(c)) 32 | convection_scheme 2 33 | -------------------------------------------------------------------------------- /channel_18/specs/timeControl: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | 20 | Tf 100.d0 21 | dt 1.d-3 22 | writeInterval -1 23 | dtout 100.d0 24 | input_folder 0 25 | 26 | setTimeStep .T. 27 | 28 | adaptiveTimeStep .T. 29 | cflMax 0.1d0 30 | 31 | !stats average 32 | process_averages .T. 33 | Ts 0.d0 34 | 35 | !ramp up props 36 | Tr 1.d-1 37 | isRampUp .F. 38 | 39 | !vof blocks redistribution 40 | vofBlocksRedInterval 1.d-1 41 | 42 | !vof blocks re-initialization 43 | restart_boxes .F. 44 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile 2 | EXE = TBFsolver 3 | POIS_OPT = FAST_MODE 4 | MEM_OPT = MEM_SAVE 5 | #select the compiler 6 | COMPILER = 7 | 8 | #if POIS_OPT=MG_MODE add paths to MUMPS lib 9 | MUMPS_INCL = 10 | MUMPS_LIB_DIR = 11 | 12 | MUMPS_FLAGS = -ldmumps -lmumps_common -lpord -lmetis -lesmumps \ 13 | -lscotch -lscotcherr 14 | FFTW_FLAGS = -lfftw3_omp -lfftw3 -lm 15 | LAPACK_FLAGS = -lopenblas -lscalapack 16 | 17 | ifeq ($(POIS_OPT),MG_MODE) 18 | LIBS = $(MUMPS_FLAGS) $(LAPACK_FLAGS) 19 | LIB_DIRS = $(MUMPS_LIB_DIR) 20 | else ifeq ($(POIS_OPT),FAST_MODE) 21 | LIBS = $(FFTW_FLAGS) $(LAPACK_FLAGS) 22 | #path to above LIBS may be necessary. if so, add below 23 | LIB_DIRS = 24 | endif 25 | 26 | #modify the flags according to the chosen compiler 27 | OMP_FLAG = -qopenmp 28 | 29 | STACK_OPT = 30 | #STACK_OPT = -heap-arrays 31 | 32 | #debug 33 | #FLAGS = -g -check all -traceback #-fpe0 34 | 35 | #optimal 36 | FLAGS = -O2 -traceback 37 | 38 | ifeq ($(POIS_OPT),MG_MODE) 39 | OBJS = solverTypes.o kinds.o formats.o interpolation.o initMpiGvar.o ompRoutines.o errorHandler.o allocateArrays.o \ 40 | mpiControl.o grid.o parFile.o field.o rbgs.o poissMat.o multiGrid.o vfield.o momentumEqn.o vofBlocks.o \ 41 | poissonEqn.o time.o auxiliaryRoutines.o initialConditions.o VOF.o statistics.o pcg.o rampUpProp.o main.o 42 | else ifeq ($(POIS_OPT),FAST_MODE) 43 | OBJS = solverTypes.o kinds.o formats.o interpolation.o initMpiGvar.o ompRoutines.o errorHandler.o allocateArrays.o \ 44 | mpiControl.o grid.o parFile.o field.o vfield.o momentumEqn.o poissonEqn.o time.o vofBlocks.o \ 45 | auxiliaryRoutines.o initialConditions.o statistics.o pencilDec.o fastPoissonSolver.o VOF.o rampUpProp.o main.o 46 | endif 47 | 48 | ifeq ($(POIS_OPT),MG_MODE) 49 | $(EXE) : $(OBJS) 50 | $(COMPILER) -o $(EXE) -I$(MUMPS_INCL) -L$(LIB_DIRS) $(OBJS) $(LIBS) $(OMP_FLAG) 51 | else ifeq ($(POIS_OPT),FAST_MODE) 52 | $(EXE) : $(OBJS) 53 | $(COMPILER) -o $(EXE) $(OBJS) $(LIBS) $(OMP_FLAG) 54 | endif 55 | 56 | solverTypes.o: solverTypes/solverTypes.f90 57 | $(COMPILER) -c $(FLAGS) solverTypes/solverTypes.f90 58 | 59 | kinds.o: kinds/kinds.f90 60 | $(COMPILER) -c $(FLAGS) kinds/kinds.f90 61 | 62 | formats.o: fields/formats.f90 63 | $(COMPILER) -c $(FLAGS) fields/formats.f90 64 | 65 | interpolation.o: kinds.o interpolation/interpolation.f90 66 | $(COMPILER) -D$(POIS_OPT) -c -cpp $(FLAGS) interpolation/interpolation.f90 $(OMP_FLAG) 67 | 68 | initMpiGvar.o: initMpiGvar/initMpiGvar.f90 69 | $(COMPILER) -c $(FLAGS) initMpiGvar/initMpiGvar.f90 $(OMP_FLAG) 70 | 71 | ompRoutines.o: ompRoutines/ompRoutines.f90 72 | $(COMPILER) -c $(FLAGS) ompRoutines/ompRoutines.f90 $(OMP_FLAG) 73 | 74 | errorHandler.o: initMpiGvar.o errorHandler/errorHandler.f90 75 | $(COMPILER) -c $(FLAGS) errorHandler/errorHandler.f90 76 | 77 | allocateArrays.o: kinds.o errorHandler.o allocateArrays/allocateArrays.f90 78 | $(COMPILER) -D$(POIS_OPT) -c -cpp $(FLAGS) allocateArrays/allocateArrays.f90 79 | 80 | parFile.o: kinds.o errorHandler.o formats.o fields/parFile.f90 81 | $(COMPILER) -c $(FLAGS) fields/parFile.f90 82 | 83 | field.o: interpolation.o ompRoutines.o grid.o fields/field/field.f90 \ 84 | fields/field/boundaryField_H.f90 fields/field/boundaryField_S.f90 85 | $(COMPILER) -D$(POIS_OPT) -D$(MEM_OPT) -c -cpp $(FLAGS) fields/field/field.f90 $(OMP_FLAG) 86 | 87 | grid.o: mpiControl.o grid/grid.f90 88 | $(COMPILER) -D$(POIS_OPT) -c -cpp $(FLAGS) grid/grid.f90 $(OMP_FLAG) 89 | 90 | rbgs.o: field.o rbgs/rbgs.f90 91 | $(COMPILER) -c $(FLAGS) rbgs/rbgs.f90 $(OMP_FLAG) 92 | 93 | multiGrid.o: rbgs.o poissMat.o multiGrid/multiGrid.f90 94 | $(COMPILER) -c $(FLAGS) multiGrid/multiGrid.f90 $(OMP_FLAG) 95 | 96 | pencilDec.o: grid.o pencilDec/pencilDec.f90 97 | $(COMPILER) -c $(FLAGS) pencilDec/pencilDec.f90 98 | 99 | fastPoissonSolver.o: field.o initialConditions.o pencilDec.o fastPoissonSolver/fastPoissonSolver.f90 100 | $(COMPILER) -c $(FLAGS) $(OMP_FLAG) fastPoissonSolver/fastPoissonSolver.f90 101 | 102 | poissMat.o: field.o poissMat/poissMat.f90 103 | $(COMPILER) -c $(FLAGS) -I$(MUMPS_INCL) poissMat/poissMat.f90 $(OMP_FLAG) 104 | 105 | mpiControl.o: allocateArrays.o parFile.o mpiControl/mpiControl.f90 106 | $(COMPILER) -D$(POIS_OPT) -c -cpp $(FLAGS) mpiControl/mpiControl.f90 107 | 108 | vfield.o: field.o fields/vfield/vfield.f90 109 | $(COMPILER) -c $(FLAGS) fields/vfield/vfield.f90 110 | 111 | momentumEqn.o: time.o momentumEqn/momentumEqn.f90 112 | $(COMPILER) -D$(POIS_OPT) -c -cpp $(FLAGS) momentumEqn/momentumEqn.f90 $(OMP_FLAG) 113 | 114 | time.o: solverTypes.o auxiliaryRoutines.o initialConditions.o time/time.f90 115 | $(COMPILER) -c $(FLAGS) time/time.f90 116 | 117 | ifeq ($(POIS_OPT),MG_MODE) 118 | poissonEqn.o: pcg.o time.o poissonEqn/poissonEqn.f90 119 | $(COMPILER) -D$(POIS_OPT) -c -cpp $(FLAGS) poissonEqn/poissonEqn.f90 $(OMP_FLAG) 120 | else ifeq ($(POIS_OPT),FAST_MODE) 121 | poissonEqn.o: fastPoissonSolver.o time.o poissonEqn/poissonEqn.f90 122 | $(COMPILER) -D$(POIS_OPT) -c -cpp $(FLAGS) \ 123 | poissonEqn/poissonEqn.f90 $(OMP_FLAG) 124 | endif 125 | 126 | auxiliaryRoutines.o: vfield.o auxiliaryRoutines/auxiliaryRoutines.f90 127 | $(COMPILER) -c $(FLAGS) auxiliaryRoutines/auxiliaryRoutines.f90 $(OMP_FLAG) 128 | 129 | initialConditions.o: vfield.o initialConditions/initialConditions.f90 130 | $(COMPILER) -c $(FLAGS) initialConditions/initialConditions.f90 $(OMP_FLAG) 131 | 132 | vofBlocks.o: initialConditions.o VOF/vofBlocks.f90 133 | $(COMPILER) -c $(FLAGS) $(STACK_OPT) VOF/vofBlocks.f90 $(OMP_FLAG) 134 | 135 | VOF.o: vofBlocks.o time.o VOF/VOF.f90 136 | $(COMPILER) -c $(FLAGS) VOF/VOF.f90 $(OMP_FLAG) 137 | 138 | statistics.o: time.o statistics/statistics.f90 139 | $(COMPILER) -c $(FLAGS) statistics/statistics.f90 $(OMP_FLAG) 140 | 141 | pcg.o: multiGrid.o pcg/pcg.f90 142 | $(COMPILER) -c $(FLAGS) pcg/pcg.f90 $(OMP_FLAG) 143 | 144 | rampUpProp.o: parFile.o rampUpProp/rampUpProp.f90 145 | $(COMPILER) -c $(FLAGS) rampUpProp/rampUpProp.f90 146 | 147 | ifeq ($(POIS_OPT),MG_MODE) 148 | main.o: momentumEqn.o poissonEqn.o VOF.o initialConditions.o statistics.o rampUpProp.o \ 149 | createFields_H.f90 writeFields_H.f90 main.f90 150 | $(COMPILER) -D$(POIS_OPT) -D$(MEM_OPT) -c -cpp $(FLAGS) main.f90 151 | else ifeq ($(POIS_OPT),FAST_MODE) 152 | main.o: momentumEqn.o poissonEqn.o VOF.o initialConditions.o statistics.o rampUpProp.o \ 153 | createFields_H.f90 writeFields_H.f90 main.f90 154 | $(COMPILER) -D$(POIS_OPT) -D$(MEM_OPT) -c -cpp $(FLAGS) main.f90 155 | endif 156 | 157 | clean : 158 | rm -f *.o *.mod $(EXE) 159 | -------------------------------------------------------------------------------- /src/auxiliaryRoutines/auxiliaryRoutines.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module auxiliaryRoutinesMod 20 | 21 | use vfieldMod 22 | 23 | implicit none 24 | 25 | public :: computeContinuityError 26 | public :: computeCFLmax 27 | public :: compute_dt_CFL 28 | public :: compute_Umag_max 29 | public :: updateShearFlow 30 | public :: shapeError 31 | public :: setPressGrad 32 | public :: scaleVelocity 33 | public :: computeVorticity 34 | public :: setFlowRate 35 | public :: computeFlowRate 36 | public :: approx_zero 37 | 38 | contains 39 | 40 | 41 | !========================================================================================! 42 | subroutine computeContinuityError(u,dt) 43 | type(vfield), intent(in) :: u 44 | real(DP), intent(in) :: dt 45 | type(grid), pointer :: mesh 46 | type(mpiControl), pointer :: mpic 47 | real(DP) :: dx, dy, dz 48 | real(DP) :: cError, cErrorg 49 | integer :: i, j, k, nx, ny, nz 50 | integer :: ierror 51 | 52 | mesh => u%ptrMesh_ 53 | mpic => mesh%ptrMPIC_ 54 | 55 | cError = -1.d0 56 | 57 | nx = mesh%nx_ 58 | ny = mesh%ny_ 59 | nz = mesh%nz_ 60 | 61 | !$OMP PARALLEL DO DEFAULT(none) & 62 | !$OMP SHARED(u,mesh) & 63 | !$OMP SHARED(nx,ny,nz) & 64 | !$OMP PRIVATE(dx,dy,dz) & 65 | !$OMP PRIVATE(i,j,k) & 66 | !$OMP REDUCTION(max:cError) 67 | do k = 1,nz 68 | do j = 1,ny 69 | do i = 1,nx 70 | 71 | dx = (u%ux_%f_(i,j,k)-u%ux_%f_(i-1,j,k))/mesh%dxf_(i) 72 | dy = (u%uy_%f_(i,j,k)-u%uy_%f_(i,j-1,k))/mesh%dyf_(j) 73 | dz = (u%uz_%f_(i,j,k)-u%uz_%f_(i,j,k-1))/mesh%dzf_(k) 74 | 75 | cError = max(abs(dx+dy+dz),cError) 76 | 77 | end do 78 | end do 79 | end do 80 | !$OMP END PARALLEL DO 81 | 82 | cError = cError*dt 83 | 84 | call Mpi_reduce(cError, cErrorg, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, mpic%cartComm_, ierror) 85 | 86 | if (IS_MASTER) then 87 | write(*,'(A,'//s_outputFormat(2:9)//')') ' continuity error: ', cErrorg 88 | end if 89 | 90 | 91 | end subroutine 92 | !========================================================================================! 93 | 94 | !========================================================================================! 95 | function computeCFLmax(u,dt) result(cflg) 96 | type(vfield), intent(in) :: u 97 | real(DP), intent(in) :: dt 98 | type(grid), pointer :: mesh 99 | type(mpiControl), pointer :: mpic 100 | real(DP) :: cx, cy, cz 101 | real(DP) :: cfl, cflg 102 | integer :: i, j, k, nx, ny, nz 103 | integer :: ierror 104 | 105 | mesh => u%ptrMesh_ 106 | mpic => mesh%ptrMPIC_ 107 | 108 | cfl = -1.d0 109 | 110 | nx = mesh%nx_ 111 | ny = mesh%ny_ 112 | nz = mesh%nz_ 113 | 114 | !$OMP PARALLEL DO DEFAULT(none) & 115 | !$OMP SHARED(u,mesh) & 116 | !$OMP SHARED(nx,ny,nz) & 117 | !$OMP PRIVATE(cx,cy,cz) & 118 | !$OMP PRIVATE(i,j,k) & 119 | !$OMP REDUCTION(max:cfl) 120 | do k = 1,nz 121 | do j = 1,ny 122 | do i = 1,nx 123 | 124 | cx = abs(0.5d0*(u%ux_%f_(i,j,k)+u%ux_%f_(i-1,j,k)))/mesh%dxf_(i) 125 | cy = abs(0.5d0*(u%uy_%f_(i,j,k)+u%uy_%f_(i,j-1,k)))/mesh%dyf_(j) 126 | cz = abs(0.5d0*(u%uz_%f_(i,j,k)+u%uz_%f_(i,j,k-1)))/mesh%dzf_(k) 127 | 128 | cfl = max(cx+cy+cz,cfl) 129 | 130 | 131 | end do 132 | end do 133 | end do 134 | !$OMP END PARALLEL DO 135 | 136 | cfl = cfl*dt 137 | 138 | call Mpi_Allreduce(cfl, cflg, 1, MPI_DOUBLE_PRECISION, MPI_MAX, mpic%cartComm_, ierror) 139 | 140 | 141 | end function 142 | !========================================================================================! 143 | 144 | !========================================================================================! 145 | function compute_dt_CFL(u,cfl) result(dt_g) 146 | type(vfield), intent(in) :: u 147 | real(DP), intent(in) :: cfl 148 | type(grid), pointer :: mesh 149 | type(mpiControl), pointer :: mpic 150 | real(DP) :: cx,cy,cz,dt,dt_g 151 | integer :: i,j,k,nx,ny,nz 152 | integer :: ierror 153 | 154 | mesh => u%ptrMesh_ 155 | mpic => mesh%ptrMPIC_ 156 | 157 | dt = huge(0.d0) 158 | 159 | nx = mesh%nx_ 160 | ny = mesh%ny_ 161 | nz = mesh%nz_ 162 | 163 | !$OMP PARALLEL DO DEFAULT(none) & 164 | !$OMP SHARED(u,mesh,cfl) & 165 | !$OMP SHARED(nx,ny,nz) & 166 | !$OMP PRIVATE(cx,cy,cz) & 167 | !$OMP PRIVATE(i,j,k) & 168 | !$OMP REDUCTION(min:dt) 169 | do k = 1,nz 170 | do j = 1,ny 171 | do i = 1,nx 172 | 173 | cx = abs(0.5d0*(u%ux_%f_(i,j,k)+u%ux_%f_(i-1,j,k)))/mesh%dxf_(i) 174 | cy = abs(0.5d0*(u%uy_%f_(i,j,k)+u%uy_%f_(i,j-1,k)))/mesh%dyf_(j) 175 | cz = abs(0.5d0*(u%uz_%f_(i,j,k)+u%uz_%f_(i,j,k-1)))/mesh%dzf_(k) 176 | 177 | dt = min(cfl/approx_zero(cx+cy+cz),dt) 178 | 179 | end do 180 | end do 181 | end do 182 | !$OMP END PARALLEL DO 183 | 184 | call Mpi_Allreduce(dt, dt_g, 1, MPI_DOUBLE_PRECISION, MPI_MIN, mpic%cartComm_, ierror) 185 | 186 | 187 | end function 188 | !========================================================================================! 189 | 190 | !========================================================================================! 191 | subroutine compute_Umag_max(u) 192 | type(vfield), intent(in) :: u 193 | type(grid), pointer :: mesh 194 | type(mpiControl), pointer :: mpic 195 | real(DP) :: ux, uy, uz, um, umax, umax_g 196 | integer :: i, j, k, nx, ny, nz 197 | integer :: ierror 198 | 199 | mesh => u%ptrMesh_ 200 | mpic => mesh%ptrMPIC_ 201 | 202 | um = -1.d0 203 | 204 | nx = mesh%nx_ 205 | ny = mesh%ny_ 206 | nz = mesh%nz_ 207 | 208 | !$OMP PARALLEL DO DEFAULT(none) & 209 | !$OMP SHARED(u,mesh) & 210 | !$OMP SHARED(nx,ny,nz) & 211 | !$OMP PRIVATE(ux,uy,uz,um) & 212 | !$OMP PRIVATE(i,j,k) & 213 | !$OMP REDUCTION(max:umax) 214 | do k = 1,nz 215 | do j = 1,ny 216 | do i = 1,nx 217 | ux = 0.5d0*(u%ux_%f_(i,j,k)+u%ux_%f_(i-1,j,k)) 218 | uy = 0.5d0*(u%uy_%f_(i,j,k)+u%uy_%f_(i,j-1,k)) 219 | uz = 0.5d0*(u%uz_%f_(i,j,k)+u%uz_%f_(i,j,k-1)) 220 | um=sqrt(ux*ux+uy*uy+uz*uz) 221 | umax = max(umax,um) 222 | end do 223 | end do 224 | end do 225 | !$OMP END PARALLEL DO 226 | 227 | call Mpi_reduce(umax,umax_g,1,MPI_DOUBLE_PRECISION,MPI_MAX,0,mpic%cartComm_,ierror) 228 | 229 | if (IS_MASTER) then 230 | write(*,'(A,'//s_outputFormat(2:9)//')') ' Umax: ', umax_g 231 | end if 232 | 233 | 234 | end subroutine 235 | !========================================================================================! 236 | 237 | !========================================================================================! 238 | subroutine updateShearFlow(u,u0,t,dt) 239 | type(vfield), intent(inout) :: u 240 | type(vfield), intent(in) :: u0 241 | real(DP), intent(in) :: t, dt 242 | integer :: i, j, k 243 | real(DP) :: Ts, th 244 | real(DP), parameter :: pi = 4.d0*DATAN(1.d0) 245 | 246 | Ts = 3.d0 247 | th = t - 0.5d0*dt 248 | 249 | 250 | !ux 251 | do k=u%ux_%ks_,u%ux_%ke_ 252 | do j=u%ux_%js_,u%ux_%je_ 253 | do i=u%ux_%is_,u%ux_%ie_ 254 | 255 | u%ux_%f_(i,j,k) = u0%ux_%f_(i,j,k)*cos(pi*th/Ts) 256 | 257 | end do 258 | end do 259 | end do 260 | 261 | !uy 262 | do k=u%uy_%ks_,u%uy_%ke_ 263 | do j=u%uy_%js_,u%uy_%je_ 264 | do i=u%uz_%is_,u%uz_%ie_ 265 | 266 | u%uy_%f_(i,j,k) = u0%uy_%f_(i,j,k)*cos(pi*th/Ts) 267 | 268 | end do 269 | end do 270 | end do 271 | 272 | !uz 273 | do k=u%uz_%ks_,u%uz_%ke_ 274 | do j=u%uz_%js_,u%uz_%je_ 275 | do i=u%uz_%is_,u%uz_%ie_ 276 | 277 | u%uz_%f_(i,j,k) = u0%uz_%f_(i,j,k)*cos(pi*th/Ts) 278 | 279 | end do 280 | end do 281 | end do 282 | 283 | 284 | end subroutine 285 | !========================================================================================! 286 | 287 | !========================================================================================! 288 | subroutine shapeError(c,c0,t) 289 | type(field), intent(in) :: c, c0 290 | real(DP), intent(in) :: t 291 | type(grid), pointer :: mesh 292 | type(mpiControl), pointer :: mpic 293 | integer :: n, nx, ny, nz 294 | real(DP) :: lerr, gerr 295 | integer :: ierror 296 | logical :: exist 297 | 298 | lerr = 0.d0 299 | 300 | mesh => c%ptrMesh_ 301 | mpic => mesh%ptrMPIC_ 302 | 303 | nx = mesh%nx_ 304 | ny = mesh%ny_ 305 | nz = mesh%nz_ 306 | 307 | n = mesh%nxg_*mesh%nyg_*mesh%nzg_ 308 | 309 | lerr = lerr + sum(abs(c%f_(1:nx,1:ny,1:nz)-c0%f_(1:nx,1:ny,1:nz)))/n 310 | 311 | call Mpi_reduce(lerr, gerr, 1, MPI_DOUBLE_PRECISION, MPI_SUM, 0, mpic%cartComm_, ierror) 312 | 313 | !output to a text file 314 | if (IS_MASTER) then 315 | 316 | inquire(file="shError", exist=exist) 317 | 318 | if (exist) then 319 | open(UNIT=s_IOunitNumber,FILE='shError',STATUS='OLD',& 320 | POSITION="append",ACTION='WRITE') 321 | write(s_IOunitNumber,'(2'//s_doubleFormat(2:10)//')') gerr,t 322 | close(s_IOunitNumber) 323 | else 324 | open(UNIT=s_IOunitNumber,FILE='shError',STATUS='NEW',ACTION='WRITE') 325 | write(s_IOunitNumber,'(2'//s_doubleFormat(2:10)//')') gerr,t 326 | close(s_IOunitNumber) 327 | end if 328 | 329 | end if 330 | 331 | 332 | end subroutine 333 | !========================================================================================! 334 | 335 | !========================================================================================! 336 | subroutine setPressGrad(f_ctrl,Ret,rho,rhol,mul,g,f) 337 | integer, intent(in) :: f_ctrl 338 | type(field), intent(in) :: rho 339 | real(DP), intent(in) :: rhol,mul,g,Ret 340 | real(DP), intent(inout) :: f 341 | type(grid), pointer :: mesh 342 | type(mpiControl), pointer :: mpic 343 | real(DP) :: x,rho_sum,rho_sum_g,rhoAv,nul,Re,tauw 344 | integer :: nx,ny,nz,i,j,k,ierror 345 | 346 | 347 | mesh => rho%ptrMesh_ 348 | mpic => mesh%ptrMPIC_ 349 | 350 | nx = mesh%nx_ 351 | ny = mesh%ny_ 352 | nz = mesh%nz_ 353 | 354 | rho_sum=0.d0 355 | !$OMP PARALLEL DO DEFAULT(none) & 356 | !$OMP SHARED(rho,mesh) & 357 | !$OMP SHARED(nx,ny,nz) & 358 | !$OMP PRIVATE(i,j,k,x) & 359 | !$OMP REDUCTION(+:rho_sum) 360 | do k=1,nz 361 | do j=1,ny 362 | do i=0,nx-1 363 | x = 0.5d0*(rho%f_(i+1,j,k)+rho%f_(i,j,k)) 364 | rho_sum = rho_sum + x*mesh%Vsx_(i,j,k) 365 | end do 366 | end do 367 | end do 368 | !$OMP END PARALLEL DO 369 | 370 | call Mpi_Allreduce(rho_sum, rho_sum_g, 1, MPI_DOUBLE_PRECISION, MPI_SUM, & 371 | mpic%cartComm_, ierror) 372 | 373 | rhoAv = rho_sum_g/s_Vg 374 | 375 | if (f_ctrl==1) then 376 | 377 | nul = mul/rhol 378 | Re = 1.d0/nul 379 | tauw = (Ret/Re)*(Ret/Re) 380 | 381 | f = tauw - rhoAv*g 382 | 383 | elseif ((f_ctrl==2).OR.(f_ctrl==3)) then 384 | 385 | f = -rhoAv*g 386 | 387 | else 388 | 389 | f = 0.d0 390 | 391 | end if 392 | 393 | end subroutine 394 | !========================================================================================! 395 | 396 | !========================================================================================! 397 | subroutine scaleVelocity(u) 398 | type(vfield), intent(inout) :: u 399 | real(DP) :: Ubar 400 | 401 | Ubar = 1.85d1 402 | 403 | u%ux_%f_ = u%ux_%f_/Ubar 404 | u%uy_%f_ = u%uy_%f_/Ubar 405 | u%uz_%f_ = u%uz_%f_/Ubar 406 | 407 | 408 | end subroutine 409 | !========================================================================================! 410 | 411 | !========================================================================================! 412 | subroutine computeVorticity(u,w) 413 | type(vfield), intent(in) :: u 414 | type(vfield), intent(inout) :: w 415 | type(grid), pointer :: mesh 416 | real(DP) :: duzdy,duydz,duzdx,duxdz,duydx,duxdy 417 | integer :: i,j,k,nx,ny,nz 418 | 419 | mesh => u%ptrMesh_ 420 | nx = mesh%nx_ 421 | ny = mesh%ny_ 422 | nz = mesh%nz_ 423 | 424 | !$OMP PARALLEL DO DEFAULT(none) & 425 | !$OMP SHARED(u,w,mesh) & 426 | !$OMP SHARED(nx,ny,nz) & 427 | !$OMP PRIVATE(i,j,k) & 428 | !$OMP PRIVATE(duzdy,duydz,duzdx,duxdz,duydx,duxdy) 429 | do k=1,nz 430 | do j=1,ny 431 | do i=1,nx 432 | 433 | duzdy=(0.5d0*(u%uz_%f_(i,j+1,k)+u%uz_%f_(i,j+1,k-1))- & 434 | 0.5d0*(u%uz_%f_(i,j-1,k)+u%uz_%f_(i,j-1,k-1)))/ & 435 | (mesh%dyc_(j+1)+mesh%dyc_(j)) 436 | duydz=(0.5d0*(u%uy_%f_(i,j,k+1)+u%uy_%f_(i,j-1,k+1))- & 437 | 0.5d0*(u%uy_%f_(i,j,k-1)+u%uy_%f_(i,j-1,k-1)))/ & 438 | (mesh%dzc_(k+1)+mesh%dzc_(k)) 439 | duzdx=(0.5d0*(u%uz_%f_(i+1,j,k)+u%uz_%f_(i+1,j,k-1))- & 440 | 0.5d0*(u%uz_%f_(i-1,j,k)+u%uz_%f_(i-1,j,k-1)))/ & 441 | (mesh%dxc_(i+1)+mesh%dxc_(i)) 442 | duxdz=(0.5d0*(u%ux_%f_(i,j,k+1)+u%ux_%f_(i-1,j,k+1))- & 443 | 0.5d0*(u%ux_%f_(i,j,k-1)+u%ux_%f_(i-1,j,k-1)))/ & 444 | (mesh%dzc_(k+1)+mesh%dzc_(k)) 445 | duydx=(0.5d0*(u%uy_%f_(i+1,j,k)+u%uy_%f_(i+1,j-1,k))- & 446 | 0.5d0*(u%uy_%f_(i-1,j,k)+u%uy_%f_(i-1,j-1,k)))/ & 447 | (mesh%dxc_(i+1)+mesh%dxc_(i)) 448 | duxdy=(0.5d0*(u%ux_%f_(i,j+1,k)+u%ux_%f_(i-1,j+1,k))- & 449 | 0.5d0*(u%ux_%f_(i,j-1,k)+u%ux_%f_(i-1,j-1,k)))/ & 450 | (mesh%dyc_(j+1)+mesh%dyc_(j)) 451 | 452 | w%ux_%f_(i,j,k)=duzdy-duydz 453 | w%uy_%f_(i,j,k)=duxdz-duzdx 454 | w%uz_%f_(i,j,k)=duydx-duxdy 455 | 456 | 457 | end do 458 | end do 459 | end do 460 | !$OMP END PARALLEL DO 461 | 462 | 463 | end subroutine 464 | !========================================================================================! 465 | 466 | !========================================================================================! 467 | subroutine setFlowRate(ctrl,u,rho,Q,dt,alpha) 468 | integer, intent(in) :: ctrl 469 | type(vfield), intent(inout) :: u 470 | type(field), intent(in) :: rho 471 | real(DP), intent(in) :: Q,dt,alpha 472 | type(grid), pointer :: mesh 473 | type(mpiControl), pointer :: mpic 474 | real(DP) :: x,irho,uf,Qs,irho_g,r 475 | integer :: nx,ny,nz,i,j,k,ierror 476 | 477 | if ((ctrl<2).OR.(ctrl>2)) then 478 | return 479 | end if 480 | 481 | mesh => u%ptrMesh_ 482 | mpic => mesh%ptrMPIC_ 483 | 484 | nx=mesh%nx_ 485 | ny=mesh%ny_ 486 | nz=mesh%nz_ 487 | 488 | call computeFlowRate(u,Qs) 489 | 490 | uf = (Q-Qs)/s_Vg 491 | 492 | !$OMP PARALLEL DO DEFAULT(none) & 493 | !$OMP PRIVATE(i,j,k) & 494 | !$OMP SHARED(u,uf,nx,ny,nz) 495 | do k=1,nz 496 | do j=1,ny 497 | do i=0,nx 498 | 499 | u%ux_%f_(i,j,k) = u%ux_%f_(i,j,k) + uf 500 | 501 | end do 502 | end do 503 | end do 504 | !$OMP END PARALLEL DO 505 | call updateBoundariesV(u) 506 | 507 | if (IS_MASTER) then 508 | !write(*,'(A,'//s_outputFormat(2:9)//')') ' Press grad set to: ', uf/(alpha*dt) 509 | end if 510 | 511 | end subroutine 512 | !========================================================================================! 513 | 514 | !========================================================================================! 515 | subroutine computeFlowRate(u,Q_g) 516 | type(vfield), intent(in) :: u 517 | real(DP), intent(out) :: Q_g 518 | type(grid), pointer :: mesh 519 | type(mpiControl), pointer :: mpic 520 | integer :: i,j,k,nx,ny,nz,ierror 521 | real(DP) :: Q 522 | 523 | mesh => u%ptrMesh_ 524 | mpic => mesh%ptrMPIC_ 525 | 526 | nx = mesh%nx_ 527 | ny = mesh%ny_ 528 | nz = mesh%nz_ 529 | 530 | Q = 0.d0 531 | !$OMP PARALLEL DO DEFAULT(none) & 532 | !$OMP PRIVATE(i,j,k) & 533 | !$OMP SHARED(u,mesh,nx,ny,nz) & 534 | !$OMP REDUCTION(+:Q) 535 | do k=1,nz 536 | do j=1,ny 537 | do i=0,nx-1 538 | 539 | Q = Q + u%ux_%f_(i,j,k)*mesh%Vsx_(i,j,k) 540 | 541 | end do 542 | end do 543 | end do 544 | !$OMP END PARALLEL DO 545 | 546 | call Mpi_Allreduce(Q, Q_g, 1, MPI_DOUBLE_PRECISION, MPI_SUM, & 547 | mpic%cartComm_, ierror) 548 | 549 | end subroutine 550 | !========================================================================================! 551 | 552 | !========================================================================================! 553 | elemental function approx_zero(d) result(r) 554 | real(DP), intent(in) :: d 555 | real(DP) :: r,small 556 | 557 | small = 1.d-50 558 | 559 | if (d==0.d0) then 560 | r=small 561 | else 562 | r=d 563 | end if 564 | 565 | end function 566 | !========================================================================================! 567 | 568 | 569 | end module auxiliaryRoutinesMod 570 | 571 | 572 | 573 | 574 | 575 | 576 | -------------------------------------------------------------------------------- /src/createFields_H.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | !init mesh and global fields 20 | if (IS_MASTER) then 21 | write(*,'(A)') 'BUILD MESH AND FIELDS' 22 | end if 23 | 24 | !build mesh 25 | if (IS_MASTER) then 26 | call gridCTOR(gMesh,mpiCTRL) 27 | end if 28 | call decomposeGrid(gMesh,mesh,mpiCTRL) 29 | call broadCastGlobalGrid(gMesh,mesh) 30 | 31 | !*********************** primary fields 32 | !init volume fraction 33 | call read_file_field(gc,c,gMesh,mesh,'c',runTime%inputFold_,halo_size=1) 34 | 35 | !init velocity 36 | call read_file_vfield(gu,u,gMesh,mesh,'u',runTime%inputFold_,halo_size=2) 37 | call initChFlowVelocity(u,mesh,gmesh) 38 | 39 | !init phi 40 | call read_file_field(gpsi,psi,gMesh,mesh,'psi',runTime%inputFold_,halo_size=1) 41 | 42 | !*********************** derived fields 43 | !init smooth volume fraction 44 | if (IS_MASTER) then 45 | call fieldCTOR(gcs,'cs',gMesh,'cl',halo_size=1,initOpt=0) 46 | end if 47 | call fieldCTOR(cs,'cs',mesh,'cl',halo_size=1,initOpt=-1) 48 | call decomposeField(gcs,cs) 49 | 50 | !init curvature 51 | if (IS_MASTER) then 52 | call fieldCTOR(gcurv,'k',gMesh,'cl',halo_size=1,initOpt=0) 53 | end if 54 | call fieldCTOR(curv,'k',mesh,'cl',halo_size=1,initOpt=-1) 55 | call decomposeField(gcurv,curv) 56 | 57 | !init vorticity 58 | if (IS_MASTER) then 59 | call vfieldCTOR(gw,'w',gMesh,'cl','cl','cl',halo_size=1,initOpt=0) 60 | end if 61 | call vfieldCTOR(w,'w',mesh,'cl','cl','cl',halo_size=1,initOpt=-1) 62 | call decomposeFieldV(gw,w) 63 | 64 | !init material properties fields 65 | call fieldCTOR(rho,'rho',mesh,'cl',halo_size=1,initOpt=-1) 66 | call fieldCTOR(mu,'mu',mesh,'cl',halo_size=1,initOpt=-1) 67 | call copyBoundary(rho,cs) 68 | call copyBoundary(mu,cs) 69 | 70 | if (IS_MASTER) then 71 | write(*,'(A)') 'END BUILD MESH AND FIELDS' 72 | end if 73 | -------------------------------------------------------------------------------- /src/errorHandler/errorHandler.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module errorHandlerMod 20 | 21 | use initMpiGvarMod 22 | 23 | implicit none 24 | 25 | public :: mpiABORT 26 | 27 | contains 28 | 29 | !========================================================================================! 30 | subroutine mpiABORT(msg,opt) 31 | character(len=*), intent(in) :: msg 32 | integer, optional :: opt 33 | integer :: errorCode, ierror 34 | 35 | if (present(opt)) then 36 | errorCode = opt 37 | else 38 | errorCode = -1 39 | end if 40 | 41 | !if (IS_MASTER) then 42 | write(*,*) '/***************************************************************/' 43 | write(*,*) 'mpiABORT CALLED with ERROR CODE: ', errorCode 44 | write(*,*) 'ERROR MESSAGE: ', msg 45 | write(*,*) '/***************************************************************/' 46 | !end if 47 | 48 | call MPI_ABORT(MPI_COMM_WORLD,errorcode,ierror) 49 | 50 | end subroutine 51 | !========================================================================================! 52 | 53 | 54 | end module errorHandlerMod 55 | 56 | 57 | 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /src/fastPoissonSolver/fastPoissonSolver.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module fastPoissonSolverMod 20 | ! ************************************************************************************** ! 21 | ! Part of this module is based on the Poisson solver developed in the code AFiD 22 | ! detailed in: 23 | ! van der Poel, Erwin P., et al. "A pencil distributed finite difference code for 24 | ! strongly turbulent wall-bounded flows." Computers & Fluids 116 (2015): 10-16. 25 | ! ************************************************************************************** ! 26 | 27 | use initialConditionsMod, only: pi 28 | use fieldMod 29 | use pencilDecMod 30 | use, intrinsic :: iso_c_binding 31 | 32 | implicit none 33 | 34 | type,public :: fastPoissonSolver 35 | real(DP), allocatable, private, dimension(:) :: lx,lz 36 | complex(DP), allocatable, private, dimension(:) :: am,ap,ac 37 | end type 38 | 39 | real(C_DOUBLE), allocatable, dimension(:,:,:) :: ux_ph,uy_ph 40 | complex(C_DOUBLE_COMPLEX), allocatable, dimension(:,:,:) :: ux_sp,uy_sp,uz_sp 41 | 42 | type, bind(C) :: fftw_iodim 43 | integer(C_INT) n, is, os 44 | end type fftw_iodim 45 | 46 | type(fftw_iodim),dimension(1) :: iodim 47 | type(fftw_iodim),dimension(2) :: howmany 48 | 49 | type(C_PTR) :: guruplan_x_fwd,guruplan_x_bwd 50 | type(C_PTR) :: guruplan_z_fwd,guruplan_z_bwd 51 | 52 | integer, parameter :: FFTW_ESTIMATE=64 53 | integer, parameter :: FFTW_FORWARD=-1 54 | integer, parameter :: FFTW_BACKWARD=1 55 | 56 | interface 57 | type(C_PTR) function fftw_plan_guru_dft_r2c(rank,dims, & 58 | howmany_rank,howmany_dims,in,out,flags) & 59 | bind(C, name='fftw_plan_guru_dft_r2c') 60 | import 61 | integer(C_INT), value :: rank 62 | type(fftw_iodim), dimension(*), intent(in) :: dims 63 | integer(C_INT), value :: howmany_rank 64 | type(fftw_iodim), dimension(*), intent(in) :: howmany_dims 65 | real(C_DOUBLE), dimension(*), intent(out) :: in 66 | complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out 67 | integer(C_INT), value :: flags 68 | end function fftw_plan_guru_dft_r2c 69 | 70 | type(C_PTR) function fftw_plan_guru_dft(rank,dims, & 71 | howmany_rank,howmany_dims,in,out,sign,flags) & 72 | bind(C, name='fftw_plan_guru_dft') 73 | import 74 | integer(C_INT), value :: rank 75 | type(fftw_iodim), dimension(*), intent(in) :: dims 76 | integer(C_INT), value :: howmany_rank 77 | type(fftw_iodim), dimension(*), intent(in) :: howmany_dims 78 | complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in 79 | complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out 80 | integer(C_INT), value :: sign 81 | integer(C_INT), value :: flags 82 | end function fftw_plan_guru_dft 83 | 84 | type(C_PTR) function fftw_plan_guru_dft_c2r(rank,dims, & 85 | howmany_rank,howmany_dims,in,out,flags) & 86 | bind(C, name='fftw_plan_guru_dft_c2r') 87 | import 88 | integer(C_INT), value :: rank 89 | type(fftw_iodim), dimension(*), intent(in) :: dims 90 | integer(C_INT), value :: howmany_rank 91 | type(fftw_iodim), dimension(*), intent(in) :: howmany_dims 92 | complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in 93 | real(C_DOUBLE), dimension(*), intent(out) :: out 94 | integer(C_INT), value :: flags 95 | end function fftw_plan_guru_dft_c2r 96 | 97 | integer(C_INT) function fftw_init_threads() & 98 | bind(C, name='fftw_init_threads') 99 | import 100 | end function fftw_init_threads 101 | 102 | subroutine fftw_plan_with_nthreads(nthreads) & 103 | bind(C, name='fftw_plan_with_nthreads') 104 | import 105 | integer(C_INT), value :: nthreads 106 | end subroutine fftw_plan_with_nthreads 107 | end interface 108 | 109 | private :: buildFFTGuruPlans 110 | private :: computeEigenvalues 111 | private :: initOffDiagMatrix 112 | private :: solveTriDiag 113 | private :: zeroAveragePressure 114 | 115 | public :: fastPoissonSolverCTOR 116 | public :: solveFPS 117 | 118 | 119 | contains 120 | 121 | 122 | !========================================================================================! 123 | subroutine fastPoissonSolverCTOR(this,mesh,gMesh) 124 | type(fastPoissonSolver), intent(out) :: this 125 | type(grid), intent(in) :: mesh,gMesh 126 | type(mpiControl), pointer :: ptrMPIC 127 | integer :: nxg,nyg,nzg,init 128 | 129 | ptrMPIC => mesh%ptrMPIC_ 130 | 131 | nxg=mesh%nxg_ 132 | nyg=mesh%nyg_ 133 | nzg=mesh%nzg_ 134 | 135 | call initPencils(mesh) 136 | 137 | call allocateArray(ux_ph,x_pen%idx(1),x_pen%idx(2),x_pen%idx(3),x_pen%idx(4),& 138 | x_pen%idx(5),x_pen%idx(6)) 139 | call allocateArray(uy_ph,s_pen%idx(1),s_pen%idx(2),s_pen%idx(3),s_pen%idx(4),& 140 | s_pen%idx(5),s_pen%idx(6)) 141 | call allocateArray(ux_sp,x_pen%idx(1),x_pen%idx(2),x_pen%idx(3),x_pen%idx(4),& 142 | x_pen%idx(5),x_pen%idx(6)) 143 | call allocateArray(uz_sp,z_pen%idx(1),z_pen%idx(2),z_pen%idx(3),z_pen%idx(4),& 144 | z_pen%idx(5),z_pen%idx(6)) 145 | call allocateArray(uy_sp,y_pen%idx(1),y_pen%idx(2),y_pen%idx(3),y_pen%idx(4),& 146 | y_pen%idx(5),y_pen%idx(6)) 147 | 148 | !fftw initi 149 | init = fftw_init_threads() 150 | call buildFFTGuruPlans(nxg,nzg) 151 | 152 | call computeEigenvalues(this,mesh) 153 | call allocateArray(this%ac,1,nyg) 154 | call initOffDiagMatrix(this,gMesh) 155 | 156 | end subroutine 157 | !========================================================================================! 158 | 159 | !========================================================================================! 160 | subroutine buildFFTGuruPlans(nxg,nzg) 161 | integer, intent(in) :: nxg,nzg 162 | 163 | !multi-threaded fftw 164 | call fftw_plan_with_nthreads(N_THREADS) 165 | 166 | !plan c2c 167 | iodim(1)%n=nzg 168 | iodim(1)%is=z_pen%n(1)*z_pen%n(2) 169 | iodim(1)%os=z_pen%n(1)*z_pen%n(2) 170 | howmany(1)%n=z_pen%n(1) 171 | howmany(1)%is=1 172 | howmany(1)%os=1 173 | howmany(2)%n=z_pen%n(2) 174 | howmany(2)%is=z_pen%n(1) 175 | howmany(2)%os=z_pen%n(1) 176 | guruplan_z_fwd=fftw_plan_guru_dft(1,iodim,2,howmany,uz_sp,uz_sp,& 177 | FFTW_FORWARD,FFTW_ESTIMATE) 178 | guruplan_z_bwd=fftw_plan_guru_dft(1,iodim,2,howmany,uz_sp,uz_sp,& 179 | FFTW_BACKWARD,FFTW_ESTIMATE) 180 | 181 | if (.not.c_associated(guruplan_z_fwd)) then 182 | call mpiABORT('guruplan_z_fwd failed ') 183 | end if 184 | if (.not.c_associated(guruplan_z_bwd)) then 185 | call mpiABORT('guruplan_z_bwd failed ') 186 | end if 187 | 188 | !plan r2c 189 | iodim(1)%n=nxg 190 | iodim(1)%is=1 191 | iodim(1)%os=1 192 | howmany(1)%n=x_pen%n(2) 193 | howmany(1)%is=x_pen%n(1) 194 | howmany(1)%os=x_pen%n(1) 195 | howmany(2)%n=x_pen%n(3) 196 | howmany(2)%is=x_pen%n(1)*x_pen%n(2) 197 | howmany(2)%os=x_pen%n(1)*x_pen%n(2) 198 | guruplan_x_fwd=fftw_plan_guru_dft_r2c(1,iodim,2,howmany,ux_ph,ux_sp,FFTW_ESTIMATE) 199 | 200 | !plan c2r 201 | guruplan_x_bwd=fftw_plan_guru_dft_c2r(1,iodim,2,howmany,ux_sp,ux_ph,FFTW_ESTIMATE) 202 | 203 | if (.not.c_associated(guruplan_x_bwd)) then 204 | call mpiABORT('guruplan_x_bwd failed ') 205 | end if 206 | if (.not.c_associated(guruplan_x_fwd)) then 207 | call mpiABORT('guruplan_x_fwd failed ') 208 | end if 209 | 210 | 211 | end subroutine 212 | !========================================================================================! 213 | 214 | !========================================================================================! 215 | subroutine computeEigenvalues(this,mesh) 216 | type(fastPoissonSolver), intent(inout) :: this 217 | type(grid), intent(in) :: mesh 218 | real(DP), allocatable, dimension(:) :: vx,vz 219 | integer :: nxg,nzg,i 220 | real(DP) :: dx,dz 221 | 222 | dx = mesh%xc_(2)-mesh%xc_(1) 223 | dz = mesh%zc_(2)-mesh%zc_(1) 224 | 225 | nxg=mesh%nxg_ 226 | nzg=mesh%nzg_ 227 | 228 | call allocateArray(this%lx,1,nxg) 229 | call allocateArray(this%lz,1,nzg) 230 | 231 | call allocateArray(vx,1,nxg) 232 | call allocateArray(vz,1,nzg) 233 | 234 | !x 235 | do i=1,nxg 236 | vx(i)=(i-1)*2.d0*pi 237 | enddo 238 | do i=1,nxg 239 | this%lx(i)=2.d0*(cos(vx(i)/nxg)-1.d0)/((dx*dx)) 240 | enddo 241 | 242 | !z 243 | do i=1,nzg 244 | vz(i)=(i-1)*2.d0*pi 245 | enddo 246 | do i=1,nzg 247 | this%lz(i)=2.d0*(cos(vz(i)/nzg)-1.d0)/((dz*dz)) 248 | enddo 249 | 250 | 251 | end subroutine 252 | !========================================================================================! 253 | 254 | !========================================================================================! 255 | subroutine initOffDiagMatrix(this,mesh) 256 | type(fastPoissonSolver), intent(inout) :: this 257 | type(grid), intent(in) :: mesh 258 | integer :: j,nyg 259 | 260 | nyg=mesh%nyg_ 261 | 262 | call allocateArray(this%am,1,nyg) 263 | call allocateArray(this%ap,1,nyg) 264 | 265 | do j=1,nyg 266 | this%am(j)=1.d0/(mesh%dyc_(j)*mesh%dyf_(j)) 267 | end do 268 | this%am(1)=0.d0 269 | 270 | do j=1,nyg 271 | this%ap(j)=1.d0/(mesh%dyc_(j+1)*mesh%dyf_(j)) 272 | end do 273 | this%ap(nyg)=0.d0 274 | 275 | 276 | end subroutine 277 | !========================================================================================! 278 | 279 | !========================================================================================! 280 | subroutine solveTriDiag(this,f) 281 | type(fastPoissonSolver), intent(inout) :: this 282 | complex(DP), allocatable, dimension(:,:,:), intent(inout) :: f 283 | integer :: i,j,k,n,nyg,info 284 | complex(DP), allocatable, dimension(:) :: du2,fy,am_scal,ap_scal,ac_scal 285 | integer, allocatable, dimension(:) :: ipiv 286 | complex(DP) :: r 287 | character(9) :: err_msg 288 | 289 | n=y_pen%n(2) 290 | call allocateArray(du2,1,n-2) 291 | call allocateArray(ipiv,1,n) 292 | call allocateArray(fy,1,n) 293 | call allocateArray(am_scal,1,n) 294 | call allocateArray(ap_scal,1,n) 295 | call allocateArray(ac_scal,1,n) 296 | 297 | !$OMP PARALLEL DO COLLAPSE(2) & 298 | !$OMP DEFAULT(none) & 299 | !$OMP SHARED(this,y_pen,f,n) & 300 | !$OMP PRIVATE(ac_scal,am_scal,ap_scal) & 301 | !$OMP PRIVATE(i,j,k) & 302 | !$OMP PRIVATE(r,fy,du2,ipiv,info,err_msg) 303 | do k=y_pen%idx(5),y_pen%idx(6) 304 | do i=y_pen%idx(1),y_pen%idx(2) 305 | 306 | fy=f(i,:,k) 307 | 308 | do j=y_pen%idx(3),y_pen%idx(4) 309 | r=1.d0/(this%lx(i)+this%lz(k)-this%am(j)-this%ap(j)) 310 | am_scal(j)=this%am(j)*r 311 | ap_scal(j)=this%ap(j)*r 312 | ac_scal(j)=1.d0 313 | fy(j)=fy(j)*r 314 | end do 315 | 316 | call zgttrf(n,am_scal(2),ac_scal,ap_scal(1),du2,ipiv,info) 317 | 318 | if (info.ne.0) then 319 | ac_scal(n)=epsilon(0.d0) 320 | !write(err_msg,'(I9)') info 321 | !call mpiAbort('zgttrf solver returned: '//err_msg) 322 | end if 323 | 324 | call zgttrs('N',n,1,am_scal(2),ac_scal,ap_scal(1),du2,ipiv, & 325 | fy,n,info) 326 | 327 | f(i,:,k)=fy 328 | 329 | end do 330 | end do 331 | !$OMP END PARALLEL DO 332 | 333 | end subroutine 334 | !========================================================================================! 335 | 336 | !========================================================================================! 337 | subroutine solveFPS(this,p,s) 338 | type(fastPoissonSolver), intent(inout) :: this 339 | type(field), intent(inout) :: p 340 | type(field), intent(in) :: s 341 | integer :: nx,nz,nxg,nyg,nzg 342 | 343 | nx=p%nx_ 344 | nz=p%nz_ 345 | nxg=p%ptrMesh_%nxg_ 346 | nyg=p%ptrMesh_%nyg_ 347 | nzg=p%ptrMesh_%nzg_ 348 | 349 | uy_ph=s%f_(1:nx,1:nyg,1:nz) 350 | call sPen_2_xPen(uy_ph,ux_ph) 351 | 352 | !fft x-pencil (periodic) 353 | call dfftw_execute_dft_r2c(guruplan_x_fwd,ux_ph,ux_sp) 354 | 355 | !fft z-pensil (periodic) 356 | call xPen_2_zPen(ux_sp,uz_sp) 357 | call dfftw_execute_dft(guruplan_z_fwd,uz_sp,uz_sp) 358 | 359 | !transpose wall-normal direction 360 | call zPen_2_yPen(uz_sp,uy_sp) 361 | 362 | !solve tridiagonal system 363 | call solveTriDiag(this,uy_sp) 364 | 365 | !inv-fft z-pencil 366 | call yPen_2_zPen(uy_sp,uz_sp) 367 | call dfftw_execute_dft(guruplan_z_bwd,uz_sp,uz_sp) 368 | 369 | !inv-fft x-pencil 370 | call zPen_2_xPen(uz_sp,ux_sp) 371 | call dfftw_execute_dft_c2r(guruplan_x_bwd,ux_sp,ux_ph) 372 | 373 | !scaling factor 374 | ux_ph=ux_ph/(nxg*nzg) 375 | 376 | call xPen_2_sPen(ux_ph,uy_ph) 377 | 378 | p%f_(1:nx,1:nyg,1:nz)=uy_ph 379 | 380 | call zeroAveragePressure(p) 381 | call updateBoundaries(p) 382 | 383 | 384 | end subroutine 385 | !========================================================================================! 386 | 387 | !========================================================================================! 388 | subroutine zeroAveragePressure(p) 389 | type(field), intent(inout) :: p 390 | type(grid), pointer :: mesh 391 | integer :: nx,ny,nz 392 | integer :: i,j,k,ierror 393 | real(DP) :: av,avg 394 | 395 | mesh => p%ptrMesh_ 396 | 397 | nx=mesh%nx_ 398 | ny=mesh%ny_ 399 | nz=mesh%nz_ 400 | 401 | av=0.d0 402 | 403 | !$OMP PARALLEL DO DEFAULT(none) & 404 | !$OMP SHARED(p,mesh) & 405 | !$OMP SHARED(nx,ny,nz) & 406 | !$OMP PRIVATE(i,j,k) & 407 | !$OMP REDUCTION(+:av) 408 | do k = 1,nz 409 | do j = 1,ny 410 | do i = 1,nx 411 | av = av + p%f_(i,j,k)*mesh%V_(i,j,k) 412 | end do 413 | end do 414 | end do 415 | !$OMP END PARALLEL DO 416 | 417 | call Mpi_Allreduce(av, avg, 1, MPI_DOUBLE_PRECISION, MPI_SUM, & 418 | mesh%ptrMPIC_%cartComm_, ierror) 419 | 420 | avg=avg/s_Vg 421 | p%f_=p%f_-avg 422 | 423 | end subroutine 424 | !========================================================================================! 425 | 426 | 427 | end module fastPoissonSolverMod 428 | 429 | -------------------------------------------------------------------------------- /src/fields/field/boundaryField_H.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | ! boundaryField 20 | type, public :: boundaryField 21 | 22 | integer :: bType_ 23 | integer :: n1_, n2_ 24 | integer :: bNumber_ 25 | logical :: isExternal_ 26 | integer :: cartDir_ !x: +-1; y: +-2; z: +-3 27 | integer :: dir1_, dir2_ !cart directions along n1 and n2 28 | 29 | real(DP) :: bf_ 30 | 31 | real(DP) :: dhi_ 32 | real(DP) :: dhb_ 33 | 34 | end type 35 | 36 | private :: initDeafaultBoundaryField 37 | private :: readBoundaryField 38 | private :: setMetrics 39 | private :: initBoundary 40 | private :: initField 41 | private :: initBoundaryValues 42 | private :: initPeriodicBoundary 43 | private :: decomposeBoundaryPatch 44 | private :: sendFieldFromMaster 45 | private :: receiveFieldFromMaster 46 | private :: sendParallelPatchFromMaster 47 | private :: receiveParallelPatchFromMaster 48 | private :: updateBoundaryField 49 | private :: updateFixedValueBoundary 50 | private :: updateNormalGradientBoundary 51 | private :: updateCalculatedBoundary 52 | private :: updateContanctAngleBoundary 53 | private :: coarsenBoundary 54 | private :: writeBoundaryField 55 | 56 | public :: boundaryFieldCTOR 57 | 58 | -------------------------------------------------------------------------------- /src/fields/formats.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module formatsMod 20 | 21 | implicit none 22 | 23 | integer, protected :: s_nFilesToWrite = 0 24 | 25 | integer, parameter :: s_IOunitNumber = 50 26 | character(len=4), parameter :: s_intFormat = '(I6)' 27 | character(len=3), parameter :: s_charFormat = '(A)' 28 | character(len=4), parameter :: s_logicalFormat = '(L7)' 29 | character(len=11), parameter :: s_doubleFormat = '(ES25.15E3)' 30 | character(len=10), parameter :: s_outputFormat = '(ES11.4E2)' 31 | 32 | end module formatsMod 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /src/fields/parFile.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module parFileMod 20 | 21 | use errorHandlerMod 22 | use kindsMod 23 | use formatsMod 24 | 25 | implicit none 26 | 27 | type, public :: parFile 28 | 29 | character(len=:), allocatable :: fileName_ 30 | character(len=:), allocatable :: filePath_ 31 | 32 | end type 33 | 34 | !generic read parameter routines 35 | interface readParameter 36 | module PROCEDURE readParInt 37 | module PROCEDURE readParBool 38 | module PROCEDURE readParReal 39 | module PROCEDURE readParString 40 | end interface 41 | 42 | private :: frstnb 43 | 44 | 45 | contains 46 | 47 | !========================================================================================! 48 | subroutine parFileCTOR(this,fileName,fileDir) 49 | type(parFile), intent(out) :: this 50 | character(len=*), intent(in) :: fileName 51 | character(len=*), intent(in) :: fileDir 52 | 53 | this%fileName_ = fileName 54 | this%filePath_ = fileDir//'/'//fileName 55 | 56 | end subroutine 57 | !========================================================================================! 58 | 59 | !========================================================================================! 60 | subroutine readParInt(this,x,name,bcast) 61 | type(parFile), intent(in) :: this 62 | integer, intent(out) :: x 63 | character(len=*), intent(in) :: name 64 | logical, intent(in), optional :: bcast 65 | logical :: opt_bcast 66 | character(len=100) :: whole 67 | integer :: i1, i2, ios, ierror 68 | 69 | if (present(bcast)) then 70 | opt_bcast = bcast 71 | else 72 | opt_bcast = .TRUE. 73 | end if 74 | 75 | if (IS_MASTER) then 76 | 77 | open(UNIT=s_IOunitNumber,FILE=this%filePath_,STATUS='OLD',ACTION='READ') 78 | do 79 | read(s_IOunitNumber,s_charFormat,IOSTAT=ios) whole 80 | 81 | if (ios /= 0) then 82 | call mpiABORT('Parameter '//name//' not found in file '//this%fileName_) 83 | else 84 | !parse whole 85 | i1 = index(whole,' ') 86 | if (whole(1:i1-1) == name) then 87 | i2 = frstnb(whole(i1+1:),name) 88 | read(whole(i1+i2:),s_intFormat) x 89 | exit 90 | end if 91 | end if 92 | end do 93 | close(s_IOunitNumber) 94 | 95 | end if 96 | 97 | if (opt_bcast) then 98 | call MPI_BARRIER(MPI_COMM_WORLD,ierror) 99 | call MPI_BCAST(x, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierror) 100 | end if 101 | 102 | end subroutine 103 | !========================================================================================! 104 | 105 | !========================================================================================! 106 | subroutine readParBool(this,x,name,bcast) 107 | type(parFile), intent(in) :: this 108 | logical, intent(out) :: x 109 | character(len=*), intent(in) :: name 110 | logical, intent(in), optional :: bcast 111 | logical :: opt_bcast 112 | character(len=100) :: whole 113 | integer :: i1, i2, ios, ierror 114 | 115 | if (present(bcast)) then 116 | opt_bcast = bcast 117 | else 118 | opt_bcast = .TRUE. 119 | end if 120 | 121 | if (IS_MASTER) then 122 | 123 | open(UNIT=s_IOunitNumber,FILE=this%filePath_,STATUS='OLD',ACTION='READ') 124 | do 125 | read(s_IOunitNumber,s_charFormat,IOSTAT=ios) whole 126 | 127 | if (ios /= 0) then 128 | call mpiABORT('Parameter '//name//' not found in file '//this%fileName_) 129 | else 130 | !parse whole 131 | i1 = index(whole,' ') 132 | if (whole(1:i1-1) == name) then 133 | i2 = frstnb(whole(i1+1:),name) 134 | read(whole(i1+i2:),s_logicalFormat) x 135 | exit 136 | end if 137 | end if 138 | end do 139 | close(s_IOunitNumber) 140 | 141 | end if 142 | 143 | if (opt_bcast) then 144 | call MPI_BCAST(x, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierror) 145 | end if 146 | 147 | 148 | 149 | end subroutine 150 | !========================================================================================! 151 | 152 | !========================================================================================! 153 | subroutine readParReal(this,x,name,bcast) 154 | type(parFile), intent(in) :: this 155 | real(DP), intent(out) :: x 156 | character(len=*), intent(in) :: name 157 | logical, intent(in), optional :: bcast 158 | logical :: opt_bcast 159 | character(len=100) :: whole 160 | integer :: i1, i2, ios, ierror 161 | 162 | if (present(bcast)) then 163 | opt_bcast = bcast 164 | else 165 | opt_bcast = .TRUE. 166 | end if 167 | 168 | if (IS_MASTER) then 169 | 170 | open(UNIT=s_IOunitNumber,FILE=this%filePath_,STATUS='OLD',ACTION='READ') 171 | do 172 | read(s_IOunitNumber,s_charFormat,IOSTAT=ios) whole 173 | 174 | if (ios /= 0) then 175 | call mpiABORT('Parameter '//name//' not found in file '//this%fileName_) 176 | else 177 | !parse whole 178 | i1 = index(whole,' ') 179 | if (whole(1:i1-1) == name) then 180 | i2 = frstnb(whole(i1+1:),name) 181 | read(whole(i1+i2:),s_doubleFormat) x 182 | exit 183 | end if 184 | end if 185 | end do 186 | close(s_IOunitNumber) 187 | 188 | end if 189 | 190 | if (opt_bcast) then 191 | call MPI_BCAST(x, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierror) 192 | end if 193 | 194 | end subroutine 195 | !========================================================================================! 196 | 197 | !========================================================================================! 198 | subroutine readParString(this,x,name,bcast) 199 | type(parFile), intent(in) :: this 200 | character(len=100), intent(out) :: x 201 | character(len=*), intent(in) :: name 202 | logical, intent(in), optional :: bcast 203 | logical :: opt_bcast 204 | character(len=100) :: whole 205 | integer :: i1, i2, ios, ierror 206 | 207 | if (present(bcast)) then 208 | opt_bcast = bcast 209 | else 210 | opt_bcast = .TRUE. 211 | end if 212 | 213 | if (IS_MASTER) then 214 | 215 | open(UNIT=s_IOunitNumber,FILE=this%filePath_,STATUS='OLD',ACTION='READ') 216 | do 217 | read(s_IOunitNumber,s_charFormat,IOSTAT=ios) whole 218 | 219 | if (ios /= 0) then 220 | call mpiABORT('Parameter '//name//' not found in file '//this%fileName_) 221 | else 222 | !parse whole 223 | i1 = index(whole,' ') 224 | if (whole(1:i1-1) == name) then 225 | i2 = frstnb(whole(i1+1:),name) 226 | read(whole(i1+i2:),s_charFormat) x 227 | exit 228 | end if 229 | end if 230 | end do 231 | close(s_IOunitNumber) 232 | 233 | end if 234 | 235 | if (opt_bcast) then 236 | call MPI_BCAST(x, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierror) 237 | end if 238 | 239 | end subroutine 240 | !========================================================================================! 241 | 242 | !========================================================================================! 243 | function frstnb(str,par) result(ind) 244 | character(len=*), intent(in) :: str, par 245 | integer :: ind, i 246 | 247 | do i=1,len(str) 248 | if (str(i:i) /= ' ') then 249 | ind = i 250 | return 251 | end if 252 | end do 253 | 254 | call mpiABORT('Invalid entry while parsing parameter: ' // par) 255 | 256 | end function 257 | !========================================================================================! 258 | 259 | 260 | end module parFileMod -------------------------------------------------------------------------------- /src/fields/vfield/vfield.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module vfieldMod 20 | 21 | use fieldMod 22 | 23 | implicit none 24 | 25 | 26 | ! vfield 27 | type, public :: vfield 28 | 29 | !keep a pointer to grid 30 | type(grid), pointer :: ptrMesh_ => NULL() 31 | 32 | type(field) :: ux_, uy_, uz_ 33 | 34 | end type 35 | 36 | private :: equatePeriodicBC 37 | 38 | public :: vfieldCTOR 39 | public :: decomposeFieldV 40 | public :: reconstructAndWriteFieldV 41 | public :: updateBoundariesV 42 | public :: copyBoundaryV 43 | public :: allocateOldFieldV 44 | public :: storeOldFieldV 45 | 46 | contains 47 | 48 | !========================================================================================! 49 | subroutine read_file_vfield(gf,lf,gmesh,mesh,fname,nFolder,halo_size) 50 | type(vfield), intent(inout) :: gf 51 | type(vfield), intent(inout) :: lf 52 | type(grid), intent(in),target :: gmesh,mesh 53 | character(len=*), intent(in) :: fname 54 | integer, intent(in) :: nFolder,halo_size 55 | 56 | gf%ptrMesh_ => gmesh 57 | lf%ptrMesh_ => mesh 58 | 59 | call read_file_field(gf%ux_,lf%ux_,gmesh,mesh,fname,nFolder,halo_size,1) 60 | call read_file_field(gf%uy_,lf%uy_,gmesh,mesh,fname,nFolder,halo_size,2) 61 | call read_file_field(gf%uz_,lf%uz_,gmesh,mesh,fname,nFolder,halo_size,3) 62 | 63 | end subroutine 64 | !========================================================================================! 65 | 66 | !========================================================================================! 67 | subroutine vfieldCTOR(this,fileName,mesh,tpx,tpy,tpz,halo_size,initOpt,nFolder) 68 | type(vfield), intent(inout) :: this 69 | type(grid), intent(in), target :: mesh 70 | character(len=*), intent(in) :: fileName 71 | character(len=*), intent(in) :: tpx, tpy, tpz 72 | integer, intent(in) :: halo_size 73 | integer, intent(in) :: initOpt 74 | integer, intent(in), optional :: nFolder 75 | 76 | this%ptrMesh_ => mesh 77 | 78 | call fieldCTOR(this%ux_,fileName//'x',mesh,tpx,halo_size,initOpt,nFolder) 79 | call fieldCTOR(this%uy_,fileName//'y',mesh,tpy,halo_size,initOpt,nFolder) 80 | call fieldCTOR(this%uz_,fileName//'z',mesh,tpz,halo_size,initOpt,nFolder) 81 | 82 | end subroutine 83 | !========================================================================================! 84 | 85 | !========================================================================================! 86 | subroutine decomposeFieldV(this,lf) 87 | type(vfield), intent(inout) :: this 88 | type(vfield), intent(inout) :: lf 89 | 90 | call decomposeField(this%ux_,lf%ux_) 91 | call decomposeField(this%uy_,lf%uy_) 92 | call decomposeField(this%uz_,lf%uz_) 93 | 94 | end subroutine 95 | !========================================================================================! 96 | 97 | !========================================================================================! 98 | subroutine reconstructAndWriteFieldV(this,lf,output_folder) 99 | type(vfield), intent(inout) :: this 100 | type(vfield), intent(inout) :: lf 101 | integer, intent(in) :: output_folder 102 | 103 | call reconstructAndWriteField(this%ux_,lf%ux_,output_folder) 104 | call reconstructAndWriteField(this%uy_,lf%uy_,output_folder) 105 | call reconstructAndWriteField(this%uz_,lf%uz_,output_folder) 106 | 107 | end subroutine 108 | !========================================================================================! 109 | 110 | !========================================================================================! 111 | subroutine updateBoundariesV(this) 112 | type(vfield), intent(inout) :: this 113 | 114 | call updateBoundaries(this%ux_) 115 | call updateBoundaries(this%uy_) 116 | call updateBoundaries(this%uz_) 117 | 118 | call equatePeriodicBC(this) 119 | 120 | end subroutine 121 | !========================================================================================! 122 | 123 | !========================================================================================! 124 | subroutine equatePeriodicBC(u) 125 | type(vfield), intent(inout) :: u 126 | type(mpiControl), pointer :: mpic 127 | integer, dimension(6) :: requests 128 | integer, dimension(MPI_STATUS_SIZE,6) :: status 129 | integer :: hd, ierror, tag1, tag2, tag3 130 | integer :: isx, jsx, ksx, iex, jex, kex 131 | integer :: isy, jsy, ksy, iey, jey, key 132 | integer :: isz, jsz, ksz, iez, jez, kez 133 | 134 | mpic => u%ptrMesh_%ptrMPIC_ 135 | hd = u%ux_%hd_ 136 | 137 | tag1 = 0 138 | tag2 = 1 139 | tag3 = 2 140 | 141 | !ux indexes 142 | isx = u%ux_%is_ 143 | iex = u%ux_%ie_ 144 | jsx = u%ux_%js_ 145 | jex = u%ux_%je_ 146 | ksx = u%ux_%ks_ 147 | kex = u%ux_%ke_ 148 | 149 | !uy indexes 150 | isy = u%uy_%is_ 151 | iey = u%uy_%ie_ 152 | jsy = u%uy_%js_ 153 | jey = u%uy_%je_ 154 | ksy = u%uy_%ks_ 155 | key = u%uy_%ke_ 156 | 157 | !uz indexes 158 | isz = u%uz_%is_ 159 | iez = u%uz_%ie_ 160 | jsz = u%uz_%js_ 161 | jez = u%uz_%je_ 162 | ksz = u%uz_%ks_ 163 | kez = u%uz_%ke_ 164 | 165 | !equate ux bc 166 | !recv from left and send to right boundary 167 | call MPI_IRECV(u%ux_%f_(isx,jsx-hd,ksx-hd),1,u%ux_%xPatchEq_, mpic%leftNe_, & 168 | tag1, mpic%cartComm_, requests(1), ierror) 169 | call MPI_ISSEND(u%ux_%f_(iex,jsx-hd,ksx-hd), 1, u%ux_%xPatchEq_, mpic%rightNe_, & 170 | tag1, mpic%cartComm_, requests(2), ierror) 171 | 172 | !equate uy bc 173 | !recv from bottom and send to top boundary 174 | call MPI_IRECV(u%uy_%f_(isy-hd,jsy,ksy-hd),1,u%uy_%yPatchEq_, mpic%bottomNe_, & 175 | tag2, mpic%cartComm_, requests(3), ierror) 176 | call MPI_ISSEND(u%uy_%f_(isy-hd,jey,ksy-hd), 1, u%uy_%yPatchEq_, mpic%topNe_, & 177 | tag2, mpic%cartComm_, requests(4), ierror) 178 | 179 | !equate uz bc 180 | !recv from back and send to front boundary 181 | call MPI_IRECV(u%uz_%f_(isz-hd,jsz-hd,ksz),1,u%uz_%zPatchEq_, mpic%backNe_, & 182 | tag3, mpic%cartComm_, requests(5), ierror) 183 | call MPI_ISSEND(u%uz_%f_(isz-hd,jsz-hd,kez), 1, u%uz_%zPatchEq_, mpic%frontNe_, & 184 | tag3, mpic%cartComm_, requests(6), ierror) 185 | 186 | call MPI_WAITALL(6, requests, status, ierror) 187 | 188 | 189 | end subroutine 190 | !========================================================================================! 191 | 192 | !========================================================================================! 193 | subroutine copyBoundaryV(cpf,f,build_htypes) 194 | type(vfield), intent(inout) :: cpf 195 | type(vfield), intent(in) :: f 196 | logical, intent(in), optional :: build_htypes 197 | 198 | call copyBoundary(cpf%ux_,f%ux_,build_htypes) 199 | call copyBoundary(cpf%uy_,f%uy_,build_htypes) 200 | call copyBoundary(cpf%uz_,f%uz_,build_htypes) 201 | 202 | end subroutine 203 | !========================================================================================! 204 | 205 | !========================================================================================! 206 | subroutine allocateOldFieldV(vf,n) 207 | type(vfield), intent(inout) :: vf 208 | integer, intent(in) :: n 209 | 210 | call allocateOldField(vf%ux_,n) 211 | call allocateOldField(vf%uy_,n) 212 | call allocateOldField(vf%uz_,n) 213 | 214 | end subroutine 215 | !========================================================================================! 216 | 217 | !========================================================================================! 218 | subroutine storeOldFieldV(vf,n) 219 | type(vfield), intent(inout) :: vf 220 | integer, intent(in) :: n 221 | 222 | call storeOldField(vf%ux_,n) 223 | call storeOldField(vf%uy_,n) 224 | call storeOldField(vf%uz_,n) 225 | 226 | end subroutine 227 | !========================================================================================! 228 | 229 | 230 | end module vfieldMod 231 | 232 | 233 | 234 | 235 | 236 | 237 | -------------------------------------------------------------------------------- /src/initMpiGvar/initMpiGvar.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module initMpiGvarMod 20 | 21 | implicit none 22 | 23 | logical, protected :: IS_MASTER, IS_PAR 24 | integer, protected :: N_THREADS 25 | 26 | INCLUDE 'mpif.h' 27 | INCLUDE 'omp_lib.h' 28 | 29 | public :: mpiGVAR 30 | 31 | contains 32 | 33 | !========================================================================================! 34 | subroutine mpiGVAR() 35 | integer :: rank, nProcs, ierror 36 | 37 | call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierror) 38 | call MPI_COMM_SIZE(MPI_COMM_WORLD, nProcs, ierror) 39 | 40 | !set isMaster 41 | if (rank == 0) then 42 | IS_MASTER = .TRUE. 43 | else 44 | IS_MASTER = .FALSE. 45 | end if 46 | 47 | !set isParallel 48 | if (nProcs == 1) then 49 | IS_PAR = .FALSE. 50 | else 51 | IS_PAR = .TRUE. 52 | end if 53 | 54 | !set number of threads 55 | !$OMP PARALLEL DEFAULT(none) & 56 | !$OMP SHARED(N_THREADS) 57 | N_THREADS = omp_get_num_threads() 58 | !$OMP END PARALLEL 59 | 60 | end subroutine 61 | !========================================================================================! 62 | 63 | 64 | end module initMpiGvarMod 65 | 66 | 67 | 68 | 69 | 70 | 71 | -------------------------------------------------------------------------------- /src/initialConditions/initialConditions.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module initialConditionsMod 20 | 21 | use vfieldMod 22 | 23 | implicit none 24 | 25 | real(DP), parameter :: pi = 4.d0*DATAN(1.d0) 26 | 27 | public :: initChFlowVelocity 28 | public :: initShearVelocity 29 | public :: init_Bubble_vf 30 | 31 | 32 | contains 33 | 34 | !========================================================================================! 35 | subroutine initChFlowVelocity(u,mesh,gmesh) 36 | type(vfield), intent(inout) :: u 37 | type(grid), intent(in) :: mesh,gmesh 38 | real(DP) :: Lx, Ly, Lz 39 | integer :: i,j,k,ig,jg,kg,proc,nx,ny,nz 40 | real(DP) :: x, y, z, icA, icB 41 | type(parFile) :: pfile 42 | logical :: found 43 | 44 | call parFileCTOR(pfile,'initVelocity','specs') 45 | call readParameter(pfile,found,'perturbed_parabolic') 46 | if (found) then 47 | call readParameter(pfile,icA,'icA') 48 | icB = icA/10.d0 49 | else 50 | return 51 | end if 52 | 53 | Lx = gmesh%Lx_ 54 | Ly = gmesh%Ly_ 55 | Lz = gmesh%Lz_ 56 | 57 | nx=mesh%nx_ 58 | ny=mesh%ny_ 59 | nz=mesh%nz_ 60 | 61 | proc=mesh%ptrMPIC_%rank_ 62 | 63 | !ux 64 | do k=u%ux_%ks_,u%ux_%ke_ 65 | do j=u%ux_%js_,u%ux_%je_ 66 | do i=u%ux_%is_,u%ux_%ie_ 67 | 68 | !global indexes 69 | ig = mesh%ptrMPIC_%gCoords_(1,proc)*nx+i 70 | jg = mesh%ptrMPIC_%gCoords_(2,proc)*ny+j 71 | kg = mesh%ptrMPIC_%gCoords_(3,proc)*nz+k 72 | 73 | x = gmesh%xf_(ig) 74 | y = gmesh%yc_(jg) 75 | z = gmesh%zc_(kg) 76 | 77 | u%ux_%f_(i,j,k) = icA*y*(Ly-y) + & 78 | icB*cos(2.d0*pi*x/Lx)*sin(2.d0*pi*y/Ly)*sin(2.d0*pi*z/Lz) + & 79 | icB*cos(4.d0*pi*x/Lx)*sin(4.d0*pi*y/Ly)*sin(4.d0*pi*z/Lz) 80 | 81 | end do 82 | end do 83 | end do 84 | 85 | !uy 86 | do k=u%uy_%ks_,u%uy_%ke_ 87 | do j=u%uy_%js_,u%uy_%je_ 88 | do i=u%uz_%is_,u%uz_%ie_ 89 | 90 | !global indexes 91 | ig = mesh%ptrMPIC_%gCoords_(1,proc)*nx+i 92 | jg = mesh%ptrMPIC_%gCoords_(2,proc)*ny+j 93 | kg = mesh%ptrMPIC_%gCoords_(3,proc)*nz+k 94 | 95 | x = gmesh%xc_(ig) 96 | y = gmesh%yf_(jg) 97 | z = gmesh%zc_(kg) 98 | 99 | u%uy_%f_(i,j,k) = -(icB*Ly)/(2.d0*Lx)* & 100 | (sin(2.d0*pi*x/Lx)*(-1.d0+cos(2.d0*pi*y/Ly))*sin(2.d0*pi*z/Lz)+ & 101 | sin(4.d0*pi*x/Lx)*(-1.d0+cos(4.d0*pi*y/Ly))*sin(4.d0*pi*z/Lz)) 102 | 103 | end do 104 | end do 105 | end do 106 | 107 | !uz 108 | do k=u%uz_%ks_,u%uz_%ke_ 109 | do j=u%uz_%js_,u%uz_%je_ 110 | do i=u%uz_%is_,u%uz_%ie_ 111 | 112 | !global indexes 113 | ig = mesh%ptrMPIC_%gCoords_(1,proc)*nx+i 114 | jg = mesh%ptrMPIC_%gCoords_(2,proc)*ny+j 115 | kg = mesh%ptrMPIC_%gCoords_(3,proc)*nz+k 116 | 117 | x = gmesh%xc_(ig) 118 | y = gmesh%yc_(jg) 119 | z = gmesh%zf_(kg) 120 | 121 | u%uz_%f_(i,j,k) = -(icB*Lz)/(2.d0*Lx)* & 122 | (sin(2.d0*pi*x/Lx)*sin(2.d0*pi*y/Ly)*cos(2.d0*pi*z/Lz)+ & 123 | sin(4.d0*pi*x/Lx)*sin(4.d0*pi*y/Ly)*cos(4.d0*pi*z/Lz)) 124 | 125 | end do 126 | end do 127 | end do 128 | 129 | call updateBoundariesV(u) 130 | 131 | end subroutine 132 | !========================================================================================! 133 | 134 | !========================================================================================! 135 | subroutine initShearVelocity(u,mesh) 136 | type(vfield), intent(inout) :: u 137 | type(grid), intent(in) :: mesh 138 | integer :: i, j, k 139 | real(DP) :: x, y, z 140 | 141 | 142 | !ux 143 | do k=u%ux_%ks_,u%ux_%ke_ 144 | do j=u%ux_%js_,u%ux_%je_ 145 | do i=u%ux_%is_,u%ux_%ie_ 146 | 147 | x = mesh%xf_(i) 148 | y = mesh%yc_(j) 149 | z = mesh%zc_(k) 150 | 151 | u%ux_%f_(i,j,k) = 2.d0*sin(2.d0*pi*y)*sin(pi*x)*sin(pi*x)*sin(2.d0*pi*z) 152 | 153 | end do 154 | end do 155 | end do 156 | 157 | !uy 158 | do k=u%uy_%ks_,u%uy_%ke_ 159 | do j=u%uy_%js_,u%uy_%je_ 160 | do i=u%uz_%is_,u%uz_%ie_ 161 | 162 | x = mesh%xc_(i) 163 | y = mesh%yf_(j) 164 | z = mesh%zc_(k) 165 | 166 | u%uy_%f_(i,j,k) = -sin(2.d0*pi*x)*sin(pi*y)*sin(pi*y)*sin(2.d0*pi*z) 167 | 168 | end do 169 | end do 170 | end do 171 | 172 | !uz 173 | do k=u%uz_%ks_,u%uz_%ke_ 174 | do j=u%uz_%js_,u%uz_%je_ 175 | do i=u%uz_%is_,u%uz_%ie_ 176 | 177 | x = mesh%xc_(i) 178 | y = mesh%yc_(j) 179 | z = mesh%zf_(k) 180 | 181 | u%uz_%f_(i,j,k) = -sin(2.d0*pi*x)*sin(pi*z)*sin(pi*z)*sin(2.d0*pi*y) 182 | 183 | end do 184 | end do 185 | end do 186 | 187 | 188 | end subroutine 189 | !========================================================================================! 190 | 191 | !========================================================================================! 192 | subroutine init_Bubble_vf(mesh,cblk,x0,y0,z0,R,nref) 193 | type(grid), intent(in) :: mesh 194 | real(DP), allocatable, dimension(:,:,:), intent(inout) :: cblk 195 | real(DP), intent(in) :: x0,y0,z0,R 196 | integer, intent(in) :: nref 197 | integer :: is,js,ks,ie,je,ke,i,j,k,count,ir,kr,jr 198 | real(DP), allocatable, dimension(:) :: xcv,ycv,zcv,xfv,yfv,zfv,dxfv,dyfv,dzfv 199 | real(DP) :: x,y,z,rad,dx,dy,dz,dxref,dyref,dzref,xs,ys,zs,Vex,V 200 | 201 | is=lbound(cblk,1) 202 | ie=ubound(cblk,1) 203 | js=lbound(cblk,2) 204 | je=ubound(cblk,2) 205 | ks=lbound(cblk,3) 206 | ke=ubound(cblk,3) 207 | 208 | !copy from global mesh 209 | call allocateArray(xcv,is,ie) 210 | call allocateArray(ycv,js,je) 211 | call allocateArray(zcv,ks,ke) 212 | xcv=mesh%xc_(is:ie) 213 | ycv=mesh%yc_(js:je) 214 | zcv=mesh%zc_(ks:ke) 215 | 216 | call allocateArray(xfv,is-1,ie) 217 | call allocateArray(yfv,js-1,je) 218 | call allocateArray(zfv,ks-1,ke) 219 | xfv=mesh%xf_(is-1:ie) 220 | yfv=mesh%yf_(js-1:je) 221 | zfv=mesh%zf_(ks-1:ke) 222 | 223 | call allocateArray(dxfv,is,ie) 224 | call allocateArray(dyfv,js,je) 225 | call allocateArray(dzfv,ks,ke) 226 | dxfv=mesh%dxf_(is:ie) 227 | dyfv=mesh%dyf_(js:je) 228 | dzfv=mesh%dzf_(ks:ke) 229 | 230 | !init to zero 231 | cblk=0.d0 232 | 233 | !init gas cells 234 | do k=ks,ke 235 | do j=js,je 236 | do i=is,ie 237 | 238 | x = xcv(i)-x0 239 | y = ycv(j)-y0 240 | z = zcv(k)-z0 241 | 242 | rad= x*x+y*y+z*z 243 | 244 | if (rad <= (R*R)) then 245 | cblk(i,j,k) = 1.d0 246 | end if 247 | 248 | end do 249 | end do 250 | end do 251 | 252 | !refine vof for interface cells 253 | do k=ks,ke 254 | do j=js,je 255 | do i=is,ie 256 | 257 | count = 0 258 | 259 | !v1 260 | x = xfv(i-1)-x0 261 | y = yfv(j-1)-y0 262 | z = zfv(k-1)-z0 263 | 264 | rad = x*x+y*y+z*z 265 | if (rad <= R*R) then 266 | count = count + 1 267 | end if 268 | 269 | !v2 270 | x = xfv(i)-x0 271 | y = yfv(j-1)-y0 272 | z = zfv(k-1)-z0 273 | 274 | rad = x*x+y*y+z*z 275 | if (rad <= R*R) then 276 | count = count + 1 277 | end if 278 | 279 | !v3 280 | x = xfv(i)-x0 281 | y = yfv(j-1)-y0 282 | z = zfv(k)-z0 283 | 284 | rad = x*x+y*y+z*z 285 | if (rad <= R*R) then 286 | count = count + 1 287 | end if 288 | 289 | !v4 290 | x = xfv(i-1)-x0 291 | y = yfv(j-1)-y0 292 | z = zfv(k)-z0 293 | 294 | rad = x*x+y*y+z*z 295 | if (rad <= R*R) then 296 | count = count + 1 297 | end if 298 | 299 | !v5 300 | x = xfv(i-1)-x0 301 | y = yfv(j)-y0 302 | z = zfv(k-1)-z0 303 | 304 | rad = x*x+y*y+z*z 305 | if (rad <= R*R) then 306 | count = count + 1 307 | end if 308 | 309 | !v6 310 | x = xfv(i)-x0 311 | y = yfv(j)-y0 312 | z = zfv(k-1)-z0 313 | 314 | rad = x*x+y*y+z*z 315 | if (rad <= R*R) then 316 | count = count + 1 317 | end if 318 | 319 | !v7 320 | x = xfv(i)-x0 321 | y = yfv(j)-y0 322 | z = zfv(k)-z0 323 | 324 | rad = x*x+y*y+z*z 325 | if (rad <= R*R) then 326 | count = count + 1 327 | end if 328 | 329 | !v8 330 | x = xfv(i-1)-x0 331 | y = yfv(j)-y0 332 | z = zfv(k)-z0 333 | 334 | rad = x*x+y*y+z*z 335 | if (rad <= R*R) then 336 | count = count + 1 337 | end if 338 | 339 | if ((count >0) .AND. (count < 8)) then 340 | 341 | !reset vof interface cell 342 | cblk(i,j,k) = 0.d0 343 | 344 | dx = dxfv(i) 345 | dy = dyfv(j) 346 | dz = dzfv(k) 347 | dxref = dx/nref 348 | dyref = dy/nref 349 | dzref = dz/nref 350 | xs = xfv(i-1) 351 | ys = yfv(j-1) 352 | zs = zfv(k-1) 353 | 354 | do kr=1,nref 355 | do jr=1,nref 356 | do ir=1,nref 357 | 358 | x = xs+0.5d0*dxref+(ir-1)*dxref-x0 359 | y = ys+0.5d0*dyref+(jr-1)*dyref-y0 360 | z = zs+0.5d0*dzref+(kr-1)*dzref-z0 361 | 362 | rad = x*x+y*y+z*z 363 | if (rad <= R*R) then 364 | cblk(i,j,k) = cblk(i,j,k)+dxref*dyref*dzref 365 | end if 366 | 367 | end do 368 | end do 369 | end do 370 | 371 | cblk(i,j,k) = cblk(i,j,k)/(dx*dy*dz) 372 | 373 | end if 374 | 375 | 376 | end do 377 | end do 378 | end do 379 | 380 | 381 | Vex = (4.d0/3.d0)*pi*R*R*R 382 | V=0.d0 383 | do k=ks,ke 384 | do j=js,je 385 | do i=is,ie 386 | dx = dxfv(i) 387 | dy = dyfv(j) 388 | dz = dzfv(k) 389 | V=V+cblk(i,j,k)*dx*dy*dz 390 | end do 391 | end do 392 | end do 393 | 394 | !******** uncomment to print out volume error 395 | !write(*,'(A,'//s_outputFormat(2:9)//')') & 396 | ! 'VOF bubbles volume error: ', abs(V-Vex)/Vex 397 | 398 | end subroutine 399 | !========================================================================================! 400 | 401 | end module initialConditionsMod 402 | 403 | 404 | 405 | 406 | 407 | 408 | -------------------------------------------------------------------------------- /src/interpolation/interpolation.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module interpolationMod 20 | 21 | use kindsMod 22 | 23 | implicit none 24 | 25 | #ifdef MG_MODE 26 | public :: restrictionOp2D 27 | public :: restrictionOp3D 28 | public :: prolongationOp3D 29 | #endif 30 | public :: cellToVertex 31 | public :: vertexToCell 32 | public :: cellToVertexBlock 33 | public :: vertexToCellBlock 34 | 35 | 36 | contains 37 | 38 | ! 2D restriction op: bilinear interp 39 | #ifdef MG_MODE 40 | !========================================================================================! 41 | subroutine restrictionOp2D(qf,qc,xf,yf,xc,yc) 42 | !c = coarse 43 | !f = fine 44 | !q = field; x,y = pos 45 | ! note: the fields and the coords are passed without halo 46 | real(DP), dimension(:,:), intent(IN) :: qf 47 | real(DP), dimension(:,:), intent(INOUT) :: qc 48 | real(DP), dimension(:), intent(IN) :: xf, yf 49 | real(DP), dimension(:), intent(IN) :: xc, yc 50 | real(DP) :: wA, wB, wC, wD, A 51 | integer :: i, j 52 | 53 | !$OMP PARALLEL DO DEFAULT(none) & 54 | !$OMP SHARED(qf,qc,xf,yf,xc,yc) & 55 | !$OMP PRIVATE(i,j) & 56 | !$OMP PRIVATE(A,wA,wB,wC,wD) 57 | do j=1,ubound(qc,2) 58 | do i=1,ubound(qc,1) 59 | !compute the weights 60 | wA = (xf(2*i)-xc(i))*(yc(j)-yf(2*j-1)) 61 | wB = (xc(i)-xf(2*i-1))*(yc(j)-yf(2*j-1)) 62 | wC = (xf(2*i)-xc(i))*(yf(2*j)-yc(j)) 63 | wD = (xc(i)-xf(2*i-1))*(yf(2*j)-yc(j)) 64 | !total area 65 | A = (xf(2*i)-xf(2*i-1))*(yf(2*j)-yf(2*j-1)) 66 | !interpolate value 67 | qc(i,j) = ( & 68 | wA*qf(2*i-1,2*j) + wB*qf(2*i,2*j) & 69 | + wC*qf(2*i-1,2*j-1) + wD*qf(2*i,2*j-1) & 70 | )/A 71 | end do 72 | end do 73 | !$OMP END PARALLEL DO 74 | 75 | end subroutine 76 | !========================================================================================! 77 | 78 | ! 3D restriction op: trilinear interp 79 | !========================================================================================! 80 | subroutine restrictionOp3D(qf,qc,xf,yf,zf,xc,yc,zc) 81 | !c = coarse 82 | !f = fine 83 | !q = field; x,y,z = pos 84 | ! note: the fields and the coords are passed without halo 85 | real(DP), dimension(:,:,:), intent(IN) :: qf 86 | real(DP), dimension(:,:,:), intent(INOUT) :: qc 87 | real(DP), dimension(:), intent(IN) :: xf,yf,zf 88 | real(DP), dimension(:), intent(IN) :: xc,yc,zc 89 | real(DP) :: w1, w2, w3, w4, w5, w6, w7, w8, V 90 | integer :: i, j, k 91 | 92 | 93 | !$OMP PARALLEL DO DEFAULT(none) & 94 | !$OMP SHARED(qf,qc,xf,yf,zf,xc,yc,zc) & 95 | !$OMP PRIVATE(i,j,k) & 96 | !$OMP PRIVATE(V,w1,w2,w3,w4,w5,w6,w7,w8) 97 | do k=1,ubound(qc,3) 98 | do j=1,ubound(qc,2) 99 | do i=1,ubound(qc,1) 100 | !compute the weights 101 | w1 = (xf(2*i)-xc(i))*(yf(2*j)-yc(j))*(zf(2*k)-zc(k)) 102 | w2 = (xc(i)-xf(2*i-1))*(yf(2*j)-yc(j))*(zf(2*k)-zc(k)) 103 | w3 = (xf(2*i)-xc(i))*(yc(j)-yf(2*j-1))*(zf(2*k)-zc(k)) 104 | w4 = (xc(i)-xf(2*i-1))*(yc(j)-yf(2*j-1))*(zf(2*k)-zc(k)) 105 | w5 = (xf(2*i)-xc(i))*(yf(2*j)-yc(j))*(zc(k)-zf(2*k-1)) 106 | w6 = (xc(i)-xf(2*i-1))*(yf(2*j)-yc(j))*(zc(k)-zf(2*k-1)) 107 | w7 = (xf(2*i)-xc(i))*(yc(j)-yf(2*j-1))*(zc(k)-zf(2*k-1)) 108 | w8 = (xc(i)-xf(2*i-1))*(yc(j)-yf(2*j-1))*(zc(k)-zf(2*k-1)) 109 | !total volume 110 | V = (xf(2*i)-xf(2*i-1))*(yf(2*j)-yf(2*j-1))*(zf(2*k)-zf(2*k-1)) 111 | 112 | !interpolate value 113 | qc(i,j,k) = ( & 114 | w1*qf(2*i-1,2*j-1,2*k-1) + w2*qf(2*i,2*j-1,2*k-1) & 115 | + w3*qf(2*i-1,2*j,2*k-1) + w4*qf(2*i,2*j,2*k-1) & 116 | + w5*qf(2*i-1,2*j-1,2*k) + w6*qf(2*i,2*j-1,2*k) & 117 | + w7*qf(2*i-1,2*j,2*k) + w8*qf(2*i,2*j,2*k) & 118 | )/V 119 | end do 120 | end do 121 | end do 122 | !$OMP END PARALLEL DO 123 | 124 | end subroutine 125 | !========================================================================================! 126 | 127 | ! 3D prolongation op: trilinear interp 128 | !========================================================================================! 129 | subroutine prolongationOp3D(qf,qc,xf,yf,zf,xc,yc,zc) 130 | !c = coarse 131 | !f = fine 132 | !q = field; x,y,z = pos 133 | ! note: the finer field is passed without halo 134 | ! the corse field is passed entirely 135 | real(DP), dimension(:,:,:), intent(INOUT) :: qf 136 | real(DP), allocatable, dimension(:,:,:), intent(IN) :: qc 137 | real(DP), dimension(:), intent(IN) :: xf,yf,zf 138 | real(DP), allocatable, dimension(:), intent(IN) :: xc,yc,zc 139 | real(DP) :: w1, w2, w3, w4, w5, w6, w7, w8, V 140 | integer :: i, j, k 141 | integer :: ih, jh, kh 142 | 143 | 144 | !$OMP PARALLEL DO DEFAULT(none) & 145 | !$OMP SHARED(qf,qc,xf,yf,zf,xc,yc,zc) & 146 | !$OMP PRIVATE(i,j,k,ih,jh,kh) & 147 | !$OMP PRIVATE(V,w1,w2,w3,w4,w5,w6,w7,w8) 148 | do k=1,ubound(qf,3) 149 | do j=1,ubound(qf,2) 150 | do i=1,ubound(qf,1) 151 | 152 | ih = i/2 153 | jh = j/2 154 | kh = k/2 155 | 156 | !compute the weights 157 | w1 = (xc(ih+1)-xf(i))*(yc(jh+1)-yf(j))*(zc(kh+1)-zf(k)) 158 | w2 = (xf(i)-xc(ih))*(yc(jh+1)-yf(j))*(zc(kh+1)-zf(k)) 159 | w3 = (xc(ih+1)-xf(i))*(yf(j)-yc(jh))*(zc(kh+1)-zf(k)) 160 | w4 = (xf(i)-xc(ih))*(yf(j)-yc(jh))*(zc(kh+1)-zf(k)) 161 | w5 = (xc(ih+1)-xf(i))*(yc(jh+1)-yf(j))*(zf(k)-zc(kh)) 162 | w6 = (xf(i)-xc(ih))*(yc(jh+1)-yf(j))*(zf(k)-zc(kh)) 163 | w7 = (xc(ih+1)-xf(i))*(yf(j)-yc(jh))*(zf(k)-zc(kh)) 164 | w8 = (xf(i)-xc(ih))*(yf(j)-yc(jh))*(zf(k)-zc(kh)) 165 | !total volume 166 | V = (xc(ih+1)-xc(ih))*(yc(jh+1)-yc(jh))*(zc(kh+1)-zc(kh)) 167 | 168 | !interpolate value 169 | qf(i,j,k) = ( & 170 | w1*qc(ih,jh,kh) + w2*qc(ih+1,jh,kh) & 171 | + w3*qc(ih,jh+1,kh) + w4*qc(ih+1,jh+1,kh) & 172 | + w5*qc(ih,jh,kh+1) + w6*qc(ih+1,jh,kh+1) & 173 | + w7*qc(ih,jh+1,kh+1) + w8*qc(ih+1,jh+1,kh+1) & 174 | )/V 175 | 176 | end do 177 | end do 178 | end do 179 | !$OMP END PARALLEL DO 180 | 181 | end subroutine 182 | !========================================================================================! 183 | 184 | #endif 185 | 186 | ! 3D interpolation to vertces: trilinear interp 187 | !========================================================================================! 188 | subroutine cellToVertex(q,qv,x,y,z,xv,yv,zv) 189 | !v = vertex 190 | !q = field; x,y,z = pos 191 | real(DP), allocatable, dimension(:,:,:), intent(IN) :: q 192 | real(DP), allocatable, dimension(:,:,:), intent(INOUT) :: qv 193 | real(DP), allocatable, dimension(:), intent(IN) :: x,y,z 194 | real(DP), allocatable, dimension(:), intent(IN) :: xv, yv, zv 195 | real(DP) :: w1, w2, w3, w4, w5, w6, w7, w8, V 196 | integer :: i, j, k 197 | 198 | !$OMP PARALLEL DO DEFAULT(none) & 199 | !$OMP SHARED(q,qv,x,y,z,xv,yv,zv) & 200 | !$OMP PRIVATE(i,j,k) & 201 | !$OMP PRIVATE(V,w1,w2,w3,w4,w5,w6,w7,w8) 202 | do k=lbound(qv,3),ubound(qv,3) 203 | do j=lbound(qv,2),ubound(qv,2) 204 | do i=lbound(qv,1),ubound(qv,1) 205 | !compute the weights 206 | w1 = (x(i+1)-xv(i))*(yv(j)-y(j))*(z(k+1)-zv(k)) 207 | w2 = (xv(i)-x(i))*(yv(j)-y(j))*(z(k+1)-zv(k)) 208 | w3 = (x(i+1)-xv(i))*(yv(j)-y(j))*(zv(k)-z(k)) 209 | w4 = (xv(i)-x(i))*(yv(j)-y(j))*(zv(k)-z(k)) 210 | w5 = (x(i+1)-xv(i))*(y(j+1)-yv(j))*(z(k+1)-zv(k)) 211 | w6 = (xv(i)-x(i))*(y(j+1)-yv(j))*(z(k+1)-zv(k)) 212 | w7 = (x(i+1)-xv(i))*(y(j+1)-yv(j))*(zv(k)-z(k)) 213 | w8 = (xv(i)-x(i))*(y(j+1)-yv(j))*(zv(k)-z(k)) 214 | !total volume 215 | V = (x(i+1)-x(i))*(y(j+1)-y(j))*(z(k+1)-z(k)) 216 | 217 | !interpolate value 218 | qv(i,j,k) = ( & 219 | w1*q(i,j+1,k) + w2*q(i+1,j+1,k) & 220 | + w3*q(i,j+1,k+1) + w4*q(i+1,j+1,k+1) & 221 | + w5*q(i,j,k) + w6*q(i+1,j,k) & 222 | + w7*q(i,j,k+1) + w8*q(i+1,j,k+1) & 223 | )/V 224 | end do 225 | end do 226 | end do 227 | !$OMP END PARALLEL DO 228 | 229 | end subroutine 230 | !========================================================================================! 231 | 232 | ! vertex average interpolation 233 | !========================================================================================! 234 | subroutine vertexToCell(q,qv,x,y,z,xv,yv,zv) 235 | !v = vertex 236 | !q = field; x,y,z = pos 237 | real(DP), allocatable, dimension(:,:,:), intent(INOUT) :: q 238 | real(DP), allocatable, dimension(:,:,:), intent(IN) :: qv 239 | real(DP), allocatable, dimension(:), intent(IN) :: x,y,z 240 | real(DP), allocatable, dimension(:), intent(IN) :: xv,yv,zv 241 | real(DP) :: w1, w2, w3, w4, w5, w6, w7, w8, V 242 | integer :: i, j, k 243 | 244 | !$OMP PARALLEL DO DEFAULT(none) & 245 | !$OMP SHARED(q,qv,x,y,z,xv,yv,zv) & 246 | !$OMP PRIVATE(i,j,k) & 247 | !$OMP PRIVATE(V,w1,w2,w3,w4,w5,w6,w7,w8) 248 | do k=1,ubound(qv,3) 249 | do j=1,ubound(qv,2) 250 | do i=1,ubound(qv,1) 251 | !compute the weights 252 | w1 = (xv(i)-x(i))*(y(j)-yv(j-1))*(zv(k)-z(k)) 253 | w2 = (x(i)-xv(i-1))*(y(j)-yv(j-1))*(zv(k)-z(k)) 254 | w3 = (xv(i)-x(i))*(y(j)-yv(j-1))*(z(k)-zv(k-1)) 255 | w4 = (x(i)-xv(i-1))*(y(j)-yv(j-1))*(z(k)-zv(k-1)) 256 | w5 = (xv(i)-x(i))*(yv(j)-y(j))*(zv(k)-z(k)) 257 | w6 = (x(i)-xv(i-1))*(yv(j)-y(j))*(zv(k)-z(k)) 258 | w7 = (xv(i)-x(i))*(yv(j)-y(j))*(z(k)-zv(k-1)) 259 | w8 = (x(i)-xv(i-1))*(yv(j)-y(j))*(z(k)-zv(k-1)) 260 | 261 | !total volume 262 | V = (xv(i)-xv(i-1))*(yv(j)-yv(j-1))*(zv(k)-zv(k-1)) 263 | 264 | !interpolate value 265 | q(i,j,k) = ( & 266 | w1*qv(i-1,j,k-1) + w2*qv(i,j,k-1) & 267 | + w3*qv(i-1,j,k) + w4*qv(i,j,k) & 268 | + w5*qv(i-1,j-1,k-1) + w6*qv(i,j-1,k-1) & 269 | + w7*qv(i-1,j-1,k) + w8*qv(i,j-1,k) & 270 | )/V 271 | end do 272 | end do 273 | end do 274 | !$OMP END PARALLEL DO 275 | 276 | end subroutine 277 | !========================================================================================! 278 | 279 | ! 3D interpolation to vertces (vof block): trilinear interp 280 | !========================================================================================! 281 | subroutine cellToVertexBlock(q,qv,x,y,z,xv,yv,zv) 282 | !v = vertex 283 | !q = field; x,y,z = pos 284 | real(DP), allocatable, dimension(:,:,:), intent(IN) :: q 285 | real(DP), allocatable, dimension(:,:,:), intent(INOUT) :: qv 286 | real(DP), pointer, dimension(:), intent(IN) :: x,y,z 287 | real(DP), pointer, dimension(:), intent(IN) :: xv,yv,zv 288 | ! real(DP), allocatable, dimension(:), intent(IN) :: x,y,z 289 | ! real(DP), allocatable, dimension(:), intent(IN) :: xv,yv,zv 290 | real(DP) :: w1, w2, w3, w4, w5, w6, w7, w8, V 291 | integer :: i, j, k 292 | 293 | do k=lbound(qv,3),ubound(qv,3) 294 | do j=lbound(qv,2),ubound(qv,2) 295 | do i=lbound(qv,1),ubound(qv,1) 296 | !compute the weights 297 | w1 = (x(i+1)-xv(i))*(yv(j)-y(j))*(z(k+1)-zv(k)) 298 | w2 = (xv(i)-x(i))*(yv(j)-y(j))*(z(k+1)-zv(k)) 299 | w3 = (x(i+1)-xv(i))*(yv(j)-y(j))*(zv(k)-z(k)) 300 | w4 = (xv(i)-x(i))*(yv(j)-y(j))*(zv(k)-z(k)) 301 | w5 = (x(i+1)-xv(i))*(y(j+1)-yv(j))*(z(k+1)-zv(k)) 302 | w6 = (xv(i)-x(i))*(y(j+1)-yv(j))*(z(k+1)-zv(k)) 303 | w7 = (x(i+1)-xv(i))*(y(j+1)-yv(j))*(zv(k)-z(k)) 304 | w8 = (xv(i)-x(i))*(y(j+1)-yv(j))*(zv(k)-z(k)) 305 | !total volume 306 | V = (x(i+1)-x(i))*(y(j+1)-y(j))*(z(k+1)-z(k)) 307 | 308 | !interpolate value 309 | qv(i,j,k) = ( & 310 | w1*q(i,j+1,k) + w2*q(i+1,j+1,k) & 311 | + w3*q(i,j+1,k+1) + w4*q(i+1,j+1,k+1) & 312 | + w5*q(i,j,k) + w6*q(i+1,j,k) & 313 | + w7*q(i,j,k+1) + w8*q(i+1,j,k+1) & 314 | )/V 315 | end do 316 | end do 317 | end do 318 | 319 | end subroutine 320 | !========================================================================================! 321 | 322 | ! vertex average interpolation (vof block) 323 | !========================================================================================! 324 | subroutine vertexToCellBlock(q,qv,x,y,z,xv,yv,zv) 325 | !v = vertex 326 | !q = field; x,y,z = pos 327 | real(DP), allocatable, dimension(:,:,:), intent(INOUT) :: q 328 | real(DP), allocatable, dimension(:,:,:), intent(IN) :: qv 329 | real(DP), pointer, dimension(:), intent(IN) :: x,y,z 330 | real(DP), pointer, dimension(:), intent(IN) :: xv,yv,zv 331 | ! real(DP), allocatable, dimension(:), intent(IN) :: x,y,z 332 | ! real(DP), allocatable, dimension(:), intent(IN) :: xv,yv,zv 333 | real(DP) :: w1, w2, w3, w4, w5, w6, w7, w8, V 334 | integer :: i, j, k 335 | 336 | do k=lbound(q,3),ubound(q,3) 337 | do j=lbound(q,2),ubound(q,2) 338 | do i=lbound(q,1),ubound(q,1) 339 | !compute the weights 340 | w1 = (xv(i)-x(i))*(y(j)-yv(j-1))*(zv(k)-z(k)) 341 | w2 = (x(i)-xv(i-1))*(y(j)-yv(j-1))*(zv(k)-z(k)) 342 | w3 = (xv(i)-x(i))*(y(j)-yv(j-1))*(z(k)-zv(k-1)) 343 | w4 = (x(i)-xv(i-1))*(y(j)-yv(j-1))*(z(k)-zv(k-1)) 344 | w5 = (xv(i)-x(i))*(yv(j)-y(j))*(zv(k)-z(k)) 345 | w6 = (x(i)-xv(i-1))*(yv(j)-y(j))*(zv(k)-z(k)) 346 | w7 = (xv(i)-x(i))*(yv(j)-y(j))*(z(k)-zv(k-1)) 347 | w8 = (x(i)-xv(i-1))*(yv(j)-y(j))*(z(k)-zv(k-1)) 348 | 349 | !total volume 350 | V = (xv(i)-xv(i-1))*(yv(j)-yv(j-1))*(zv(k)-zv(k-1)) 351 | 352 | !interpolate value 353 | q(i,j,k) = ( & 354 | w1*qv(i-1,j,k-1) + w2*qv(i,j,k-1) & 355 | + w3*qv(i-1,j,k) + w4*qv(i,j,k) & 356 | + w5*qv(i-1,j-1,k-1) + w6*qv(i,j-1,k-1) & 357 | + w7*qv(i-1,j-1,k) + w8*qv(i,j-1,k) & 358 | )/V 359 | end do 360 | end do 361 | end do 362 | 363 | end subroutine 364 | !========================================================================================! 365 | 366 | 367 | 368 | 369 | end module interpolationMod 370 | 371 | 372 | 373 | 374 | 375 | 376 | -------------------------------------------------------------------------------- /src/kinds/kinds.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module kindsMod 20 | implicit none 21 | 22 | !kinds 23 | integer, parameter :: SP = KIND(0.e0) 24 | integer, parameter :: DP = KIND(0.d0) 25 | 26 | !size 27 | integer, parameter :: realSP_size = SIZEOF(0.e0) 28 | integer, parameter :: realDP_size = SIZEOF(0.d0) 29 | integer, parameter :: integer_size = SIZEOF(0) 30 | integer, parameter :: logical_size = SIZEOF(.TRUE.) 31 | 32 | end module kindsMod 33 | -------------------------------------------------------------------------------- /src/main.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | PROGRAM main 20 | 21 | USE momentumEqnMod 22 | USE poissonEqnMod 23 | USE initialConditionsMod 24 | USE vofMOD 25 | USE statisticsMod 26 | USE rampUpPropMod 27 | 28 | IMPLICIT NONE 29 | 30 | integer :: ierror,flow_solver 31 | type(mpiControl) :: mpiCTRL 32 | type(time) :: runTime 33 | type(grid) :: gMesh, mesh 34 | type(field) :: gpsi, psi 35 | type(field) :: gc, c, gcs, cs, gcurv, curv 36 | type(field) :: rho, mu 37 | type(vfield) :: gU, U, gW, w 38 | type(momentumEqn) :: uEqn 39 | type(poissonEqn) :: pEqn 40 | type(VOF) :: vofS 41 | type(statistics) :: stats 42 | type(rampUpProp) :: rhoRamp,muRamp 43 | type(parFile) :: file_fsolver 44 | real(DP) :: t_S, t_E, t_S0, t_E0 45 | 46 | 47 | call MPI_INIT(ierror) 48 | call mpiGVAR() 49 | call mpiControlCTOR(mpiCTRL) 50 | call timeCTOR(runTime,u,mpiCTRL) 51 | 52 | t_S0 = MPI_Wtime() 53 | 54 | INCLUDE 'createFields_H.f90' 55 | 56 | call init_main_solver() 57 | 58 | call info_run_start() 59 | 60 | !***************************** FLOW SOLVER ******************************! 61 | if (flow_solver==SINGLE_PHASE_FLOW) then 62 | call sph_flow_solver() 63 | end if 64 | 65 | if (flow_solver==TWO_PHASE_FLOW) then 66 | call tph_flow_solver() 67 | end if 68 | !************************************************************************! 69 | 70 | !write final before exit 71 | INCLUDE 'writeFields_H.f90' 72 | 73 | t_E0 = MPI_Wtime() 74 | 75 | call info_run_end() 76 | 77 | 78 | !clean up 79 | call deallocateBlocks(vofBlocks) 80 | call MPI_FINALIZE(ierror) 81 | 82 | 83 | 100 FORMAT(E18.10) 84 | 101 FORMAT(I4) 85 | 86 | 87 | contains 88 | 89 | !========================================================================================! 90 | subroutine info_run_start() 91 | 92 | if (IS_MASTER) then 93 | write(*,*) '' 94 | write(*,'(A,'//s_intFormat(2:3)//',A)') & 95 | 'INIT TIME-INTEGRATOR on ', mpiCTRL%nProcs_*N_THREADS, ' cores' 96 | end if 97 | 98 | end subroutine 99 | !========================================================================================! 100 | 101 | !========================================================================================! 102 | subroutine info_run_end() 103 | 104 | if (IS_MASTER) then 105 | write(*,*) '' 106 | write(*,'(A,'//s_outputFormat(2:9)//')') & 107 | 'EXIT RUN NORMAL. SIMULATION TIME: ', t_E0-t_S0 108 | end if 109 | 110 | end subroutine 111 | !========================================================================================! 112 | 113 | !========================================================================================! 114 | subroutine info_run_cpu_time() 115 | 116 | if (IS_MASTER) then 117 | write(*,'(A,'//s_outputFormat(2:9)//')') ' TOTAL CPU TIME: ', t_E-t_S 118 | end if 119 | 120 | end subroutine 121 | !========================================================================================! 122 | 123 | !========================================================================================! 124 | subroutine init_main_solver() 125 | 126 | !read flow solver type 127 | call parFileCTOR(file_fsolver,'flowSolver','specs') 128 | call readParameter(file_fsolver,flow_solver,'flow_solver') 129 | 130 | call vofCTOR(vofS,gmesh,mesh,runTime,flow_solver) 131 | call momentumEqnCTOR(uEqn,gMesh,mesh,gu,u,runTime) 132 | #ifdef FAST_MODE 133 | call poissonEqnCTOR(pEqn,mesh,gMesh,gpsi,psi,runTime,vofS%rhol_,vofS%rhog_) 134 | #endif 135 | #ifdef MG_MODE 136 | call poissonEqnCTOR(pEqn,mesh,gMesh,cs,gpsi,psi,runTime,vofS%rhol_,vofS%rhog_) 137 | #endif 138 | 139 | !build ramps 140 | call rampUpPropCTOR(rhoRamp,vofS%rhog_,vofS%rhol_,vofS%rhog_) 141 | call rampUpPropCTOR(muRamp,vofS%mug_,vofS%mul_,vofS%mug_) 142 | call updateMaterialProps(vofS,c,cs,rho,mu) 143 | 144 | call statisticsCTOR(stats,u,w,p,c,mu,vofS%mul_/vofS%rhol_,gMesh,runTime) 145 | 146 | !store time-step restrictions 147 | call compute_timestep_restrictions(runTime,u,gMesh,vofS%rhol_,vofS%rhog_,& 148 | vofS%mul_,vofS%mug_,vofS%sigma_,flow_solver) 149 | 150 | end subroutine 151 | !========================================================================================! 152 | 153 | !========================================================================================! 154 | subroutine reset_matprops_sph() 155 | 156 | c%f_ = 0.d0 157 | cs%f_ = 0.d0 158 | vofS%rhog_ = vofS%rhol_ 159 | vofS%mug_ = vofS%mul_ 160 | rho%f_ = vofS%rhol_ 161 | mu%f_ = vofS%mul_ 162 | 163 | end subroutine 164 | !========================================================================================! 165 | 166 | !========================================================================================! 167 | subroutine tph_flow_solver() 168 | 169 | !cycle time loop 170 | do while (timeloop(runTime)) 171 | 172 | t_S = MPI_Wtime() 173 | 174 | !update ramped props 175 | call updateProp(rhoRamp,runTime%t_,vofS%rhog_) 176 | call updateProp(muRamp,runTime%t_,vofS%mug_) 177 | 178 | !update stats 179 | call updateStats(stats,runTime%t_,runTime%dt_) 180 | 181 | do while (timeRkStep(runTime)) 182 | 183 | !advect VOF 184 | call solveVOF(vofS,c,u) 185 | 186 | !update surface tension and mat pros 187 | call computeSurfaceTension(vofS,st,curv) 188 | call updateMaterialProps(vofS,c,cs,rho,mu) 189 | 190 | call setPressGrad(uEqn%flowCtrl_,uEqn%Ret_,rho,vofS%rhol_,vofS%mul_,& 191 | uEqn%gCH_,uEqn%fs_) 192 | 193 | !solve momentum equation 194 | call solveMomentumEqn(uEqn,u,p,mu,rho,pEqn%rho0_,st,c) 195 | 196 | !solve poisson equation 197 | call solvePoissonEqn(pEqn,psi,rho,u,st) 198 | 199 | !divergence free velocity 200 | #ifdef FAST_MODE 201 | call makeVelocityDivFree(uEqn,u,st,psi,rho,pEqn%rho0_,pEqn%nl_) 202 | #endif 203 | #ifdef MG_MODE 204 | call makeVelocityDivFree(uEqn,u,psi,rho) 205 | #endif 206 | 207 | !set flow rate 208 | call setFlowRate(uEqn%flowCtrl_,u,rho,uEqn%Q0_,runTime%dt_,& 209 | alphaRKS(runTime)) 210 | 211 | !print out continuity error 212 | call computeContinuityError(u,runTime%dt_) 213 | 214 | !update pressure 215 | call updatePressure(pEqn,psi,p,p0,st,st0) 216 | 217 | end do 218 | 219 | call computeVorticity(u,w) 220 | 221 | if (timeOutput(runTime)) then 222 | INCLUDE 'writeFields_H.f90' 223 | end if 224 | 225 | t_E = MPI_Wtime() 226 | 227 | call info_run_cpu_time() 228 | 229 | end do 230 | 231 | 232 | end subroutine 233 | !========================================================================================! 234 | 235 | !========================================================================================! 236 | subroutine sph_flow_solver() 237 | 238 | call reset_matprops_sph() 239 | 240 | !cycle time loop 241 | do while (timeloop(runTime)) 242 | 243 | t_S = MPI_Wtime() 244 | 245 | !update stats 246 | call updateStats(stats,runTime%t_,runTime%dt_) 247 | 248 | do while (timeRkStep(runTime)) 249 | 250 | call setPressGrad(uEqn%flowCtrl_,uEqn%Ret_,rho,vofS%rhol_,vofS%mul_,& 251 | uEqn%gCH_,uEqn%fs_) 252 | 253 | !solve momentum equation 254 | call solveMomentumEqn(uEqn,u,p,mu,rho,pEqn%rho0_,st,c) 255 | 256 | !solve poisson equation 257 | call solvePoissonEqn(pEqn,psi,rho,u,st) 258 | 259 | !divergence free velocity 260 | #ifdef FAST_MODE 261 | call makeVelocityDivFree(uEqn,u,st,psi,rho,pEqn%rho0_,pEqn%nl_) 262 | #endif 263 | #ifdef MG_MODE 264 | call makeVelocityDivFree(uEqn,u,psi,rho) 265 | #endif 266 | 267 | !set flow rate 268 | call setFlowRate(uEqn%flowCtrl_,u,rho,uEqn%Q0_,runTime%dt_,& 269 | alphaRKS(runTime)) 270 | 271 | !print out continuity error 272 | call computeContinuityError(u,runTime%dt_) 273 | 274 | !update pressure 275 | call updatePressure(pEqn,psi,p,p0,st,st0) 276 | 277 | end do 278 | 279 | call computeVorticity(u,w) 280 | 281 | if (timeOutput(runTime)) then 282 | INCLUDE 'writeFields_H.f90' 283 | end if 284 | 285 | t_E = MPI_Wtime() 286 | 287 | call info_run_cpu_time() 288 | 289 | end do 290 | 291 | end subroutine 292 | !========================================================================================! 293 | 294 | 295 | END PROGRAM main 296 | 297 | -------------------------------------------------------------------------------- /src/mpiControl/mpiControl.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module mpiControlMod 20 | 21 | use allocateArraysMod 22 | use parFileMod 23 | 24 | implicit none 25 | 26 | 27 | type, public :: mpiControl 28 | 29 | !cartesian communicator 30 | integer :: cartComm_ 31 | 32 | integer, dimension(3) :: nProcsAxis_ 33 | integer, dimension(3) :: procCoord_ 34 | logical, dimension(3) :: wrapAround_ 35 | 36 | integer, allocatable, dimension(:,:) :: gCoords_ 37 | 38 | integer :: rank_ 39 | integer :: nProcs_ 40 | 41 | !mesh size 42 | integer, private :: nx_, ny_, nz_ 43 | 44 | !neighbours procs 45 | integer :: leftNe_, rightNe_, backNe_, frontNe_, bottomNe_, topNe_ 46 | 47 | !halo dim 48 | integer, private :: haloDim_ 49 | 50 | contains 51 | 52 | 53 | end type 54 | 55 | private :: readMeshpfile 56 | private :: readDecomposepfile 57 | private :: setNeighboursProc 58 | private :: setGlobalCoord 59 | #ifdef FAST_MODE 60 | private :: checkPeriodicDirFFT 61 | private :: checkPencilDecomp 62 | #endif 63 | 64 | public :: mpiControlCTOR 65 | 66 | 67 | contains 68 | 69 | 70 | !========================================================================================! 71 | subroutine mpiControlCTOR(this) 72 | type(mpiControl), intent(out) :: this 73 | integer :: ierr 74 | 75 | !set number of procs 76 | call MPI_COMM_SIZE(MPI_COMM_WORLD, this%nProcs_, ierr) 77 | 78 | !read meshpfile 79 | call readMeshpfile(this) 80 | 81 | !read decomposepfile 82 | call readDecomposepfile(this) 83 | 84 | !create cartesian communicator 85 | call MPI_CART_CREATE(MPI_COMM_WORLD, & 86 | 3, & 87 | this%nProcsAxis_, & 88 | this%wrapAround_, & 89 | 1, & 90 | this%cartComm_, & 91 | ierr) 92 | 93 | !set proc rank 94 | call MPI_COMM_RANK(this%cartComm_, this%rank_, ierr) 95 | 96 | !set proc coordinates 97 | call MPI_CART_COORDS(this%cartComm_, this%rank_, 3, this%procCoord_, ierr) 98 | 99 | !set proc neighbours 100 | call setNeighboursProc(this) 101 | 102 | !set global cart coordinates to All procs 103 | call setGlobalCoord(this) 104 | 105 | #ifdef FAST_MODE 106 | call checkPeriodicDirFFT(this) 107 | call checkPencilDecomp(this) 108 | #endif 109 | 110 | 111 | 112 | end subroutine 113 | !========================================================================================! 114 | 115 | 116 | !========================================================================================! 117 | subroutine readDecomposepfile(this) 118 | type(mpiControl), intent(inout) :: this 119 | type(parFile) :: pfile 120 | 121 | call parFileCTOR(pfile,'decompose','specs') 122 | 123 | !set number of procs per axis 124 | if (IS_PAR) then 125 | call readParameter(pfile,this%nProcsAxis_(1),'px') 126 | call readParameter(pfile,this%nProcsAxis_(2),'py') 127 | call readParameter(pfile,this%nProcsAxis_(3),'pz') 128 | else 129 | this%nProcsAxis_(1) = 1 130 | this%nProcsAxis_(2) = 1 131 | this%nProcsAxis_(3) = 1 132 | end if 133 | 134 | if ( (this%nProcs_ /= this%nProcsAxis_(1)*this%nProcsAxis_(2)*this%nProcsAxis_(3)) & 135 | .AND. (IS_PAR)) then 136 | call mpiABORT('Number of read in procs not equal to MPI_SIZE') 137 | end if 138 | 139 | !check even division mesh size - number of procs 140 | if ( mod(this%nx_,this%nProcsAxis_(1)) /= 0) then 141 | call mpiABORT('Number of procs in x direction does not divide evenly nx') 142 | end if 143 | if ( mod(this%ny_,this%nProcsAxis_(2)) /= 0) then 144 | call mpiABORT('Number of procs in y direction does not divide evenly ny') 145 | end if 146 | if ( mod(this%nz_,this%nProcsAxis_(3)) /= 0) then 147 | call mpiABORT('Number of procs in z direction does not divide evenly nz') 148 | end if 149 | 150 | !set wrap around option 151 | call readParameter(pfile,this%wrapAround_(1),'wrap_x') 152 | call readParameter(pfile,this%wrapAround_(2),'wrap_y') 153 | call readParameter(pfile,this%wrapAround_(3),'wrap_z') 154 | 155 | end subroutine 156 | !========================================================================================! 157 | 158 | !========================================================================================! 159 | subroutine readMeshpfile(this) 160 | type(mpiControl), intent(inout) :: this 161 | type(parFile) :: pfile 162 | 163 | call parFileCTOR(pfile,'mesh','specs') 164 | 165 | call readParameter(pfile,this%nx_,'nx') 166 | call readParameter(pfile,this%ny_,'ny') 167 | call readParameter(pfile,this%nz_,'nz') 168 | 169 | 170 | end subroutine 171 | !========================================================================================! 172 | 173 | !========================================================================================! 174 | subroutine setNeighboursProc(this) 175 | type(mpiControl), intent(inout) :: this 176 | integer :: ierror 177 | 178 | !along x 179 | call MPI_CART_SHIFT(this%cartComm_, 0, 1, this%leftNe_, this%rightNe_, ierror) 180 | 181 | !along y 182 | call MPI_CART_SHIFT(this%cartComm_, 1, 1, this%bottomNe_, this%topNe_, ierror) 183 | 184 | !along z 185 | call MPI_CART_SHIFT(this%cartComm_, 2, 1, this%backNe_, this%frontNe_, ierror) 186 | 187 | 188 | end subroutine 189 | !========================================================================================! 190 | 191 | !========================================================================================! 192 | subroutine setGlobalCoord(this) 193 | type(mpiControl), intent(inout) :: this 194 | integer :: ierror 195 | 196 | !gather global proc coords 197 | call allocateArray(this%gCoords_,1,3,0,this%nProcs_-1) 198 | 199 | call MPI_ALLGather(this%procCoord_,3,MPI_INTEGER,this%gCoords_,3,MPI_INTEGER,this%cartComm_,ierror) 200 | 201 | end subroutine 202 | !========================================================================================! 203 | 204 | #ifdef FAST_MODE 205 | !========================================================================================! 206 | subroutine checkPeriodicDirFFT(this) 207 | type(mpiControl), intent(in) :: this 208 | 209 | if (.NOT.(this%wrapAround_(1))) then 210 | call mpiAbort('Direction x is not periodic') 211 | end if 212 | 213 | if (.NOT.(this%wrapAround_(3))) then 214 | call mpiAbort('Direction z is not periodic') 215 | end if 216 | 217 | end subroutine 218 | !========================================================================================! 219 | 220 | !========================================================================================! 221 | subroutine checkPencilDecomp(this) 222 | type(mpiControl), intent(in) :: this 223 | 224 | if (this%nProcsAxis_(2)>1) then 225 | call mpiAbort('n procs along pencil > 1') 226 | end if 227 | 228 | end subroutine 229 | !========================================================================================! 230 | #endif 231 | 232 | end module mpiControlMod 233 | 234 | 235 | -------------------------------------------------------------------------------- /src/multiGrid/multiGrid.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module multiGridMod 20 | 21 | use rbgsMod 22 | use poissMatMod 23 | 24 | implicit none 25 | 26 | 27 | type, public :: multiGrid 28 | 29 | type(parFile), private :: pfile_ 30 | 31 | integer :: nLevels_ 32 | integer, private :: nPreSweep_ 33 | integer, private :: nPostSweep_ 34 | 35 | real(DP), private :: tol_ 36 | integer :: iter_ 37 | integer, private :: maxIter_ 38 | 39 | !keep a pointer to grid 40 | type(grid), pointer, private :: ptrMesh_ => NULL() 41 | 42 | type(rbgs) :: smoother_ 43 | type(poissMat), private :: directS_ 44 | 45 | logical, private :: fullInfo_ 46 | 47 | end type 48 | 49 | private :: checkLevelsNumber 50 | private :: initDirectSolver 51 | private :: mgVcycle 52 | private :: continueIterating 53 | 54 | public :: multiGridCTOR 55 | public :: solveMG 56 | public :: residualMG 57 | 58 | 59 | contains 60 | 61 | !========================================================================================! 62 | elemental function residualMG(this) result(r) 63 | class(multiGrid), intent(in) :: this 64 | real(DP) :: r 65 | 66 | r = this%smoother_%res_ 67 | 68 | end function 69 | !========================================================================================! 70 | 71 | !========================================================================================! 72 | subroutine multiGridCTOR(this,mesh,p,beta,s) 73 | type(multiGrid) :: this 74 | type(field), intent(inout) :: p, beta, s 75 | type(grid), target :: mesh 76 | 77 | this%ptrMesh_ => mesh 78 | 79 | call parFileCTOR(this%pfile_,'pcg_solver','specs') 80 | 81 | call readParameter(this%pfile_,this%nLevels_,'nLevels') 82 | call readParameter(this%pfile_,this%nPreSweep_,'nPreSweep') 83 | call readParameter(this%pfile_,this%nPostSweep_,'nPostSweep') 84 | call readParameter(this%pfile_,this%tol_,'tolMG') 85 | call readParameter(this%pfile_,this%maxIter_,'maxIterMG') 86 | call readParameter(this%pfile_,this%fullInfo_,'fullInfoMG') 87 | 88 | call checkLevelsNumber(this) 89 | 90 | !init smoother 91 | call rbgsCTOR(this%smoother_,mesh,p) 92 | 93 | !init coarse meshes and fields 94 | call coarsenGrids(mesh,this%nLevels_) 95 | call coarsenFields(p,this%nLevels_) 96 | call coarsenFields(beta,this%nLevels_) 97 | call coarsenFields(s,this%nLevels_) 98 | 99 | !set mg levels 100 | call setMgLevels(this%ptrMesh_,this%nLevels_) 101 | 102 | !init coarse Gauss-Seidel solvers 103 | call coarsenRbgsSolvers(this%smoother_,mesh,p,this%nLevels_) 104 | 105 | !init direct solver for coarsest level 106 | call initDirectSolver(this,mesh,p) 107 | 108 | !homogeneous b.c. for error fields 109 | call resetBCerrorField(p) 110 | 111 | 112 | end subroutine 113 | !========================================================================================! 114 | 115 | !========================================================================================! 116 | subroutine checkLevelsNumber(this) 117 | type(multiGrid), intent(inout) :: this 118 | integer :: r, i 119 | 120 | !check direction-wise 121 | !x 122 | do i=1,this%nLevels_-1 123 | r = mod(this%ptrMesh_%nx_,2**i) 124 | if (r /= 0) then 125 | call mpiABORT('Attempt to initialize a MG grid with a non-integer number of cells along x') 126 | end if 127 | end do 128 | 129 | !y 130 | do i=1,this%nLevels_-1 131 | r = mod(this%ptrMesh_%ny_,2**i) 132 | if (r /= 0) then 133 | call mpiABORT('Attempt to initialize a MG grid with a non-integer number of cells along y') 134 | end if 135 | end do 136 | 137 | !z 138 | do i=1,this%nLevels_-1 139 | r = mod(this%ptrMesh_%nz_,2**i) 140 | if (r /= 0) then 141 | call mpiABORT('Attempt to initialize a MG grid with a non-integer number of cells along z') 142 | end if 143 | end do 144 | 145 | end subroutine 146 | !========================================================================================! 147 | 148 | !========================================================================================! 149 | recursive subroutine initDirectSolver(this,mesh,p) 150 | type(multiGrid), intent(inout) :: this 151 | type(grid), intent(in) :: mesh 152 | type(field), intent(in) :: p 153 | 154 | if ( mesh%level_ == 1) then 155 | call poissMatCTOR(this%directS_,mesh,p) 156 | else 157 | call initDirectSolver(this,mesh%ptrGrid_,p%ptrf_) 158 | end if 159 | 160 | end subroutine 161 | !========================================================================================! 162 | 163 | 164 | !========================================================================================! 165 | subroutine solveMG(this,mesh,p,beta,s) 166 | type(multiGrid), intent(inout) :: this 167 | type(grid), intent(in) :: mesh 168 | type(field), intent(inout) :: p 169 | type(field), intent(inout) :: beta, s 170 | 171 | this%iter_ = 0 172 | 173 | !compute initial residual 174 | call computeResiduals(this%smoother_,p,beta,s) 175 | 176 | do while(continueIterating(this)) 177 | 178 | call mgVcycle(this,mesh,p,beta,s,this%smoother_) 179 | 180 | end do 181 | 182 | end subroutine 183 | !========================================================================================! 184 | 185 | !========================================================================================! 186 | recursive subroutine mgVcycle(this,mesh,p,beta,s,smoother) 187 | type(multiGrid), intent(inout) :: this 188 | type(grid), intent(in) :: mesh 189 | type(field), intent(inout) :: p 190 | type(field), intent(inout) :: beta, s 191 | type(rbgs), intent(inout) :: smoother 192 | 193 | 194 | if (mesh%level_ == 1) then 195 | !direct solver for coarsest level 196 | call solveMat(this%directS_,p,beta,s) 197 | else 198 | 199 | !pre-smoothing 200 | if (mesh%level_ == this%nLevels_) then 201 | call solveRBGS(smoother,p,beta,s,this%nPreSweep_,isToBeReset=.FALSE.) 202 | else 203 | call solveRBGS(smoother,p,beta,s,this%nPreSweep_,isToBeReset=.TRUE.) 204 | end if 205 | 206 | 207 | !residual restriction 208 | call restrictField(s,smoother%resV_) 209 | !beta field restriction 210 | call restrictField(beta) 211 | 212 | 213 | !recursive call to coarser level 214 | call mgVcycle(this,mesh%ptrGrid_, & 215 | p%ptrf_, & 216 | beta%ptrf_, & 217 | s%ptrf_, & 218 | smoother%ptrRbgs_) 219 | 220 | 221 | !coarse grid correction 222 | call prolongateField(p,p%prol_) 223 | call unarySum_omp(p%f_,p%prol_,1,p%nx_,1,p%ny_,1,p%nz_) 224 | call updateBoundaries(p) 225 | 226 | !post smoothing 227 | call solveRBGS(smoother,p,beta,s,this%nPostSweep_,isToBeReset=.FALSE.) 228 | 229 | end if 230 | 231 | 232 | end subroutine 233 | !========================================================================================! 234 | 235 | 236 | !========================================================================================! 237 | function continueIterating(this) RESULT(isVar) 238 | type(multiGrid), intent(inout) :: this 239 | logical :: isVar 240 | 241 | 242 | !check max iteration limit 243 | if (this%iter_ == this%maxIter_) then 244 | if (IS_MASTER) then 245 | write(*,*) '!*************** WARNING *****************' 246 | write(*,*) 'EXIT multiGrid iterations: max iter reached' 247 | end if 248 | isVar = .FALSE. 249 | return 250 | end if 251 | 252 | !check tolerance 253 | if (this%smoother_%res_ > this%tol_) then 254 | 255 | if (IS_MASTER) then 256 | if (this%fullInfo_) then 257 | write(*,*) 'multiGrid solver: iteration ', this%iter_, ' residual = ', & 258 | this%smoother_%res_ 259 | end if 260 | end if 261 | isVar = .TRUE. 262 | 263 | else 264 | 265 | if (IS_MASTER) then 266 | if (this%fullInfo_) then 267 | write(*,*) 'Criterion met at iteration: ', this%iter_, ' residual = ', & 268 | this%smoother_%res_ 269 | end if 270 | end if 271 | 272 | isVar = .FALSE. 273 | 274 | end if 275 | 276 | this%iter_ = this%iter_ + 1 277 | 278 | 279 | end function 280 | !========================================================================================! 281 | 282 | 283 | 284 | 285 | 286 | end module multiGridMod 287 | 288 | -------------------------------------------------------------------------------- /src/ompRoutines/ompRoutines.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module ompRoutinesMod 20 | 21 | use kindsMod 22 | 23 | implicit none 24 | 25 | interface assign_omp 26 | module PROCEDURE assign_whole_omp 27 | module PROCEDURE assign_section_omp 28 | end interface 29 | 30 | interface reduceSum_omp 31 | module PROCEDURE reduceSum_whole_omp 32 | module PROCEDURE reduceSum_section_omp 33 | end interface 34 | 35 | interface reduceMax_omp 36 | module PROCEDURE reduceMax_whole_omp 37 | module PROCEDURE reduceMax_whole_int_omp 38 | module PROCEDURE reduceMax_section_omp 39 | end interface 40 | 41 | interface reduceMin_omp 42 | module PROCEDURE reduceMin_whole_omp 43 | module PROCEDURE reduceMin_section_omp 44 | end interface 45 | 46 | interface reduceSqrSum_omp 47 | module PROCEDURE reduceSqrSum_whole_omp 48 | module PROCEDURE reduceSqrSum_section_omp 49 | end interface 50 | 51 | interface unarySum_omp 52 | module PROCEDURE unarySum_whole_omp 53 | module PROCEDURE unarySum_section_omp 54 | end interface 55 | 56 | contains 57 | 58 | !========================================================================================! 59 | subroutine assign_whole_omp(va,vb) 60 | real(DP), allocatable, dimension(:,:,:), intent(inout) :: va 61 | real(DP), allocatable, dimension(:,:,:), intent(in) :: vb 62 | integer :: is,ie,js,je,ks,ke 63 | integer :: i,j,k 64 | 65 | is = lbound(va,1) 66 | ie = ubound(va,1) 67 | js = lbound(va,2) 68 | je = ubound(va,2) 69 | ks = lbound(va,3) 70 | ke = ubound(va,3) 71 | 72 | !$OMP PARALLEL DO DEFAULT(none) & 73 | !$OMP SHARED(va,vb) & 74 | !$OMP SHARED(is,ie,js,je,ks,ke) & 75 | !$OMP PRIVATE(i,j,k) 76 | do k=ks,ke 77 | do j=js,je 78 | do i=is,ie 79 | va(i,j,k)=vb(i,j,k) 80 | end do 81 | end do 82 | end do 83 | !$OMP END PARALLEL DO 84 | 85 | end subroutine 86 | !========================================================================================! 87 | 88 | !========================================================================================! 89 | subroutine assign_section_omp(va,vb,is,ie,js,je,ks,ke) 90 | real(DP), allocatable, dimension(:,:,:), intent(inout) :: va 91 | real(DP), allocatable, dimension(:,:,:), intent(in) :: vb 92 | integer, intent(in) :: is,ie,js,je,ks,ke 93 | integer :: i,j,k 94 | 95 | !$OMP PARALLEL DO DEFAULT(none) & 96 | !$OMP SHARED(va,vb) & 97 | !$OMP SHARED(is,ie,js,je,ks,ke) & 98 | !$OMP PRIVATE(i,j,k) 99 | do k=ks,ke 100 | do j=js,je 101 | do i=is,ie 102 | va(i,j,k)=vb(i,j,k) 103 | end do 104 | end do 105 | end do 106 | !$OMP END PARALLEL DO 107 | 108 | end subroutine 109 | !========================================================================================! 110 | 111 | !========================================================================================! 112 | subroutine set2zero_omp(v) 113 | real(DP), allocatable, dimension(:,:,:), intent(inout) :: v 114 | integer :: is,ie,js,je,ks,ke 115 | integer :: i,j,k 116 | 117 | is = lbound(v,1) 118 | ie = ubound(v,1) 119 | js = lbound(v,2) 120 | je = ubound(v,2) 121 | ks = lbound(v,3) 122 | ke = ubound(v,3) 123 | 124 | !$OMP PARALLEL DO DEFAULT(none) & 125 | !$OMP SHARED(v) & 126 | !$OMP SHARED(is,ie,js,je,ks,ke) & 127 | !$OMP PRIVATE(i,j,k) 128 | do k=ks,ke 129 | do j=js,je 130 | do i=is,ie 131 | v(i,j,k)=0.d0 132 | end do 133 | end do 134 | end do 135 | !$OMP END PARALLEL DO 136 | 137 | end subroutine 138 | !========================================================================================! 139 | 140 | !========================================================================================! 141 | subroutine resetLogicalField_omp(v,bool) 142 | logical, allocatable, dimension(:,:,:), intent(inout) :: v 143 | logical, intent(in) :: bool 144 | integer :: is,ie,js,je,ks,ke 145 | integer :: i,j,k 146 | 147 | is = lbound(v,1) 148 | ie = ubound(v,1) 149 | js = lbound(v,2) 150 | je = ubound(v,2) 151 | ks = lbound(v,3) 152 | ke = ubound(v,3) 153 | 154 | !$OMP PARALLEL DO DEFAULT(none) & 155 | !$OMP SHARED(v,bool) & 156 | !$OMP SHARED(is,ie,js,je,ks,ke) & 157 | !$OMP PRIVATE(i,j,k) 158 | do k=ks,ke 159 | do j=js,je 160 | do i=is,ie 161 | v(i,j,k)=bool 162 | end do 163 | end do 164 | end do 165 | !$OMP END PARALLEL DO 166 | 167 | end subroutine 168 | !========================================================================================! 169 | 170 | !========================================================================================! 171 | subroutine reduceSum_whole_omp(v,r) 172 | real(DP), allocatable, dimension(:,:,:), intent(in) :: v 173 | real(DP), intent(out) :: r 174 | integer :: is,ie,js,je,ks,ke 175 | integer :: i,j,k 176 | 177 | is = lbound(v,1) 178 | ie = ubound(v,1) 179 | js = lbound(v,2) 180 | je = ubound(v,2) 181 | ks = lbound(v,3) 182 | ke = ubound(v,3) 183 | 184 | r = 0.d0 185 | 186 | !$OMP PARALLEL DO DEFAULT(none) & 187 | !$OMP SHARED(v) & 188 | !$OMP SHARED(is,ie,js,je,ks,ke) & 189 | !$OMP PRIVATE(i,j,k) & 190 | !$OMP REDUCTION(+:r) 191 | do k=ks,ke 192 | do j=js,je 193 | do i=is,ie 194 | r = r + v(i,j,k) 195 | end do 196 | end do 197 | end do 198 | !$OMP END PARALLEL DO 199 | 200 | end subroutine 201 | !========================================================================================! 202 | 203 | !========================================================================================! 204 | subroutine reduceSum_section_omp(v,is,ie,js,je,ks,ke,r) 205 | real(DP), allocatable, dimension(:,:,:), intent(in) :: v 206 | real(DP), intent(out) :: r 207 | integer, intent(in) :: is,ie,js,je,ks,ke 208 | integer :: i,j,k 209 | 210 | r = 0.d0 211 | 212 | !$OMP PARALLEL DO DEFAULT(none) & 213 | !$OMP SHARED(v) & 214 | !$OMP SHARED(is,ie,js,je,ks,ke) & 215 | !$OMP PRIVATE(i,j,k) & 216 | !$OMP REDUCTION(+:r) 217 | do k=ks,ke 218 | do j=js,je 219 | do i=is,ie 220 | r = r + v(i,j,k) 221 | end do 222 | end do 223 | end do 224 | !$OMP END PARALLEL DO 225 | 226 | end subroutine 227 | !========================================================================================! 228 | 229 | !========================================================================================! 230 | subroutine reduceMax_whole_omp(v,r) 231 | real(DP), allocatable, dimension(:,:,:), intent(in) :: v 232 | real(DP), intent(out) :: r 233 | integer :: is,ie,js,je,ks,ke 234 | integer :: i,j,k 235 | 236 | is = lbound(v,1) 237 | ie = ubound(v,1) 238 | js = lbound(v,2) 239 | je = ubound(v,2) 240 | ks = lbound(v,3) 241 | ke = ubound(v,3) 242 | 243 | r = v(is,js,ks) 244 | 245 | !$OMP PARALLEL DO DEFAULT(none) & 246 | !$OMP SHARED(v) & 247 | !$OMP SHARED(is,ie,js,je,ks,ke) & 248 | !$OMP PRIVATE(i,j,k) & 249 | !$OMP REDUCTION(max:r) 250 | do k=ks,ke 251 | do j=js,je 252 | do i=is,ie 253 | r = max(v(i,j,k),r) 254 | end do 255 | end do 256 | end do 257 | !$OMP END PARALLEL DO 258 | 259 | end subroutine 260 | !========================================================================================! 261 | 262 | !========================================================================================! 263 | subroutine reduceMax_whole_int_omp(v,r) 264 | integer, allocatable, dimension(:,:,:), intent(in) :: v 265 | integer, intent(out) :: r 266 | integer :: is,ie,js,je,ks,ke 267 | integer :: i,j,k 268 | 269 | is = lbound(v,1) 270 | ie = ubound(v,1) 271 | js = lbound(v,2) 272 | je = ubound(v,2) 273 | ks = lbound(v,3) 274 | ke = ubound(v,3) 275 | 276 | r = v(is,js,ks) 277 | 278 | !$OMP PARALLEL DO DEFAULT(none) & 279 | !$OMP SHARED(v) & 280 | !$OMP SHARED(is,ie,js,je,ks,ke) & 281 | !$OMP PRIVATE(i,j,k) & 282 | !$OMP REDUCTION(max:r) 283 | do k=ks,ke 284 | do j=js,je 285 | do i=is,ie 286 | r = max(v(i,j,k),r) 287 | end do 288 | end do 289 | end do 290 | !$OMP END PARALLEL DO 291 | 292 | end subroutine 293 | !========================================================================================! 294 | 295 | !========================================================================================! 296 | subroutine reduceMax_section_omp(v,is,ie,js,je,ks,ke,r) 297 | real(DP), allocatable, dimension(:,:,:), intent(in) :: v 298 | real(DP), intent(out) :: r 299 | integer, intent(in) :: is,ie,js,je,ks,ke 300 | integer :: i,j,k 301 | 302 | r = v(is,js,ks) 303 | 304 | !$OMP PARALLEL DO DEFAULT(none) & 305 | !$OMP SHARED(v) & 306 | !$OMP SHARED(is,ie,js,je,ks,ke) & 307 | !$OMP PRIVATE(i,j,k) & 308 | !$OMP REDUCTION(max:r) 309 | do k=ks,ke 310 | do j=js,je 311 | do i=is,ie 312 | r = max(v(i,j,k),r) 313 | end do 314 | end do 315 | end do 316 | !$OMP END PARALLEL DO 317 | 318 | end subroutine 319 | !========================================================================================! 320 | 321 | !========================================================================================! 322 | subroutine reduceMin_whole_omp(v,r) 323 | real(DP), allocatable, dimension(:,:,:), intent(in) :: v 324 | real(DP), intent(out) :: r 325 | integer :: is,ie,js,je,ks,ke 326 | integer :: i,j,k 327 | 328 | is = lbound(v,1) 329 | ie = ubound(v,1) 330 | js = lbound(v,2) 331 | je = ubound(v,2) 332 | ks = lbound(v,3) 333 | ke = ubound(v,3) 334 | 335 | r = v(is,js,ks) 336 | 337 | !$OMP PARALLEL DO DEFAULT(none) & 338 | !$OMP SHARED(v) & 339 | !$OMP SHARED(is,ie,js,je,ks,ke) & 340 | !$OMP PRIVATE(i,j,k) & 341 | !$OMP REDUCTION(min:r) 342 | do k=ks,ke 343 | do j=js,je 344 | do i=is,ie 345 | r = min(v(i,j,k),r) 346 | end do 347 | end do 348 | end do 349 | !$OMP END PARALLEL DO 350 | 351 | end subroutine 352 | !========================================================================================! 353 | 354 | !========================================================================================! 355 | subroutine reduceMin_section_omp(v,is,ie,js,je,ks,ke,r) 356 | real(DP), allocatable, dimension(:,:,:), intent(in) :: v 357 | real(DP), intent(out) :: r 358 | integer, intent(in) :: is,ie,js,je,ks,ke 359 | integer :: i,j,k 360 | 361 | r = v(is,js,ks) 362 | 363 | !$OMP PARALLEL DO DEFAULT(none) & 364 | !$OMP SHARED(v) & 365 | !$OMP SHARED(is,ie,js,je,ks,ke) & 366 | !$OMP PRIVATE(i,j,k) & 367 | !$OMP REDUCTION(min:r) 368 | do k=ks,ke 369 | do j=js,je 370 | do i=is,ie 371 | r = min(v(i,j,k),r) 372 | end do 373 | end do 374 | end do 375 | !$OMP END PARALLEL DO 376 | 377 | end subroutine 378 | !========================================================================================! 379 | 380 | !========================================================================================! 381 | subroutine reduceSqrSum_whole_omp(v,r) 382 | real(DP), allocatable, dimension(:,:,:), intent(in) :: v 383 | real(DP), intent(out) :: r 384 | integer :: is,ie,js,je,ks,ke 385 | integer :: i,j,k 386 | 387 | is = lbound(v,1) 388 | ie = ubound(v,1) 389 | js = lbound(v,2) 390 | je = ubound(v,2) 391 | ks = lbound(v,3) 392 | ke = ubound(v,3) 393 | 394 | r = 0.d0 395 | 396 | !$OMP PARALLEL DO DEFAULT(none) & 397 | !$OMP SHARED(v) & 398 | !$OMP SHARED(is,ie,js,je,ks,ke) & 399 | !$OMP PRIVATE(i,j,k) & 400 | !$OMP REDUCTION(+:r) 401 | do k=ks,ke 402 | do j=js,je 403 | do i=is,ie 404 | r = r + v(i,j,k)*v(i,j,k) 405 | end do 406 | end do 407 | end do 408 | !$OMP END PARALLEL DO 409 | 410 | end subroutine 411 | !========================================================================================! 412 | 413 | !========================================================================================! 414 | subroutine reduceSqrSum_section_omp(v,is,ie,js,je,ks,ke,r) 415 | real(DP), allocatable, dimension(:,:,:), intent(in) :: v 416 | real(DP), intent(out) :: r 417 | integer, intent(in) :: is,ie,js,je,ks,ke 418 | integer :: i,j,k 419 | 420 | r = 0.d0 421 | 422 | !$OMP PARALLEL DO DEFAULT(none) & 423 | !$OMP SHARED(v) & 424 | !$OMP SHARED(is,ie,js,je,ks,ke) & 425 | !$OMP PRIVATE(i,j,k) & 426 | !$OMP REDUCTION(+:r) 427 | do k=ks,ke 428 | do j=js,je 429 | do i=is,ie 430 | r = r + v(i,j,k)*v(i,j,k) 431 | end do 432 | end do 433 | end do 434 | !$OMP END PARALLEL DO 435 | 436 | end subroutine 437 | !========================================================================================! 438 | 439 | !========================================================================================! 440 | subroutine unarySum_whole_omp(va,vb) 441 | real(DP), allocatable, dimension(:,:,:), intent(inout) :: va 442 | real(DP), allocatable, dimension(:,:,:), intent(in) :: vb 443 | integer :: is,ie,js,je,ks,ke 444 | integer :: i,j,k 445 | 446 | is = lbound(va,1) 447 | ie = ubound(va,1) 448 | js = lbound(va,2) 449 | je = ubound(va,2) 450 | ks = lbound(va,3) 451 | ke = ubound(va,3) 452 | 453 | !$OMP PARALLEL DO DEFAULT(none) & 454 | !$OMP SHARED(va,vb) & 455 | !$OMP SHARED(is,ie,js,je,ks,ke) & 456 | !$OMP PRIVATE(i,j,k) 457 | do k=ks,ke 458 | do j=js,je 459 | do i=is,ie 460 | va(i,j,k) = va(i,j,k)+vb(i,j,k) 461 | end do 462 | end do 463 | end do 464 | !$OMP END PARALLEL DO 465 | 466 | end subroutine 467 | !========================================================================================! 468 | 469 | !========================================================================================! 470 | subroutine unarySum_section_omp(va,vb,is,ie,js,je,ks,ke) 471 | real(DP), allocatable, dimension(:,:,:), intent(inout) :: va 472 | real(DP), allocatable, dimension(:,:,:), intent(in) :: vb 473 | integer, intent(in) :: is,ie,js,je,ks,ke 474 | integer :: i,j,k 475 | 476 | !$OMP PARALLEL DO DEFAULT(none) & 477 | !$OMP SHARED(va,vb) & 478 | !$OMP SHARED(is,ie,js,je,ks,ke) & 479 | !$OMP PRIVATE(i,j,k) 480 | do k=ks,ke 481 | do j=js,je 482 | do i=is,ie 483 | va(i,j,k) = va(i,j,k)+vb(i,j,k) 484 | end do 485 | end do 486 | end do 487 | !$OMP END PARALLEL DO 488 | 489 | end subroutine 490 | !========================================================================================! 491 | 492 | end module ompRoutinesMod 493 | 494 | 495 | 496 | 497 | 498 | 499 | -------------------------------------------------------------------------------- /src/pcg/pcg.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module pcgMod 20 | 21 | use multiGridMod 22 | 23 | implicit none 24 | 25 | 26 | type, public :: pcg 27 | 28 | type(field), private :: d_,r_ 29 | real(DP), allocatable, dimension(:,:,:) :: qV_,d0_ 30 | !store metrics 31 | real(DP), private, allocatable, dimension(:,:) :: invx_, invy_, invz_ 32 | 33 | type(multiGrid), private :: mgs_ 34 | 35 | real(DP), private :: tol_ 36 | real(DP) :: res_ 37 | integer :: iter_ 38 | integer, private :: maxIter_ 39 | logical, private :: fullInfo_ 40 | logical, private :: isSystemSingular_ 41 | 42 | 43 | end type 44 | 45 | private :: computeQv 46 | private :: computeAlpha 47 | private :: updatePsi 48 | private :: updateDir 49 | private :: updateDeltaN 50 | private :: updateResidual 51 | private :: continueIterating 52 | private :: scalarResidual 53 | private :: storeMetrics 54 | 55 | public :: pcgCTOR 56 | public :: solvePCG 57 | 58 | contains 59 | 60 | 61 | !========================================================================================! 62 | subroutine pcgCTOR(this,mesh,psi,beta) 63 | type(pcg) :: this 64 | type(grid), intent(in) :: mesh 65 | type(field), intent(inout) :: psi,beta 66 | type(parFile) :: pfile 67 | integer :: nx,ny,nz 68 | 69 | nx = mesh%nx_ 70 | ny = mesh%ny_ 71 | nz = mesh%nz_ 72 | 73 | !init field 74 | call fieldCTOR(this%d_,'d',mesh,'cl',psi%hd_,initOpt=-1) 75 | call copyBoundary(this%d_,psi) 76 | call resetBCerrorField(this%d_) 77 | call fieldCTOR(this%r_,'r',mesh,'cl',psi%hd_,initOpt=-1) 78 | call copyBoundary(this%r_,psi) 79 | call resetBCerrorField(this%r_) 80 | 81 | !read form pfile 82 | call parFileCTOR(pfile,'pcg_solver','specs') 83 | call readParameter(pfile,this%tol_,'tolPCG') 84 | call readParameter(pfile,this%maxIter_,'maxIterPCG') 85 | call readParameter(pfile,this%fullInfo_,'fullInfoPCG') 86 | 87 | !allocate auxiliary vectors 88 | call allocateArray(this%qV_,1,nx,1,ny,1,nz) 89 | !allocate auxiliary vectors 90 | call allocateArray(this%d0_,1,nx,1,ny,1,nz) 91 | 92 | !build multigrid 93 | call multiGridCTOR(this%mgs_,mesh,this%d_,beta,this%r_) 94 | 95 | this%isSystemSingular_ = this%mgs_%smoother_%isSystemSingular_ 96 | 97 | call storeMetrics(this,mesh) 98 | 99 | end subroutine 100 | !========================================================================================! 101 | 102 | !========================================================================================! 103 | subroutine solvePCG(this,mesh,psi,beta,q) 104 | type(pcg), intent(inout) :: this 105 | type(grid), intent(in) :: mesh 106 | type(field), intent(inout) :: psi,beta,q 107 | real(DP) :: alpha, deltaN, delta0, gamma 108 | integer :: nx,ny,nz 109 | 110 | nx = mesh%nx_ 111 | ny = mesh%ny_ 112 | nz = mesh%nz_ 113 | 114 | this%iter_ = 0 115 | 116 | call computeResiduals(this%mgs_%smoother_,psi,beta,q) 117 | call assign_omp(this%r_%f_,this%mgs_%smoother_%resV_,1,nx,1,ny,1,nz) 118 | call set2zero_omp(this%d_%f_) 119 | call solveMG(this%mgs_,mesh,this%d_,beta,this%r_) 120 | call updateDeltaN(this%r_,this%d_,deltaN) 121 | 122 | do while(continueIterating(this,q)) 123 | call computeQv(this,beta,this%d_) 124 | call computeAlpha(this%d_,this%qv_,deltaN,alpha) 125 | call updatePsi(psi,this%d_,alpha,this%isSystemSingular_) 126 | call updateResidual(this%r_,this%qv_,alpha) 127 | call assign_omp(this%d0_,this%d_%f_,1,nx,1,ny,1,nz) 128 | call set2zero_omp(this%d_%f_) 129 | call solveMG(this%mgs_,mesh,this%d_,beta,this%r_) 130 | delta0 = deltaN 131 | call updateDeltaN(this%r_,this%d_,deltaN) 132 | gamma = deltaN/delta0 133 | call updateDir(this%d0_,this%d_,gamma) 134 | call assign_omp(this%d_%f_,this%d0_,1,nx,1,ny,1,nz) 135 | call updateBoundaries(this%d_) 136 | end do 137 | 138 | call updateBoundaries(psi) 139 | 140 | end subroutine 141 | !========================================================================================! 142 | 143 | !========================================================================================! 144 | subroutine computeQv(this,beta,d) 145 | type(pcg), intent(inout) :: this 146 | type(field), intent(in) :: beta,d 147 | integer :: i,j,k,nx,ny,nz 148 | real(DP) :: aR,aL,aT,aBo,aF,aBa 149 | 150 | nx = d%nx_ 151 | ny = d%ny_ 152 | nz = d%nz_ 153 | 154 | !$OMP PARALLEL DO DEFAULT(none) & 155 | !$OMP SHARED(this,beta,d) & 156 | !$OMP SHARED(nx,ny,nz) & 157 | !$OMP PRIVATE(i,j,k) & 158 | !$OMP PRIVATE(aR,aL,aT,aBo,aF,aBa) 159 | do k=1,nz 160 | do j=1,ny 161 | do i=1,nx 162 | 163 | aR = 0.5d0*(beta%f_(i+1,j,k)+beta%f_(i,j,k))*this%invx_(1,i) 164 | aL = 0.5d0*(beta%f_(i,j,k)+beta%f_(i-1,j,k))*this%invx_(2,i) 165 | aT = 0.5d0*(beta%f_(i,j+1,k)+beta%f_(i,j,k))*this%invy_(1,j) 166 | aBo = 0.5d0*(beta%f_(i,j,k)+beta%f_(i,j-1,k))*this%invy_(2,j) 167 | aF = 0.5d0*(beta%f_(i,j,k+1)+beta%f_(i,j,k))*this%invz_(1,k) 168 | aBa = 0.5d0*(beta%f_(i,j,k)+beta%f_(i,j,k-1))*this%invz_(2,k) 169 | 170 | 171 | this%qv_(i,j,k) = aR*(d%f_(i+1,j,k)-d%f_(i,j,k)) & 172 | - aL*(d%f_(i,j,k)-d%f_(i-1,j,k)) & 173 | + aT*(d%f_(i,j+1,k)-d%f_(i,j,k)) & 174 | - aBo*(d%f_(i,j,k)-d%f_(i,j-1,k)) & 175 | + aF*(d%f_(i,j,k+1)-d%f_(i,j,k)) & 176 | - aBa*(d%f_(i,j,k)-d%f_(i,j,k-1)) 177 | end do 178 | end do 179 | end do 180 | !$OMP END PARALLEL DO 181 | 182 | 183 | end subroutine 184 | !========================================================================================! 185 | 186 | !========================================================================================! 187 | subroutine computeAlpha(d,qv,deltaN,alpha) 188 | type(field), intent(in) :: d 189 | real(DP), allocatable, dimension(:,:,:), intent(in) :: qv 190 | real(DP), intent(in) :: deltaN 191 | real(DP), intent(out) :: alpha 192 | integer :: nx,ny,nz 193 | real(DP) :: denoml,denomg 194 | integer :: ierror, comm 195 | integer :: i,j,k 196 | 197 | nx = d%nx_ 198 | ny = d%ny_ 199 | nz = d%nz_ 200 | 201 | denoml = 0.d0 202 | 203 | !$OMP PARALLEL DO DEFAULT(none) & 204 | !$OMP SHARED(d,qv) & 205 | !$OMP SHARED(nx,ny,nz) & 206 | !$OMP PRIVATE(i,j,k) & 207 | !$OMP REDUCTION(+:denoml) 208 | do k=1,nz 209 | do j=1,ny 210 | do i=1,nx 211 | denoml = denoml + d%f_(i,j,k)*qv(i,j,k) 212 | end do 213 | end do 214 | end do 215 | !$OMP END PARALLEL DO 216 | 217 | 218 | comm = d%ptrMesh_%ptrMPIC_%cartComm_ 219 | 220 | call Mpi_Allreduce(denoml, denomg, 1, MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierror) 221 | 222 | alpha = deltaN/denomg 223 | 224 | end subroutine 225 | !========================================================================================! 226 | 227 | !========================================================================================! 228 | subroutine updatePsi(psi,d,alpha,isSingular) 229 | type(field), intent(inout) :: psi 230 | type(field), intent(in) :: d 231 | real(DP), intent(in) :: alpha 232 | logical, intent(in) :: isSingular 233 | integer :: is,ie,js,je,ks,ke 234 | integer :: i,j,k 235 | 236 | is = lbound(psi%f_,1) 237 | ie = ubound(psi%f_,1) 238 | js = lbound(psi%f_,2) 239 | je = ubound(psi%f_,2) 240 | ks = lbound(psi%f_,3) 241 | ke = ubound(psi%f_,3) 242 | 243 | !$OMP PARALLEL DO DEFAULT(none) & 244 | !$OMP SHARED(psi,d,alpha) & 245 | !$OMP SHARED(is,ie,js,je,ks,ke) & 246 | !$OMP PRIVATE(i,j,k) 247 | do k=ks,ke 248 | do j=js,je 249 | do i=is,ie 250 | psi%f_(i,j,k) = psi%f_(i,j,k) + alpha*d%f_(i,j,k) 251 | end do 252 | end do 253 | end do 254 | !$OMP END PARALLEL DO 255 | 256 | !correct full Neumann system 257 | if (isSingular) then 258 | !call correctFullNeumann(psi%ptrMesh_,psi) 259 | end if 260 | 261 | 262 | end subroutine 263 | !========================================================================================! 264 | 265 | !========================================================================================! 266 | subroutine updateDir(d0,d,gamma) 267 | real(DP), allocatable, dimension(:,:,:), intent(inout) :: d0 268 | type(field), intent(in) :: d 269 | real(DP), intent(in) :: gamma 270 | integer :: nx,ny,nz 271 | integer :: i,j,k 272 | 273 | nx = d%nx_ 274 | ny = d%ny_ 275 | nz = d%nz_ 276 | 277 | !$OMP PARALLEL DO DEFAULT(none) & 278 | !$OMP SHARED(d,d0) & 279 | !$OMP SHARED(nx,ny,nz,gamma) & 280 | !$OMP PRIVATE(i,j,k) 281 | do k=1,nz 282 | do j=1,ny 283 | do i=1,nx 284 | d0(i,j,k) = d%f_(i,j,k) + gamma*d0(i,j,k) 285 | end do 286 | end do 287 | end do 288 | !$OMP END PARALLEL DO 289 | 290 | end subroutine 291 | !========================================================================================! 292 | 293 | !========================================================================================! 294 | subroutine updateDeltaN(va,vb,deltaN) 295 | type(field), intent(in) :: va,vb 296 | real(DP), intent(out) :: deltaN 297 | integer :: nx,ny,nz 298 | real(DP) :: deltaNl 299 | integer :: ierror, comm 300 | integer :: i,j,k 301 | 302 | nx = va%nx_ 303 | ny = va%ny_ 304 | nz = va%nz_ 305 | 306 | deltaNl = 0.d0 307 | 308 | !$OMP PARALLEL DO DEFAULT(none) & 309 | !$OMP SHARED(va,vb) & 310 | !$OMP SHARED(nx,ny,nz) & 311 | !$OMP PRIVATE(i,j,k) & 312 | !$OMP REDUCTION(+:deltaNl) 313 | do k=1,nz 314 | do j=1,ny 315 | do i=1,nx 316 | deltaNl = deltaNl + va%f_(i,j,k)*vb%f_(i,j,k) 317 | end do 318 | end do 319 | end do 320 | !$OMP END PARALLEL DO 321 | 322 | comm = va%ptrMesh_%ptrMPIC_%cartComm_ 323 | 324 | call Mpi_Allreduce(deltaNl, deltaN, 1, MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierror) 325 | 326 | 327 | end subroutine 328 | !========================================================================================! 329 | 330 | !========================================================================================! 331 | subroutine updateResidual(r,qv,alpha) 332 | type(field), intent(inout) :: r 333 | real(DP), allocatable, dimension(:,:,:), intent(in) :: qv 334 | real(DP), intent(in) :: alpha 335 | integer :: nx,ny,nz 336 | integer :: i,j,k 337 | 338 | nx = r%nx_ 339 | ny = r%ny_ 340 | nz = r%nz_ 341 | 342 | !$OMP PARALLEL DO DEFAULT(none) & 343 | !$OMP SHARED(r,qv,alpha) & 344 | !$OMP SHARED(nx,ny,nz) & 345 | !$OMP PRIVATE(i,j,k) 346 | do k=1,nz 347 | do j=1,ny 348 | do i=1,nx 349 | r%f_(i,j,k) = r%f_(i,j,k)-alpha*qv(i,j,k) 350 | end do 351 | end do 352 | end do 353 | !$OMP END PARALLEL DO 354 | 355 | end subroutine 356 | !========================================================================================! 357 | 358 | !========================================================================================! 359 | function continueIterating(this,q) RESULT(isVar) 360 | type(pcg), intent(inout) :: this 361 | type(field), intent(in) :: q 362 | logical :: isVar 363 | 364 | 365 | !check max iteration limit 366 | if (this%iter_ == this%maxIter_) then 367 | if (IS_MASTER) then 368 | write(*,*) '!*************** WARNING *****************' 369 | write(*,*) 'EXIT PCG iterations: max iter reached' 370 | end if 371 | isVar = .FALSE. 372 | return 373 | end if 374 | 375 | call scalarResidual(this%r_,q,this%res_) 376 | 377 | !check tolerance 378 | if (this%res_ > this%tol_) then 379 | 380 | if (IS_MASTER) then 381 | if (this%fullInfo_) then 382 | write(*,*) 'PCG solver: iteration ', this%iter_, ' residual = ', & 383 | this%res_ 384 | end if 385 | end if 386 | isVar = .TRUE. 387 | 388 | else 389 | 390 | if (IS_MASTER) then 391 | if (this%fullInfo_) then 392 | write(*,*) 'Criterion met at iteration: ', this%iter_, ' residual = ', & 393 | this%res_ 394 | end if 395 | end if 396 | 397 | isVar = .FALSE. 398 | 399 | end if 400 | 401 | this%iter_ = this%iter_ + 1 402 | 403 | 404 | end function 405 | !========================================================================================! 406 | 407 | !========================================================================================! 408 | subroutine scalarResidual(r,q,res) 409 | type(field), intent(in) :: r,q 410 | real(DP), intent(out) :: res 411 | integer :: nx,ny,nz 412 | integer :: comm, ierror 413 | real(DP) :: r_l,q_l,r_g,q_g 414 | 415 | nx = q%nx_ 416 | ny = q%ny_ 417 | nz = q%nz_ 418 | 419 | call reduceSqrSum_omp(r%f_,1,nx,1,ny,1,nz,r_l) 420 | call reduceSqrSum_omp(q%f_,1,nx,1,ny,1,nz,q_l) 421 | 422 | comm = r%ptrMesh_%ptrMPIC_%cartComm_ 423 | 424 | call Mpi_Allreduce(r_l, r_g, 1, MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierror) 425 | call Mpi_Allreduce(q_l, q_g, 1, MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierror) 426 | 427 | res = sqrt(r_g)/sqrt(q_g+tiny(0.d0)) 428 | 429 | end subroutine 430 | !========================================================================================! 431 | 432 | !========================================================================================! 433 | subroutine storeMetrics(this,mesh) 434 | type(pcg), intent(inout) :: this 435 | type(grid), intent(in) :: mesh 436 | integer :: nx,ny,nz 437 | integer :: i,j,k 438 | 439 | nx = mesh%nx_ 440 | ny = mesh%ny_ 441 | nz = mesh%nz_ 442 | 443 | call allocateArray(this%invx_,1,2,1,nx) 444 | call allocateArray(this%invy_,1,2,1,ny) 445 | call allocateArray(this%invz_,1,2,1,nz) 446 | 447 | !x 448 | do i=1,nx 449 | this%invx_(1,i) = 1.d0/(mesh%dxc_(i+1)*mesh%dxf_(i)) 450 | this%invx_(2,i) = 1.d0/(mesh%dxc_(i)*mesh%dxf_(i)) 451 | end do 452 | 453 | !y 454 | do j=1,ny 455 | this%invy_(1,j) = 1.d0/(mesh%dyc_(j+1)*mesh%dyf_(j)) 456 | this%invy_(2,j) = 1.d0/(mesh%dyc_(j)*mesh%dyf_(j)) 457 | end do 458 | 459 | !z 460 | do k=1,nz 461 | this%invz_(1,k) = 1.d0/(mesh%dzc_(k+1)*mesh%dzf_(k)) 462 | this%invz_(2,k) = 1.d0/(mesh%dzc_(k)*mesh%dzf_(k)) 463 | end do 464 | 465 | 466 | end subroutine 467 | !========================================================================================! 468 | 469 | 470 | 471 | end module pcgMod 472 | 473 | -------------------------------------------------------------------------------- /src/poissonEqn/poissonEqn.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module poissonEqnMod 20 | 21 | #ifdef FAST_MODE 22 | use fastPoissonSolverMod 23 | #endif 24 | #ifdef MG_MODE 25 | use pcgMod 26 | #endif 27 | use timeMod 28 | 29 | implicit none 30 | 31 | 32 | type, public :: poissonEqn 33 | 34 | !keep a pointer to grid 35 | type(grid), pointer :: ptrMesh_ => NULL() 36 | 37 | #ifdef FAST_MODE 38 | type(fastPoissonSolver), private :: fftSolver_ 39 | #endif 40 | #ifdef MG_MODE 41 | type(pcg) :: pcgs_ 42 | #endif 43 | 44 | !poisson eqn source 45 | type(field), private :: s_ 46 | 47 | #ifdef MG_MODE 48 | !poisson eqn coefficients 49 | type(field), private :: beta_ 50 | #endif 51 | 52 | !keep a pointer to time 53 | type(time), pointer :: ptrTime_ => NULL() 54 | 55 | 56 | !number of pressure levels 57 | integer :: nl_ 58 | 59 | !reference density (only used in FFT based solver) 60 | real(DP) :: rho0_ 61 | 62 | 63 | end type 64 | 65 | !pressure fields 66 | type(field) :: gp, p, gp0, p0 67 | 68 | 69 | private :: computeSource 70 | private :: clean_st_prev_bc 71 | #ifdef MG_MODE 72 | private :: computeBeta 73 | #endif 74 | private :: info 75 | #ifdef FAST_MODE 76 | private :: computeOldPressDiv 77 | #endif 78 | public :: poissonEqnCTOR 79 | public :: solvePoissonEqn 80 | public :: updatePressure 81 | 82 | 83 | 84 | contains 85 | 86 | 87 | !========================================================================================! 88 | #ifdef FAST_MODE 89 | subroutine poissonEqnCTOR(this,mesh,gMesh,gpsi,psi,rt,rhol,rhog) 90 | type(poissonEqn) :: this 91 | type(grid), intent(in), target :: mesh,gMesh 92 | type(field), intent(in) :: gpsi 93 | type(field), intent(inout) :: psi 94 | type(time), intent(in), target :: rt 95 | real(DP), intent(in) :: rhol,rhog 96 | integer :: n_old 97 | #endif 98 | #ifdef MG_MODE 99 | subroutine poissonEqnCTOR(this,mesh,gMesh,c,gpsi,psi,rt,rhol,rhog) 100 | type(poissonEqn) :: this 101 | type(grid), intent(in), target :: mesh,gMesh 102 | type(field), intent(inout) :: c 103 | type(field), intent(in) :: gpsi 104 | type(field), intent(inout) :: psi 105 | type(time), intent(in), target :: rt 106 | real(DP), intent(in) :: rhol,rhog 107 | #endif 108 | 109 | this%ptrMesh_ => mesh 110 | this%ptrTime_ => rt 111 | 112 | !init source and beta coeff 113 | call fieldCTOR(this%s_,'s',mesh,'cl',psi%hd_,initOpt=-1) 114 | call copyBoundary(this%s_,psi) 115 | 116 | #ifdef FAST_MODE 117 | call fastPoissonSolverCTOR(this%fftSolver_,mesh,gMesh) 118 | #endif 119 | #ifdef MG_MODE 120 | call fieldCTOR(this%beta_,'beta',mesh,'cl',psi%hd_,initOpt=-1) 121 | call copyBoundary(this%beta_,c) 122 | 123 | call pcgCTOR(this%pcgs_,mesh,psi,this%beta_) 124 | #endif 125 | 126 | !set reference density 127 | this%rho0_=min(rhol,rhog) 128 | 129 | !init current and old pressure field 130 | if (IS_MASTER) then 131 | call fieldCTOR(gp,'p',gMesh,'cl',halo_size=1,initOpt=4,nFolder=rt%inputFold_) 132 | call copyBoundary(gp,gpsi,build_htypes=.FALSE.) 133 | end if 134 | call fieldCTOR(p,'p',mesh,'cl',halo_size=1,initOpt=-1) 135 | call decomposeField(gp,p) 136 | 137 | if (IS_MASTER) then 138 | call fieldCTOR(gp0,'p0',gMesh,'cl',halo_size=1,initOpt=4,nFolder=rt%inputFold_) 139 | call copyBoundary(gp0,gpsi,build_htypes=.FALSE.) 140 | end if 141 | call fieldCTOR(p0,'p0',mesh,'cl',halo_size=1,initOpt=-1) 142 | call decomposeField(gp0,p0) 143 | 144 | !allocate old pressure field 145 | this%nl_=2 146 | call allocateOldField(psi,this%nl_) 147 | psi%ptrf_%ptrf_%f_=p0%f_ 148 | 149 | 150 | end subroutine 151 | !========================================================================================! 152 | 153 | !========================================================================================! 154 | #ifdef MG_MODE 155 | subroutine computeSource(this,u) 156 | type(poissonEqn), intent(inout) :: this 157 | type(vfield), intent(in) :: u 158 | type(grid), pointer :: mesh 159 | integer :: nx, ny, nz 160 | integer :: i, j, k 161 | real(DP) :: dx, dy, dz 162 | 163 | 164 | mesh => u%ptrMesh_ 165 | 166 | nx = mesh%nx_ 167 | ny = mesh%ny_ 168 | nz = mesh%nz_ 169 | 170 | !$OMP PARALLEL DO DEFAULT(none) & 171 | !$OMP SHARED(this,u,mesh) & 172 | !$OMP SHARED(nx,ny,nz) & 173 | !$OMP PRIVATE(i,j,k) & 174 | !$OMP PRIVATE(dx,dy,dz) 175 | do k = 1,nz 176 | do j = 1,ny 177 | do i = 1,nx 178 | 179 | dx = (u%ux_%f_(i,j,k)-u%ux_%f_(i-1,j,k))/mesh%dxf_(i) 180 | dy = (u%uy_%f_(i,j,k)-u%uy_%f_(i,j-1,k))/mesh%dyf_(j) 181 | dz = (u%uz_%f_(i,j,k)-u%uz_%f_(i,j,k-1))/mesh%dzf_(k) 182 | 183 | this%s_%f_(i,j,k) = dx + dy + dz 184 | 185 | end do 186 | end do 187 | end do 188 | !$OMP END PARALLEL DO 189 | 190 | end subroutine 191 | #endif 192 | #ifdef FAST_MODE 193 | subroutine computeSource(this,psi,rho,u,st) 194 | type(poissonEqn), intent(inout) :: this 195 | type(field), intent(in) :: psi,rho 196 | type(vfield), intent(in) :: u,st 197 | type(grid), pointer :: mesh 198 | integer :: nx, ny, nz 199 | integer :: i, j, k 200 | real(DP) :: dx,dy,dz,rho0,dt,alpha,r 201 | real(DP) :: apx,amx,apy,amy,apz,amz 202 | real(DP) :: dpxp,dpxm,dpyp,dpym,dpzp,dpzm 203 | 204 | 205 | mesh => u%ptrMesh_ 206 | 207 | nx = mesh%nx_ 208 | ny = mesh%ny_ 209 | nz = mesh%nz_ 210 | 211 | rho0=this%rho0_ 212 | 213 | dt = this%ptrTime_%dt_ 214 | alpha = alphaRKS(this%ptrTime_) 215 | r = 1.d0/(alpha*dt) 216 | 217 | !$OMP PARALLEL DO DEFAULT(none) & 218 | !$OMP SHARED(this,u,mesh,psi,rho,st) & 219 | !$OMP SHARED(nx,ny,nz,r,rho0) & 220 | !$OMP PRIVATE(i,j,k) & 221 | !$OMP PRIVATE(dx,dy,dz) & 222 | !$OMP PRIVATE(apx,amx,apy,amy,apz,amz) & 223 | !$OMP PRIVATE(dpxp,dpxm,dpyp,dpym,dpzp,dpzm) 224 | do k = 1,nz 225 | do j = 1,ny 226 | do i = 1,nx 227 | 228 | dx = (u%ux_%f_(i,j,k)-u%ux_%f_(i-1,j,k))/mesh%dxf_(1) 229 | dy = (u%uy_%f_(i,j,k)-u%uy_%f_(i,j-1,k))/mesh%dyf_(j) 230 | dz = (u%uz_%f_(i,j,k)-u%uz_%f_(i,j,k-1))/mesh%dzf_(1) 231 | 232 | this%s_%f_(i,j,k) = (dx + dy + dz)*r*rho0 233 | 234 | apx=1.d0-rho0*0.5d0*(1.d0/rho%f_(i+1,j,k)+1.d0/rho%f_(i,j,k)) 235 | amx=1.d0-rho0*0.5d0*(1.d0/rho%f_(i-1,j,k)+1.d0/rho%f_(i,j,k)) 236 | apy=1.d0-rho0*0.5d0*(1.d0/rho%f_(i,j+1,k)+1.d0/rho%f_(i,j,k)) 237 | amy=1.d0-rho0*0.5d0*(1.d0/rho%f_(i,j-1,k)+1.d0/rho%f_(i,j,k)) 238 | apz=1.d0-rho0*0.5d0*(1.d0/rho%f_(i,j,k+1)+1.d0/rho%f_(i,j,k)) 239 | amz=1.d0-rho0*0.5d0*(1.d0/rho%f_(i,j,k-1)+1.d0/rho%f_(i,j,k)) 240 | 241 | call computeOldPressDiv(dpxp,dpxm,dpyp,dpym,dpzp,dpzm,& 242 | i,j,k,psi,st,mesh,this%nl_) 243 | 244 | dx = (apx*dpxp-amx*dpxm)/mesh%dxf_(1) 245 | dy = (apy*dpyp-amy*dpym)/mesh%dyf_(j) 246 | dz = (apz*dpzp-amz*dpzm)/mesh%dzf_(1) 247 | 248 | this%s_%f_(i,j,k)=this%s_%f_(i,j,k)+dx+dy+dz 249 | 250 | 251 | end do 252 | end do 253 | end do 254 | !$OMP END PARALLEL DO 255 | 256 | end subroutine 257 | 258 | subroutine computeOldPressDiv(dpxp,dpxm,dpyp,dpym,dpzp,dpzm,i,j,k,psi,st,mesh,n) 259 | ! ************************************************************************************** ! 260 | ! This subroutine is based on the work: Cifani, P., 2019. Analysis of a constant-coefficient 261 | ! pressure equation method for fast computations of two-phase flows at high density ratios, 262 | ! Journal of Computational Physics. 263 | ! ************************************************************************************** ! 264 | real(DP), intent(out) :: dpxp,dpxm,dpyp,dpym,dpzp,dpzm 265 | integer, intent(in) :: i,j,k,n 266 | type(field), intent(in) :: psi 267 | type(vfield), intent(in) :: st 268 | type(grid), intent(in) :: mesh 269 | 270 | select case(n) 271 | case(2) 272 | !x+ 273 | dpxp=2.d0*(psi%ptrf_%f_(i+1,j,k)-psi%ptrf_%f_(i,j,k)) 274 | dpxp=dpxp-(psi%ptrf_%ptrf_%f_(i+1,j,k)-psi%ptrf_%ptrf_%f_(i,j,k)) 275 | dpxp=dpxp/mesh%dxc_(1) 276 | dpxp=dpxp-2.d0*st%ux_%ptrf_%f_(i,j,k)+st%ux_%ptrf_%ptrf_%f_(i,j,k) 277 | !x- 278 | dpxm=2.d0*(psi%ptrf_%f_(i,j,k)-psi%ptrf_%f_(i-1,j,k)) 279 | dpxm=dpxm-(psi%ptrf_%ptrf_%f_(i,j,k)-psi%ptrf_%ptrf_%f_(i-1,j,k)) 280 | dpxm=dpxm/mesh%dxc_(1) 281 | dpxm=dpxm-2.d0*st%ux_%ptrf_%f_(i-1,j,k)+st%ux_%ptrf_%ptrf_%f_(i-1,j,k) 282 | !y+ 283 | dpyp=2.d0*(psi%ptrf_%f_(i,j+1,k)-psi%ptrf_%f_(i,j,k)) 284 | dpyp=dpyp-(psi%ptrf_%ptrf_%f_(i,j+1,k)-psi%ptrf_%ptrf_%f_(i,j,k)) 285 | dpyp=dpyp/mesh%dyc_(j+1) 286 | dpyp=dpyp-2.d0*st%uy_%ptrf_%f_(i,j,k)+st%uy_%ptrf_%ptrf_%f_(i,j,k) 287 | !y- 288 | dpym=2.d0*(psi%ptrf_%f_(i,j,k)-psi%ptrf_%f_(i,j-1,k)) 289 | dpym=dpym-(psi%ptrf_%ptrf_%f_(i,j,k)-psi%ptrf_%ptrf_%f_(i,j-1,k)) 290 | dpym=dpym/mesh%dyc_(j) 291 | dpym=dpym-2.d0*st%uy_%ptrf_%f_(i,j-1,k)+st%uy_%ptrf_%ptrf_%f_(i,j-1,k) 292 | !z+ 293 | dpzp=2.d0*(psi%ptrf_%f_(i,j,k+1)-psi%ptrf_%f_(i,j,k)) 294 | dpzp=dpzp-(psi%ptrf_%ptrf_%f_(i,j,k+1)-psi%ptrf_%ptrf_%f_(i,j,k)) 295 | dpzp=dpzp/mesh%dzc_(1) 296 | dpzp=dpzp-2.d0*st%uz_%ptrf_%f_(i,j,k)+st%uz_%ptrf_%ptrf_%f_(i,j,k) 297 | !z- 298 | dpzm=2.d0*(psi%ptrf_%f_(i,j,k)-psi%ptrf_%f_(i,j,k-1)) 299 | dpzm=dpzm-(psi%ptrf_%ptrf_%f_(i,j,k)-psi%ptrf_%ptrf_%f_(i,j,k-1)) 300 | dpzm=dpzm/mesh%dzc_(1) 301 | dpzm=dpzm-2.d0*st%uz_%ptrf_%f_(i,j,k-1)+st%uz_%ptrf_%ptrf_%f_(i,j,k-1) 302 | case default 303 | end select 304 | 305 | end subroutine 306 | #endif 307 | !========================================================================================! 308 | 309 | !========================================================================================! 310 | #ifdef MG_MODE 311 | subroutine computeBeta(this,rho) 312 | type(poissonEqn), intent(inout) :: this 313 | type(field), intent(in) :: rho 314 | integer :: nx, ny, nz 315 | real(DP) :: dt, alpha 316 | integer :: i,j,k 317 | 318 | dt = this%ptrTime_%dt_ 319 | alpha = alphaRKS(this%ptrTime_) 320 | 321 | nx = this%ptrMesh_%nx_ 322 | ny = this%ptrMesh_%ny_ 323 | nz = this%ptrMesh_%nz_ 324 | 325 | !$OMP PARALLEL DO DEFAULT(none) & 326 | !$OMP SHARED(this,rho) & 327 | !$OMP SHARED(dt,alpha) & 328 | !$OMP SHARED(nx,ny,nz) & 329 | !$OMP PRIVATE(i,j,k) 330 | do k = 1,nz 331 | do j = 1,ny 332 | do i = 1,nx 333 | this%beta_%f_(i,j,k) = (dt*alpha)/rho%f_(i,j,k) 334 | end do 335 | end do 336 | end do 337 | !$OMP END PARALLEL DO 338 | 339 | call updateBoundaries(this%beta_) 340 | 341 | 342 | end subroutine 343 | #endif 344 | !========================================================================================! 345 | 346 | !========================================================================================! 347 | subroutine solvePoissonEqn(this,psi,rho,u,st) 348 | type(poissonEqn), intent(inout) :: this 349 | type(field), intent(inout) :: psi 350 | type(field), intent(in) :: rho 351 | type(vfield), intent(in) :: u,st 352 | real(DP) :: start, finish 353 | 354 | start = MPI_Wtime() 355 | 356 | #ifdef FAST_MODE 357 | call computeSource(this,psi,rho,u,st) 358 | call solveFPS(this%fftSolver_,psi,this%s_) 359 | #endif 360 | #ifdef MG_MODE 361 | call computeSource(this,u) 362 | call computeBeta(this,rho) 363 | call solvePCG(this%pcgs_,this%ptrMesh_,psi,this%beta_,this%s_) 364 | #endif 365 | 366 | finish = MPI_Wtime() 367 | 368 | call info(this,finish-start) 369 | 370 | end subroutine 371 | !========================================================================================! 372 | 373 | !========================================================================================! 374 | subroutine updatePressure(this,psi,p,p0,st,st0) 375 | type(poissonEqn), intent(in) :: this 376 | type(field), intent(inout) :: p,psi,p0 377 | type(vfield), intent(inout) :: st,st0 378 | integer :: nx, ny, nz 379 | integer :: i,j,k 380 | 381 | nx = p%ptrMesh_%nx_ 382 | ny = p%ptrMesh_%ny_ 383 | nz = p%ptrMesh_%nz_ 384 | 385 | !$OMP PARALLEL DO DEFAULT(none) & 386 | !$OMP SHARED(p,psi) & 387 | !$OMP SHARED(nx,ny,nz) & 388 | !$OMP PRIVATE(i,j,k) 389 | do k = 1,nz 390 | do j = 1,ny 391 | do i = 1,nx 392 | p%f_(i,j,k) = psi%f_(i,j,k) !+ p%f_(i,j,k) 393 | end do 394 | end do 395 | end do 396 | !$OMP END PARALLEL DO 397 | 398 | call updateBoundaries(p) 399 | 400 | !store old pressure fields 401 | call storeOldField(psi,this%nl_) 402 | 403 | !store old surface tension fields 404 | call storeOldFieldV(st,this%nl_) 405 | 406 | !clean-up b.c. old times surface tension 407 | call clean_st_prev_bc(psi,st) 408 | 409 | !output copy 410 | call assign_omp(p0%f_,psi%ptrf_%ptrf_%f_) 411 | call assign_omp(st0%ux_%f_,st%ux_%ptrf_%ptrf_%f_) 412 | call assign_omp(st0%uy_%f_,st%uy_%ptrf_%ptrf_%f_) 413 | call assign_omp(st0%uz_%f_,st%uz_%ptrf_%ptrf_%f_) 414 | 415 | end subroutine 416 | !========================================================================================! 417 | 418 | !========================================================================================! 419 | subroutine clean_st_prev_bc(psi,st) 420 | type(field), intent(in) :: psi 421 | type(vfield), intent(inout) :: st 422 | integer :: lbi,ubi,lbj,ubj,lbk,ubk 423 | integer :: hd 424 | 425 | lbi=lbound(st%ux_%f_,1) 426 | ubi=ubound(st%ux_%f_,1) 427 | lbj=lbound(st%uy_%f_,2) 428 | ubj=ubound(st%uy_%f_,2) 429 | lbk=lbound(st%uz_%f_,3) 430 | ubk=ubound(st%uz_%f_,3) 431 | 432 | hd=st%ux_%hd_ 433 | 434 | if (psi%bRight_%bType_==s_normalGradient) then 435 | st%ux_%ptrf_%f_(ubi-hd:ubi,:,:)=0.d0 436 | st%ux_%ptrf_%ptrf_%f_(ubi-hd:ubi,:,:)=0.d0 437 | end if 438 | if (psi%bLeft_%bType_==s_normalGradient) then 439 | st%ux_%ptrf_%f_(lbi:lbi+hd,:,:)=0.d0 440 | st%ux_%ptrf_%ptrf_%f_(lbi:lbi+hd,:,:)=0.d0 441 | end if 442 | if (psi%bTop_%bType_==s_normalGradient) then 443 | st%uy_%ptrf_%f_(:,ubj-hd:ubj,:)=0.d0 444 | st%uy_%ptrf_%ptrf_%f_(:,ubj-hd:ubj,:)=0.d0 445 | end if 446 | if (psi%bBottom_%bType_==s_normalGradient) then 447 | st%uy_%ptrf_%f_(:,lbj:lbj+hd,:)=0.d0 448 | st%uy_%ptrf_%ptrf_%f_(:,lbj:lbj+hd,:)=0.d0 449 | end if 450 | if (psi%bFront_%bType_==s_normalGradient) then 451 | st%uz_%ptrf_%f_(:,:,ubk-hd:ubk)=0.d0 452 | st%uz_%ptrf_%ptrf_%f_(:,:,ubk-hd:ubk)=0.d0 453 | end if 454 | if (psi%bBack_%bType_==s_normalGradient) then 455 | st%uz_%ptrf_%f_(:,:,lbk:lbk+hd)=0.d0 456 | st%uz_%ptrf_%ptrf_%f_(:,:,lbk:lbk+hd)=0.d0 457 | end if 458 | 459 | end subroutine 460 | !========================================================================================! 461 | 462 | !========================================================================================! 463 | subroutine info(this,cpuTime) 464 | type(poissonEqn), intent(in) :: this 465 | real(DP), intent(in) :: cpuTime 466 | real(DP) :: cpuTime_max 467 | type(mpiControl), pointer :: comm 468 | integer :: ierror 469 | 470 | comm => this%ptrMesh_%ptrMPIC_ 471 | 472 | call Mpi_Reduce(cpuTime, cpuTime_max, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, & 473 | comm%cartComm_, ierror) 474 | 475 | #ifdef FAST_MODE 476 | if (IS_MASTER) then 477 | write(*,'(A,'//s_outputFormat(2:9)//')') & 478 | ' P Eqn: CPU time = ', cpuTime_max 479 | end if 480 | #endif 481 | #ifdef MG_MODE 482 | if (IS_MASTER) then 483 | write(*,'(A,'//s_intFormat(2:3)//',2(A,'//s_outputFormat(2:9)//'))') & 484 | ' P Eqn: n iter = ', this%pcgs_%iter_, & 485 | ' residual = ', this%pcgs_%res_, ' CPU time = ', cpuTime_max 486 | end if 487 | #endif 488 | 489 | end subroutine 490 | !========================================================================================! 491 | 492 | end module poissonEqnMod 493 | 494 | -------------------------------------------------------------------------------- /src/rampUpProp/rampUpProp.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module rampUpPropMod 20 | 21 | use parFileMod 22 | 23 | implicit none 24 | 25 | type, public :: rampUpProp 26 | 27 | real(DP), private :: Tr_ 28 | real(DP), private :: startValue_,endValue_ 29 | logical, private :: isRampUp_ 30 | 31 | 32 | contains 33 | end type 34 | 35 | private :: reSet 36 | private :: rampUp 37 | 38 | public :: rampUpPropCTOR 39 | public :: updateProp 40 | 41 | 42 | contains 43 | 44 | !========================================================================================! 45 | subroutine rampUpPropCTOR(this,p,startValue,endValue) 46 | type(rampUpProp), intent(out) :: this 47 | real(DP), intent(inout) :: p 48 | real(DP) :: startValue,endValue 49 | type(parFile) :: pfile 50 | 51 | call parFileCTOR(pfile,'timeControl','specs') 52 | call readParameter(pfile,this%Tr_,'Tr') 53 | call readParameter(pfile,this%isRampUp_,'isRampUp') 54 | 55 | this%startValue_ = startValue 56 | this%endValue_ = endValue 57 | 58 | call reSet(this,p) 59 | 60 | 61 | end subroutine 62 | !========================================================================================! 63 | 64 | !========================================================================================! 65 | subroutine reSet(this,p) 66 | type(rampUpProp), intent(in) :: this 67 | real(DP), intent(inout) :: p 68 | 69 | if (this%isRampUp_) then 70 | p = this%startValue_ 71 | end if 72 | 73 | end subroutine 74 | !========================================================================================! 75 | 76 | !========================================================================================! 77 | function rampUp(this,t) result(isRamp) 78 | type(rampUpProp), intent(in) :: this 79 | real(DP), intent(in) :: t 80 | logical :: isRamp 81 | 82 | if (t <= this%Tr_) then 83 | isRamp = .TRUE. 84 | else 85 | isRamp = .FALSE. 86 | end if 87 | 88 | end function 89 | !========================================================================================! 90 | 91 | !========================================================================================! 92 | subroutine updateProp(this,t,p) 93 | type(rampUpProp), intent(in) :: this 94 | real(DP), intent(inout) :: p 95 | real(DP), intent(in) :: t 96 | 97 | if (rampUp(this,t) .AND. this%isRampUp_) then 98 | p=this%startValue_+( (this%endValue_-this%startValue_)/this%Tr_ )*t 99 | else 100 | p = this%endValue_ 101 | end if 102 | 103 | end subroutine 104 | !========================================================================================! 105 | 106 | 107 | end module rampUpPropMod 108 | 109 | 110 | 111 | 112 | 113 | 114 | -------------------------------------------------------------------------------- /src/rbgs/rbgs.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module rbgsMod 20 | 21 | use fieldMod 22 | 23 | implicit none 24 | 25 | real(DP), parameter :: pi = 4.d0*DATAN(1.d0) 26 | 27 | type, public :: rbgs 28 | 29 | real(DP), private, allocatable, dimension(:,:) :: rList_, bList_ 30 | real(DP), allocatable, dimension(:,:,:) :: resV_ 31 | 32 | !store metrics 33 | real(DP), private, allocatable, dimension(:,:) :: invx_, invy_, invz_ 34 | 35 | !class pointer for multi-grids 36 | type(rbgs), pointer :: ptrRbgs_ => NULL() 37 | 38 | type(grid), pointer, private :: ptrMesh_ => NULL() 39 | 40 | real(DP) :: res_ 41 | 42 | logical :: isSystemSingular_ 43 | 44 | 45 | contains 46 | 47 | final :: delete_rbgs 48 | 49 | 50 | end type 51 | 52 | 53 | private :: coarsenRbgsSolver 54 | private :: allocatePtrRbgs 55 | private :: deallocatePtrRbgs 56 | private :: checkSingularSystem 57 | private :: storeMetrics 58 | private :: iterateGS 59 | 60 | public :: rbgsCTOR 61 | public :: delete_rbgs 62 | public :: solveRBGS 63 | public :: computeResiduals 64 | public :: coarsenRbgsSolvers 65 | public :: correctFullNeumann 66 | 67 | 68 | contains 69 | 70 | 71 | 72 | 73 | !========================================================================================! 74 | subroutine delete_rbgs(this) 75 | type(rbgs), intent(inout) :: this 76 | 77 | call deallocatePtrRbgs(this) 78 | 79 | end subroutine 80 | !========================================================================================! 81 | 82 | !========================================================================================! 83 | subroutine rbgsCTOR(this,mesh,p) 84 | type(rbgs) :: this 85 | type(grid), intent(in), target :: mesh 86 | type(field), intent(in) :: p 87 | type(mpiControl), pointer :: ptrMPIC 88 | integer, dimension(3) :: procCoord 89 | integer :: nx, ny, nz 90 | integer :: i, j, k 91 | integer :: i0, j0, k0, i1, j1, k1 92 | integer :: nr, nb 93 | 94 | this%ptrMesh_ => mesh 95 | ptrMPIC => mesh%ptrMPIC_ 96 | 97 | procCoord = ptrMPIC%procCoord_ 98 | 99 | nx = mesh%nx_ 100 | ny = mesh%ny_ 101 | nz = mesh%nz_ 102 | 103 | !info system 104 | call checkSingularSystem(this,p) 105 | 106 | !global indexes 107 | i0 = mesh%i0g_ 108 | i1 = mesh%i1g_ 109 | j0 = mesh%j0g_ 110 | j1 = mesh%j1g_ 111 | k0 = mesh%k0g_ 112 | k1 = mesh%k1g_ 113 | 114 | 115 | !count first to allocate lists 116 | nr = 0 117 | nb = 0 118 | do k=k0,k1 119 | do j=j0,j1 120 | do i=i0,i1 121 | if ( mod(i+j+k,2) == 0 ) then 122 | nr = nr +1 123 | else 124 | nb = nb +1 125 | end if 126 | end do 127 | end do 128 | end do 129 | 130 | call allocateArray(this%rList_,1,3,1,nr) 131 | call allocateArray(this%bList_,1,3,1,nb) 132 | 133 | 134 | !set indices 135 | nr = 1 136 | nb = 1 137 | do k=k0,k1 138 | do j=j0,j1 139 | do i=i0,i1 140 | if ( mod(i+j+k,2) == 0 ) then 141 | this%rList_(1,nr) = i-i0+1 142 | this%rList_(2,nr) = j-j0+1 143 | this%rList_(3,nr) = k-k0+1 144 | nr = nr+1 145 | else 146 | this%bList_(1,nb) = i-i0+1 147 | this%bList_(2,nb) = j-j0+1 148 | this%bList_(3,nb) = k-k0+1 149 | nb = nb+1 150 | end if 151 | end do 152 | end do 153 | end do 154 | 155 | 156 | !allocate residuals array 157 | call allocateArray(this%resV_,1,nx,1,ny,1,nz) 158 | 159 | !store metrics 160 | call storeMetrics(this) 161 | 162 | 163 | 164 | end subroutine 165 | !========================================================================================! 166 | 167 | !========================================================================================! 168 | subroutine solveRBGS(this,p,beta,q,nIter,isToBeReset) 169 | type(rbgs), intent(inout) :: this 170 | type(field), intent(in) :: beta, q 171 | integer, intent(in) :: nIter 172 | type(field), intent(inout) :: p 173 | logical, intent(in) :: isToBeReset 174 | 175 | !GS sweeps 176 | call iterateGS(this,p,beta,q,nIter,isToBeReset) 177 | 178 | !update residuals 179 | call computeResiduals(this,p,beta,q) 180 | 181 | 182 | end subroutine 183 | !========================================================================================! 184 | 185 | !========================================================================================! 186 | subroutine iterateGS(this,p,beta,q,nIter,isToBeReset) 187 | type(rbgs), intent(inout) :: this 188 | type(field), intent(in) :: beta, q 189 | integer, intent(in) :: nIter 190 | type(field), intent(inout) :: p 191 | logical, intent(in) :: isToBeReset 192 | integer :: i, j, k, n 193 | real(DP) :: aR, aL, aT, aBo, aF, aBa 194 | integer :: iter 195 | 196 | 197 | if (isToBeReset) then 198 | call initToZero(p) 199 | end if 200 | 201 | 202 | do iter = 1,nIter 203 | 204 | !update red-list 205 | !$OMP PARALLEL DO DEFAULT(none) & 206 | !$OMP SHARED(this,p,beta,q) & 207 | !$OMP PRIVATE(i,j,k,n) & 208 | !$OMP PRIVATE(aR,aL,aT,aBo,aF,aBa) 209 | do n=1,size(this%rList_,2) 210 | i = this%rList_(1,n) 211 | j = this%rList_(2,n) 212 | k = this%rList_(3,n) 213 | 214 | 215 | aR = 0.5d0*(beta%f_(i+1,j,k)+beta%f_(i,j,k))*this%invx_(1,i) 216 | aL = 0.5d0*(beta%f_(i,j,k)+beta%f_(i-1,j,k))*this%invx_(2,i) 217 | aT = 0.5d0*(beta%f_(i,j+1,k)+beta%f_(i,j,k))*this%invy_(1,j) 218 | aBo = 0.5d0*(beta%f_(i,j,k)+beta%f_(i,j-1,k))*this%invy_(2,j) 219 | aF = 0.5d0*(beta%f_(i,j,k+1)+beta%f_(i,j,k))*this%invz_(1,k) 220 | aBa = 0.5d0*(beta%f_(i,j,k)+beta%f_(i,j,k-1))*this%invz_(2,k) 221 | 222 | 223 | p%f_(i,j,k) = ( & 224 | - q%f_(i,j,k) & 225 | + (aR*p%f_(i+1,j,k)+aL*p%f_(i-1,j,k)) & 226 | + (aT*p%f_(i,j+1,k)+aBo*p%f_(i,j-1,k)) & 227 | + (aF*p%f_(i,j,k+1)+aBa*p%f_(i,j,k-1)) & 228 | )/(aR+aL+aT+aBo+aF+aBa) 229 | end do 230 | !$OMP END PARALLEL DO 231 | 232 | !update boundaries 233 | call updateBoundaries(p) 234 | 235 | !update black-list 236 | !$OMP PARALLEL DO DEFAULT(none) & 237 | !$OMP SHARED(this,p,beta,q) & 238 | !$OMP PRIVATE(i,j,k,n) & 239 | !$OMP PRIVATE(aR,aL,aT,aBo,aF,aBa) 240 | do n=1,size(this%bList_,2) 241 | i = this%bList_(1,n) 242 | j = this%bList_(2,n) 243 | k = this%bList_(3,n) 244 | 245 | aR = 0.5d0*(beta%f_(i+1,j,k)+beta%f_(i,j,k))*this%invx_(1,i) 246 | aL = 0.5d0*(beta%f_(i,j,k)+beta%f_(i-1,j,k))*this%invx_(2,i) 247 | aT = 0.5d0*(beta%f_(i,j+1,k)+beta%f_(i,j,k))*this%invy_(1,j) 248 | aBo = 0.5d0*(beta%f_(i,j,k)+beta%f_(i,j-1,k))*this%invy_(2,j) 249 | aF = 0.5d0*(beta%f_(i,j,k+1)+beta%f_(i,j,k))*this%invz_(1,k) 250 | aBa = 0.5d0*(beta%f_(i,j,k)+beta%f_(i,j,k-1))*this%invz_(2,k) 251 | 252 | 253 | p%f_(i,j,k) = ( & 254 | - q%f_(i,j,k) & 255 | + (aR*p%f_(i+1,j,k)+aL*p%f_(i-1,j,k)) & 256 | + (aT*p%f_(i,j+1,k)+aBo*p%f_(i,j-1,k)) & 257 | + (aF*p%f_(i,j,k+1)+aBa*p%f_(i,j,k-1)) & 258 | )/(aR+aL+aT+aBo+aF+aBa) 259 | end do 260 | !$OMP END PARALLEL DO 261 | 262 | !update boundaries 263 | call updateBoundaries(p) 264 | 265 | !correct full Neumann system 266 | if (this%isSystemSingular_) then 267 | call correctFullNeumann(this%ptrMesh_,p) 268 | end if 269 | 270 | end do 271 | 272 | end subroutine 273 | !========================================================================================! 274 | 275 | !========================================================================================! 276 | subroutine computeResiduals(this,p,beta,q) 277 | type(rbgs), intent(inout) :: this 278 | type(field), intent(in) :: beta, q 279 | type(field), intent(in) :: p 280 | type(mpiControl), pointer :: ptrMPIC 281 | integer :: i, j, k 282 | real(DP) :: aR, aL, aT, aBo, aF, aBa 283 | real(DP) :: res_l,resq_l,res_g,resq_g 284 | integer :: ierror 285 | integer :: nx, ny, nz 286 | 287 | nx = this%ptrMesh_%nx_ 288 | ny = this%ptrMesh_%ny_ 289 | nz = this%ptrMesh_%nz_ 290 | 291 | !$OMP PARALLEL DO DEFAULT(none) & 292 | !$OMP SHARED(this,p,beta,q) & 293 | !$OMP SHARED(nx,ny,nz) & 294 | !$OMP PRIVATE(i,j,k) & 295 | !$OMP PRIVATE(aR,aL,aT,aBo,aF,aBa) 296 | do k=1,nz 297 | do j=1,ny 298 | do i=1,nx 299 | 300 | aR = 0.5d0*(beta%f_(i+1,j,k)+beta%f_(i,j,k))*this%invx_(1,i) 301 | aL = 0.5d0*(beta%f_(i,j,k)+beta%f_(i-1,j,k))*this%invx_(2,i) 302 | aT = 0.5d0*(beta%f_(i,j+1,k)+beta%f_(i,j,k))*this%invy_(1,j) 303 | aBo = 0.5d0*(beta%f_(i,j,k)+beta%f_(i,j-1,k))*this%invy_(2,j) 304 | aF = 0.5d0*(beta%f_(i,j,k+1)+beta%f_(i,j,k))*this%invz_(1,k) 305 | aBa = 0.5d0*(beta%f_(i,j,k)+beta%f_(i,j,k-1))*this%invz_(2,k) 306 | 307 | 308 | this%resV_(i,j,k) = q%f_(i,j,k) & 309 | - & 310 | ( & 311 | aR*(p%f_(i+1,j,k)-p%f_(i,j,k)) & 312 | - aL*(p%f_(i,j,k)-p%f_(i-1,j,k)) & 313 | + aT*(p%f_(i,j+1,k)-p%f_(i,j,k)) & 314 | - aBo*(p%f_(i,j,k)-p%f_(i,j-1,k)) & 315 | + aF*(p%f_(i,j,k+1)-p%f_(i,j,k)) & 316 | - aBa*(p%f_(i,j,k)-p%f_(i,j,k-1)) & 317 | ) 318 | end do 319 | end do 320 | end do 321 | !$OMP END PARALLEL DO 322 | 323 | 324 | call reduceSqrSum_omp(this%resV_,res_l) 325 | call reduceSqrSum_omp(q%f_,resq_l) 326 | 327 | ptrMPIC => this%ptrMesh_%ptrMPIC_ 328 | call Mpi_Allreduce(res_l, res_g, 1, MPI_DOUBLE_PRECISION, MPI_SUM, ptrMPIC%cartComm_, ierror) 329 | call Mpi_Allreduce(resq_l, resq_g, 1, MPI_DOUBLE_PRECISION, MPI_SUM, ptrMPIC%cartComm_, ierror) 330 | 331 | this%res_ = sqrt(res_g)/(sqrt(resq_g)+tiny(1.d0)) 332 | 333 | end subroutine 334 | !========================================================================================! 335 | 336 | !========================================================================================! 337 | recursive subroutine coarsenRbgsSolvers(this,mesh,p,n) 338 | type(rbgs), intent(inout) :: this 339 | type(grid), intent(in) :: mesh 340 | type(field), intent(in) :: p 341 | integer, intent(in) :: n 342 | 343 | if (n > 1) then 344 | call coarsenRbgsSolver(this,mesh,p) 345 | call coarsenRbgsSolvers(this%ptrRbgs_,mesh%ptrGrid_,p%ptrf_,n-1) 346 | else 347 | return 348 | end if 349 | 350 | 351 | end subroutine 352 | !========================================================================================! 353 | 354 | !========================================================================================! 355 | subroutine coarsenRbgsSolver(this,mesh,p) 356 | type(rbgs), intent(inout) :: this 357 | type(grid), intent(in) :: mesh 358 | type(field), intent(in) :: p 359 | 360 | !allocate pointer 361 | call allocatePtrRbgs(this) 362 | 363 | !init coarse solver 364 | call rbgsCTOR(this%ptrRbgs_,mesh%ptrGrid_,p%ptrf_) 365 | 366 | 367 | end subroutine 368 | !========================================================================================! 369 | 370 | !========================================================================================! 371 | subroutine allocatePtrRbgs(this) 372 | type(rbgs), intent(inout) :: this 373 | integer :: err 374 | 375 | 376 | if (.not. associated(this%ptrRbgs_)) then 377 | 378 | allocate(this%ptrRbgs_,STAT=err) 379 | 380 | if (err /= 0) then 381 | call mpiABORT('Allocation of ptrRbgs failed ') 382 | end if 383 | else 384 | call mpiABORT('Attempt to allocate an already associated ptrRbgs ') 385 | end if 386 | 387 | 388 | end subroutine 389 | !========================================================================================! 390 | 391 | !========================================================================================! 392 | subroutine deallocatePtrRbgs(this) 393 | type(rbgs), intent(inout) :: this 394 | 395 | if (associated(this%ptrRbgs_)) then 396 | deallocate(this%ptrRbgs_) 397 | end if 398 | 399 | end subroutine 400 | !========================================================================================! 401 | 402 | !========================================================================================! 403 | subroutine correctFullNeumann(mesh,p) 404 | type(grid), intent(in) :: mesh 405 | type(field), intent(inout) :: p 406 | type(mpiControl), pointer :: ptrMPIC 407 | real(DP) :: pAvl, pAvg 408 | integer :: ierror 409 | integer :: is,ie,js,je,ks,ke 410 | integer :: nx, ny, nz 411 | integer :: i,j,k 412 | 413 | nx = mesh%nx_ 414 | ny = mesh%ny_ 415 | nz = mesh%nz_ 416 | 417 | is = lbound(p%f_,1) 418 | ie = ubound(p%f_,1) 419 | js = lbound(p%f_,2) 420 | je = ubound(p%f_,2) 421 | ks = lbound(p%f_,3) 422 | ke = ubound(p%f_,3) 423 | 424 | call reduceSum_omp(p%f_,1,nx,1,ny,1,nz,pAvl) 425 | 426 | ptrMPIC => mesh%ptrMPIC_ 427 | 428 | call Mpi_Allreduce(pAvl, pAvg, 1, MPI_DOUBLE_PRECISION, MPI_SUM, ptrMPIC%cartComm_, ierror) 429 | pAvg = pAvg/(mesh%nxg_*mesh%nyg_*mesh%nzg_) 430 | 431 | !make field zero-average 432 | !$OMP PARALLEL DO DEFAULT(none) & 433 | !$OMP SHARED(p,pAvg) & 434 | !$OMP SHARED(is,ie,js,je,ks,ke) & 435 | !$OMP PRIVATE(i,j,k) 436 | do k=ks,ke 437 | do j=js,je 438 | do i=is,ie 439 | p%f_(i,j,k) = p%f_(i,j,k) - pAvg 440 | end do 441 | end do 442 | end do 443 | !$OMP END PARALLEL DO 444 | 445 | 446 | end subroutine 447 | !========================================================================================! 448 | 449 | !========================================================================================! 450 | subroutine checkSingularSystem(this,f) 451 | type(rbgs), intent(inout) :: this 452 | type(field), intent(in) :: f 453 | type(mpiControl), pointer :: ptrMPIC 454 | integer :: i, ig 455 | integer :: ierror 456 | 457 | 458 | ptrMPIC => this%ptrMesh_%ptrMPIC_ 459 | 460 | if ( & 461 | (f%bLeft_%bType_ == s_fixedValue) .OR. & 462 | (f%bRight_%bType_ == s_fixedValue) .OR. & 463 | (f%bBottom_%bType_ == s_fixedValue) .OR. & 464 | (f%bTop_%bType_ == s_fixedValue) .OR. & 465 | (f%bBack_%bType_ == s_fixedValue) .OR. & 466 | (f%bFront_%bType_ == s_fixedValue) & 467 | ) then 468 | 469 | i = 1 470 | 471 | else 472 | 473 | i = 0 474 | 475 | end if 476 | 477 | call Mpi_Allreduce(i, ig, 1, MPI_INTEGER, MPI_SUM, ptrMPIC%cartComm_, ierror) 478 | 479 | if (ig == 0) then 480 | this%isSystemSingular_ = .TRUE. 481 | else 482 | this%isSystemSingular_ = .FALSE. 483 | end if 484 | 485 | end subroutine 486 | !========================================================================================! 487 | 488 | !========================================================================================! 489 | subroutine storeMetrics(this) 490 | type(rbgs), intent(inout) :: this 491 | integer :: nx,ny,nz 492 | integer :: i,j,k 493 | 494 | nx = this%ptrMesh_%nx_ 495 | ny = this%ptrMesh_%ny_ 496 | nz = this%ptrMesh_%nz_ 497 | 498 | call allocateArray(this%invx_,1,2,1,nx) 499 | call allocateArray(this%invy_,1,2,1,ny) 500 | call allocateArray(this%invz_,1,2,1,nz) 501 | 502 | !x 503 | do i=1,nx 504 | this%invx_(1,i) = 1.d0/(this%ptrMesh_%dxc_(i+1)*this%ptrMesh_%dxf_(i)) 505 | this%invx_(2,i) = 1.d0/(this%ptrMesh_%dxc_(i)*this%ptrMesh_%dxf_(i)) 506 | end do 507 | 508 | !y 509 | do j=1,ny 510 | this%invy_(1,j) = 1.d0/(this%ptrMesh_%dyc_(j+1)*this%ptrMesh_%dyf_(j)) 511 | this%invy_(2,j) = 1.d0/(this%ptrMesh_%dyc_(j)*this%ptrMesh_%dyf_(j)) 512 | end do 513 | 514 | !z 515 | do k=1,nz 516 | this%invz_(1,k) = 1.d0/(this%ptrMesh_%dzc_(k+1)*this%ptrMesh_%dzf_(k)) 517 | this%invz_(2,k) = 1.d0/(this%ptrMesh_%dzc_(k)*this%ptrMesh_%dzf_(k)) 518 | end do 519 | 520 | 521 | end subroutine 522 | !========================================================================================! 523 | 524 | 525 | end module rbgsMod 526 | 527 | -------------------------------------------------------------------------------- /src/solverTypes/solverTypes.f90: -------------------------------------------------------------------------------- 1 | module solverTypesMod 2 | 3 | implicit none 4 | 5 | integer, parameter :: SINGLE_PHASE_FLOW = 1 6 | integer, parameter :: TWO_PHASE_FLOW = 2 7 | 8 | end module solverTypesMod -------------------------------------------------------------------------------- /src/time/time.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | module timeMod 20 | 21 | use solverTypesMod 22 | use auxiliaryRoutinesMod 23 | use initialConditionsMod, only: pi 24 | 25 | implicit none 26 | 27 | !enumerate time integration scheme 28 | integer, parameter :: s_AB2 = 0 29 | integer, parameter :: s_RK3 = 1 30 | 31 | type, public :: time 32 | 33 | real(DP) :: t_ 34 | real(DP), private :: Tf_ 35 | real(DP) :: dt_,dtout_,tout_ 36 | integer, private :: writeInterval_ 37 | integer, private :: writeIter_ 38 | 39 | !adaptive time-step based on CFL 40 | type(vfield), pointer, private :: ptrU_ => NULL() 41 | logical, private :: adaptiveTimeStep_ 42 | real(DP), private :: cflLim_ 43 | real(DP), private :: cflMax_ 44 | 45 | !time-step restr. (viscosity, surface tension) 46 | logical, private :: setTimeStep_ 47 | real(DP), private :: dtLim_ 48 | 49 | !timeControl parFile 50 | type(parFile), private :: pfile_ 51 | 52 | !counter time iterations 53 | integer :: iter_ 54 | 55 | !input-output folder 56 | integer :: inputFold_,outputFold_ 57 | 58 | !time integr. scheme 59 | integer :: scheme_ 60 | 61 | !rk3 coefficients 62 | real(DP), dimension(3) :: alpha_ 63 | real(DP), dimension(3) :: gamma_ 64 | real(DP), dimension(3) :: xi_ 65 | integer, private :: rkn_ 66 | 67 | integer, private :: rkIter_ 68 | 69 | !redistribution VOF blocks time interval 70 | real(DP), private :: tVOFB_,dtVOFB_ 71 | 72 | !restart boxes 73 | logical :: restart_boxes_ 74 | 75 | 76 | contains 77 | end type 78 | 79 | private :: update 80 | private :: info 81 | private :: initRK3coef 82 | private :: initTimeLevel 83 | 84 | public :: timeCTOR 85 | public :: timeLoop 86 | public :: timeOutput 87 | public :: timeRkStep 88 | public :: writeTimeFolder 89 | public :: alphaRKS 90 | public :: gammaRKS 91 | public :: xiRKS 92 | public :: vofBlocksRed 93 | public :: compute_timestep_restrictions 94 | 95 | 96 | contains 97 | 98 | !========================================================================================! 99 | elemental function alphaRKS(this) result(r) 100 | class(time), intent(in) :: this 101 | real(DP) :: r 102 | 103 | r = this%alpha_(this%rkIter_) 104 | 105 | end function 106 | !========================================================================================! 107 | 108 | !========================================================================================! 109 | elemental function gammaRKS(this) result(r) 110 | class(time), intent(in) :: this 111 | real(DP) :: r 112 | 113 | r = this%gamma_(this%rkIter_) 114 | 115 | end function 116 | !========================================================================================! 117 | 118 | !========================================================================================! 119 | elemental function xiRKS(this) result(r) 120 | class(time), intent(in) :: this 121 | real(DP) :: r 122 | 123 | r = this%xi_(this%rkIter_) 124 | 125 | end function 126 | !========================================================================================! 127 | 128 | !========================================================================================! 129 | function vofBlocksRed(this) result(r) 130 | type(time), intent(inout) :: this 131 | logical :: r 132 | 133 | if (this%t_>=this%tVOFB_) then 134 | r = .TRUE. 135 | this%tVOFB_ = this%tVOFB_ + this%dtVOFB_ 136 | else 137 | r = .FALSE. 138 | end if 139 | 140 | end function 141 | !========================================================================================! 142 | 143 | !========================================================================================! 144 | subroutine timeCTOR(this,u,mpic) 145 | type(time), intent(out) :: this 146 | type(vfield), intent(in), target :: u 147 | type(mpiControl), intent(in) :: mpic 148 | 149 | this%ptrU_ => u 150 | 151 | call parFileCTOR(this%pfile_,'timeControl','specs') 152 | 153 | call readParameter(this%pfile_,this%Tf_,'Tf') 154 | call readParameter(this%pfile_,this%dt_,'dt') 155 | call readParameter(this%pfile_,this%inputFold_,'input_folder') 156 | call readParameter(this%pfile_,this%writeInterval_,'writeInterval') 157 | call readParameter(this%pfile_,this%dtout_,'dtout') 158 | call readParameter(this%pfile_,this%adaptiveTimeStep_,'adaptiveTimeStep') 159 | call readParameter(this%pfile_,this%setTimeStep_,'setTimeStep') 160 | call readParameter(this%pfile_,this%cflLim_,'cflMax') 161 | call readParameter(this%pfile_,this%dtVOFB_,'vofBlocksRedInterval') 162 | call readParameter(this%pfile_,this%restart_boxes_,'restart_boxes') 163 | 164 | this%iter_ = 0 165 | this%writeIter_ = 0 166 | this%outputFold_ = this%inputFold_ 167 | 168 | !init time level 169 | call initTimeLevel(this,mpic) 170 | !init RK parameters 171 | call initRK3coef(this) 172 | this%rkIter_ = 0 173 | 174 | 175 | end subroutine 176 | !========================================================================================! 177 | 178 | !========================================================================================! 179 | subroutine update(this) 180 | type(time), intent(inout) :: this 181 | real(DP) :: dt_cfl 182 | 183 | this%iter_ = this%iter_ + 1 184 | this%writeIter_ = this%writeIter_ + 1 185 | 186 | !compute cfl max 187 | this%cflMax_ = computeCFLmax(this%ptrU_,this%dt_) 188 | 189 | if ((this%adaptiveTimeStep_).AND.(this%iter_>1)) then 190 | dt_cfl=this%dt_*this%cflLim_/(this%cflMax_+tiny(0.d0)) 191 | this%dt_ = min(dt_cfl,this%dtLim_) 192 | end if 193 | 194 | this%t_ = this%t_ + this%dt_ 195 | 196 | end subroutine 197 | !========================================================================================! 198 | 199 | !========================================================================================! 200 | subroutine compute_timestep_restrictions(this,u,gmesh,rhol,rhog,mul,mug,sigma,solver) 201 | type(time), intent(inout) :: this 202 | type(vfield), intent(in) :: u 203 | type(grid), intent(in) :: gmesh 204 | real(DP), intent(in) :: rhol,rhog,mul,mug,sigma 205 | real(DP) :: dxm,dym,dzm,d,dt_cfl,dt_nul,dt_nug,dt_sigma,dt_lim 206 | integer, intent(in) :: solver 207 | integer :: nx,ny,nz 208 | 209 | nx=gmesh%nx_ 210 | ny=gmesh%ny_ 211 | nz=gmesh%nz_ 212 | 213 | dxm=minval(gmesh%dxf_(0:nx+1)) 214 | dym=minval(gmesh%dyf_(0:ny+1)) 215 | dzm=minval(gmesh%dzf_(0:nz+1)) 216 | d=minval((/dxm,dym,dzm/)) 217 | 218 | dt_nul=rhol*(1.d0/6.d0)*d*d/mul 219 | dt_nug=rhog*(1.d0/6.d0)*d*d/mug 220 | if (solver==TWO_PHASE_FLOW) then 221 | dt_sigma=sqrt(d*d*d*(rhol+rhog)/(4.d0*pi*sigma)) 222 | else 223 | dt_sigma=huge(0.d0) 224 | end if 225 | 226 | dt_cfl=compute_dt_CFL(u,this%cflLim_) 227 | 228 | dt_nul=dt_nul/2.d0 229 | dt_nug=dt_nug/2.d0 230 | dt_sigma=dt_sigma/2.5d0 231 | 232 | dt_lim=minval((/dt_nul,dt_nug,dt_sigma/)) 233 | 234 | if (this%setTimeStep_) then 235 | this%dtLim_=dt_lim 236 | this%dt_=min(this%dtLim_,dt_cfl) 237 | else 238 | this%dtLim_=this%dt_ 239 | end if 240 | 241 | end subroutine 242 | !========================================================================================! 243 | 244 | !========================================================================================! 245 | function timeLoop(this) result(isRun) 246 | type(time), intent(inout) :: this 247 | logical :: isRun 248 | real(DP) :: small 249 | 250 | small = 1.d-9 251 | 252 | call update(this) 253 | 254 | if (this%t_ >= this%Tf_ + small) then 255 | isRun = .FALSE. 256 | this%t_=this%t_-this%dt_ 257 | else 258 | call info(this) 259 | isRun = .TRUE. 260 | end if 261 | 262 | end function 263 | !========================================================================================! 264 | 265 | !========================================================================================! 266 | function timeRkStep(this) result(run) 267 | type(time), intent(inout) :: this 268 | logical :: run 269 | 270 | this%rkIter_ = this%rkIter_ + 1 271 | 272 | if (this%rkIter_ > this%rkn_) then 273 | run = .FALSE. 274 | this%rkIter_ = 0 275 | else 276 | run = .TRUE. 277 | if (IS_MASTER) then 278 | if (this%scheme_==s_RK3) then 279 | write(*,'(A,I2)') ' RK STEP: ', this%rkIter_ 280 | else 281 | write(*,'(A)') ' AB2 STEP' 282 | end if 283 | end if 284 | end if 285 | 286 | end function 287 | !========================================================================================! 288 | 289 | !========================================================================================! 290 | function timeOutput(this) result(isOutput) 291 | type(time), intent(inout) :: this 292 | logical :: isOutput 293 | 294 | if ((this%writeInterval_ == this%writeIter_).OR. & 295 | (this%t_ >= this%tout_)) then 296 | isOutput = .TRUE. 297 | this%writeIter_ = 0 298 | this%tout_ = this%tout_ + this%dtout_ 299 | else 300 | isOutput = .FALSE. 301 | end if 302 | 303 | end function 304 | !========================================================================================! 305 | 306 | !========================================================================================! 307 | subroutine writeTimeFolder(this,nb,mpic) 308 | type(time), intent(inout) :: this 309 | integer, intent(in) :: nb 310 | type(mpiControl), intent(in) :: mpic 311 | character(len=10) :: dirName 312 | integer :: CSTAT,ierror 313 | 314 | this%outputFold_ = this%outputFold_ + 1 315 | 316 | write(dirName,s_intFormat) this%outputFold_ 317 | 318 | if (IS_MASTER) then 319 | 320 | !mkdir 321 | call execute_command_line('mkdir -p ./' // adjustl(trim(dirName)),CMDSTAT=CSTAT ) 322 | 323 | if ((CSTAT > 0) .OR. (CSTAT < 0)) then 324 | call mpiABORT('mkdir on new time level failed ') 325 | end if 326 | 327 | call execute_command_line(adjustl('touch ./'//trim(dirName)//'/info_restart'),CMDSTAT=CSTAT ) 328 | 329 | 330 | !write time and total number of bubbles 331 | open(UNIT=s_IOunitNumber,FILE=trim(adjustl(dirName))//'/info_restart',& 332 | STATUS='REPLACE',ACTION='WRITE') 333 | write(s_IOunitNumber,s_doubleFormat) this%t_ 334 | write(s_IOunitNumber,s_intFormat) nb 335 | close(s_IOunitNumber) 336 | 337 | 338 | end if 339 | 340 | call mpi_barrier(mpic%cartComm_,ierror) 341 | 342 | 343 | end subroutine 344 | !========================================================================================! 345 | 346 | !========================================================================================! 347 | subroutine info(this) 348 | type(time), intent(inout) :: this 349 | 350 | if (IS_MASTER) then 351 | write(*,*) '' 352 | 353 | write(*,*) 'SOLVING FOR TIME:' 354 | 355 | write(*,'(A,'//s_doubleFormat(2:10)//')') ' t =', this%t_ 356 | write(*,'(A,'//s_outputFormat(2:9)//')') ' dt = ', this%dt_ 357 | write(*,'(A,'//s_outputFormat(2:9)//')') ' CFL max = ', this%cflMax_ 358 | 359 | end if 360 | 361 | end subroutine 362 | !========================================================================================! 363 | 364 | !========================================================================================! 365 | subroutine initRK3coef(this) 366 | type(time), intent(inout) :: this 367 | type(parFile) :: dict 368 | 369 | 370 | call parFileCTOR(dict,'schemes','specs') 371 | call readParameter(dict,this%scheme_,'time_scheme') 372 | 373 | if (this%scheme_==1) then 374 | 375 | this%rkn_ = 3 376 | 377 | this%gamma_(1) = 8.d0/15.d0 378 | this%gamma_(2) = 5.d0/12.d0 379 | this%gamma_(3) = 3.d0/4.d0 380 | 381 | this%xi_(1) = 0.d0 382 | this%xi_(2) = -17.d0/60.d0 383 | this%xi_(3) = -5.d0/12.d0 384 | 385 | else if (this%scheme_==0) then 386 | 387 | this%rkn_ = 1 388 | 389 | this%gamma_(1) = 1.5d0 390 | this%gamma_(2) = 0.d0 391 | this%gamma_(3) = 0.d0 392 | 393 | this%xi_(1) = -0.5d0 394 | this%xi_(2) = 0.d0 395 | this%xi_(3) = 0.d0 396 | 397 | else 398 | call mpiABORT('invalid time integration scheme ') 399 | end if 400 | 401 | this%alpha_(1) = this%gamma_(1)+this%xi_(1) 402 | this%alpha_(2) = this%gamma_(2)+this%xi_(2) 403 | this%alpha_(3) = this%gamma_(3)+this%xi_(3) 404 | 405 | end subroutine 406 | !========================================================================================! 407 | 408 | !========================================================================================! 409 | subroutine initTimeLevel(this,mpic) 410 | type(time), intent(inout) :: this 411 | type(mpiControl), intent(in) :: mpic 412 | character(len=10) :: dirName 413 | integer :: ierror 414 | 415 | if (IS_MASTER) then 416 | 417 | write(dirName,s_intFormat) this%inputFold_ 418 | 419 | if (this%inputFold_ == 0) then 420 | this%t_ = 0.d0 421 | this%tout_ = this%dtout_ 422 | this%tVOFB_ = this%dtVOFB_ 423 | else 424 | open(UNIT=s_IOunitNumber,FILE=adjustl(trim(dirName)//'/info_restart'),& 425 | STATUS='old',ACTION='read') 426 | read(s_IOunitNumber,s_doubleFormat) this%t_ 427 | close(s_IOunitNumber) 428 | this%tout_ = this%dtout_+this%t_ 429 | this%tVOFB_ = this%dtVOFB_+this%t_ 430 | end if 431 | end if 432 | 433 | call MPI_BCAST(this%t_, 1, MPI_DOUBLE_PRECISION, 0, mpic%cartComm_, ierror) 434 | call MPI_BCAST(this%tout_, 1, MPI_DOUBLE_PRECISION, 0, mpic%cartComm_, ierror) 435 | call MPI_BCAST(this%tVOFB_, 1, MPI_DOUBLE_PRECISION, 0, mpic%cartComm_, ierror) 436 | 437 | 438 | end subroutine 439 | !========================================================================================! 440 | 441 | 442 | 443 | 444 | 445 | end module timeMod 446 | 447 | 448 | 449 | 450 | 451 | 452 | -------------------------------------------------------------------------------- /src/writeFields_H.f90: -------------------------------------------------------------------------------- 1 | ! ************************************************************************************** ! 2 | ! TBFsolver - DNS turbulent bubbly flow solver 3 | ! Copyright (C) 2018 University of Twente. 4 | ! 5 | ! This program is free software: you can redistribute it and/or modify 6 | ! it under the terms of the GNU General Public License as published by 7 | ! the Free Software Foundation, either version 3 of the License, or 8 | ! (at your option) any later version. 9 | ! 10 | ! This program is distributed in the hope that it will be useful, 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ! GNU General Public License for more details. 14 | ! 15 | ! You should have received a copy of the GNU General Public License 16 | ! along with this program. If not, see . 17 | ! ************************************************************************************** ! 18 | 19 | !reconstruct and write fields 20 | call writeTimeFolder(runTime,s_nb,mpiCTRL) 21 | 22 | call reconstructAndWriteField(c,gc,runTime%outputFold_) 23 | call reconstructAndWriteField(cs,gcs,runTime%outputFold_) 24 | call reconstructAndWriteField(curv,gcurv,runTime%outputFold_) 25 | call reconstructAndWriteField(p,gp,runTime%outputFold_) 26 | call reconstructAndWriteField(p0,gp0,runTime%outputFold_) 27 | call reconstructAndWriteField(psi,gpsi,runTime%outputFold_) 28 | call reconstructAndWriteFieldV(u,gu,runTime%outputFold_) 29 | call reconstructAndWriteFieldV(st,gst,runTime%outputFold_) 30 | call reconstructAndWriteFieldV(st0,gst0,runTime%outputFold_) 31 | call reconstructAndWriteFieldV(w,gw,runTime%outputFold_) 32 | 33 | !write old time fluxes 34 | call printOldTimeFlux(uEqn,runTime%scheme_,runTime%outputFold_) 35 | 36 | !write stats 37 | call writeStats(stats,runTime%outputFold_) 38 | 39 | !write boxes: make sure every MPI proc can read and write in the main folder. 40 | call printVOFblocks(runTime%outputFold_) 41 | -------------------------------------------------------------------------------- /user_guide/user_guide.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cifanip/TBFsolver/1b595e017f2a7dfa0ca25528411a79d19ae34127/user_guide/user_guide.pdf --------------------------------------------------------------------------------