var tipuesearch = {"pages":[{"title":" HPC DNS Post-Processing Fortran Core ","text":"HPC DNS Post-Processing Fortran Core Fortran Core Documentation Welcome to the Fortran Core Reference. This section contains automatically generated docs from FORD for the high-order compact difference solver modules: Compact : Compact finite difference scheme equations. m_calculate : spatial derivatives and chemical kinetics. m_arrays : post-processing field allocation. m_openmpi : MPI parallel domain wrapper. m_parameters : input loaders and physical values. post : main driver pipeline. Developer Info Google DeepMind Team & Ignis","tags":"home","url":"index.html"},{"title":"READ_FILE – HPC DNS Post-Processing Fortran Core","text":"subroutine READ_FILE(num) Uses m_arrays m_parameters Arguments Type Intent Optional Attributes Name integer, intent(in) :: num","tags":"","url":"proc/read_file~2.html"},{"title":"WRITE_FILE – HPC DNS Post-Processing Fortran Core","text":"subroutine WRITE_FILE(num) Uses m_arrays m_parameters Arguments Type Intent Optional Attributes Name integer, intent(in) :: num","tags":"","url":"proc/write_file.html"},{"title":"to_omit – HPC DNS Post-Processing Fortran Core","text":"public  function to_omit(num) Arguments Type Intent Optional Attributes Name integer, intent(in) :: num Return Value logical","tags":"","url":"proc/to_omit.html"},{"title":"read_intro – HPC DNS Post-Processing Fortran Core","text":"public  subroutine read_intro() Arguments None","tags":"","url":"proc/read_intro.html"},{"title":"m_arrays_init – HPC DNS Post-Processing Fortran Core","text":"public  subroutine m_arrays_init() Arguments None","tags":"","url":"proc/m_arrays_init.html"},{"title":"m_arrays_finalize – HPC DNS Post-Processing Fortran Core","text":"public  subroutine m_arrays_finalize() Arguments None","tags":"","url":"proc/m_arrays_finalize.html"},{"title":"main – HPC DNS Post-Processing Fortran Core","text":"public  subroutine main() Arguments None","tags":"","url":"proc/main.html"},{"title":"ludcmp – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ludcmp(nx, ny, nz, xp, yp, zp) Entry point for LU decomposition calculations. Prepares the workspace allocations and runs the decomposition calculation for all three directions. Arguments Type Intent Optional Attributes Name integer, intent(in) :: nx Grid size in x-direction. integer, intent(in) :: ny Grid size in x-direction.\nGrid size in y-direction. integer, intent(in) :: nz Grid size in x-direction.\nGrid size in y-direction.\nGrid size in z-direction. integer, intent(in) :: xp Periodic flag for x-direction (0 = periodic, other = non-periodic). integer, intent(in) :: yp Periodic flag for x-direction (0 = periodic, other = non-periodic).\nPeriodic flag for y-direction (0 = periodic, other = non-periodic). integer, intent(in) :: zp Periodic flag for x-direction (0 = periodic, other = non-periodic).\nPeriodic flag for y-direction (0 = periodic, other = non-periodic).\nPeriodic flag for z-direction (0 = periodic, other = non-periodic).","tags":"","url":"proc/ludcmp.html"},{"title":"ludcmp_allocate – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ludcmp_allocate(nx, ny, nz, xp, yp, zp) LU 분해를 위한 포트란 workspace 배열 메모리를 동적 할당하는 서브루틴입니다. 경계 조건(xp, yp, zp = 0 주기적 경계 조건, 1 비주기적 경계 조건)에 따라 배열 크기와 \n할당 여부를 결정하며, 할당에 실패하면 에러를 출력하고 즉시 프로그램을 안전하게 종료(STOP)시킵니다. Arguments Type Intent Optional Attributes Name integer, intent(in) :: nx Grid size in x-direction. integer, intent(in) :: ny Grid size in x-direction.\nGrid size in y-direction. integer, intent(in) :: nz Grid size in x-direction.\nGrid size in y-direction.\nGrid size in z-direction. integer, intent(in) :: xp Periodic flag for x-direction (0 = periodic, other = non-periodic). integer, intent(in) :: yp Periodic flag for x-direction (0 = periodic, other = non-periodic).\nPeriodic flag for y-direction (0 = periodic, other = non-periodic). integer, intent(in) :: zp Periodic flag for x-direction (0 = periodic, other = non-periodic).\nPeriodic flag for y-direction (0 = periodic, other = non-periodic).\nPeriodic flag for z-direction (0 = periodic, other = non-periodic).","tags":"","url":"proc/ludcmp_allocate.html"},{"title":"ludcmp_deallocate – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ludcmp_deallocate(xp, yp, zp) Arguments Type Intent Optional Attributes Name integer, intent(in) :: xp integer, intent(in) :: yp integer, intent(in) :: zp","tags":"","url":"proc/ludcmp_deallocate.html"},{"title":"ludcmp_testalloc – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ludcmp_testalloc() Arguments None","tags":"","url":"proc/ludcmp_testalloc.html"},{"title":"ludcmp_calculate – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ludcmp_calculate(nx, ny, nz, xp, yp, zp) Arguments Type Intent Optional Attributes Name integer, intent(in) :: nx integer, intent(in) :: ny integer, intent(in) :: nz integer, intent(in) :: xp integer, intent(in) :: yp integer, intent(in) :: zp","tags":"","url":"proc/ludcmp_calculate.html"},{"title":"test_nonp_lud1 – HPC DNS Post-Processing Fortran Core","text":"public  subroutine test_nonp_lud1(xx, coef) Arguments Type Intent Optional Attributes Name integer :: xx real(kind=real64), intent(out), DIMENSION(xx) :: coef","tags":"","url":"proc/test_nonp_lud1.html"},{"title":"test_nonp_lud2 – HPC DNS Post-Processing Fortran Core","text":"public  subroutine test_nonp_lud2(xx, coef) Arguments Type Intent Optional Attributes Name integer :: xx real(kind=real64), intent(out), DIMENSION(xx) :: coef","tags":"","url":"proc/test_nonp_lud2.html"},{"title":"test_p_lud1 – HPC DNS Post-Processing Fortran Core","text":"public  subroutine test_p_lud1(xx, coef1, coef2) Arguments Type Intent Optional Attributes Name integer :: xx real(kind=real64), intent(out), DIMENSION(xx) :: coef1 real(kind=real64), intent(out), DIMENSION(xx) :: coef2","tags":"","url":"proc/test_p_lud1.html"},{"title":"test_p_lud2 – HPC DNS Post-Processing Fortran Core","text":"public  subroutine test_p_lud2(xx, coef1, coef2) Arguments Type Intent Optional Attributes Name integer :: xx real(kind=real64), intent(out), DIMENSION(xx) :: coef1 real(kind=real64), intent(out), DIMENSION(xx) :: coef2","tags":"","url":"proc/test_p_lud2.html"},{"title":"nonp_lud – HPC DNS Post-Processing Fortran Core","text":"public  subroutine nonp_lud(xyz, xx) Arguments Type Intent Optional Attributes Name integer :: xyz integer :: xx","tags":"","url":"proc/nonp_lud.html"},{"title":"p_lud – HPC DNS Post-Processing Fortran Core","text":"public  subroutine p_lud(xyz, xx) Arguments Type Intent Optional Attributes Name integer :: xyz integer :: xx","tags":"","url":"proc/p_lud.html"},{"title":"stdlu – HPC DNS Post-Processing Fortran Core","text":"public  subroutine stdlu(a, n, l) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: a (n) integer :: n real(kind=real64), intent(out) :: l (n)","tags":"","url":"proc/stdlu.html"},{"title":"ptdlu – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ptdlu(a, n, l, w) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: a integer :: n real(kind=real64), intent(out) :: l (n) real(kind=real64), intent(out) :: w (n)","tags":"","url":"proc/ptdlu.html"},{"title":"rhs1np – HPC DNS Post-Processing Fortran Core","text":"public  subroutine rhs1np(n, h, x, dx, nd) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd","tags":"","url":"proc/rhs1np.html"},{"title":"dfnonp – HPC DNS Post-Processing Fortran Core","text":"public  subroutine dfnonp(n, h, x, dx, nd, dir) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd integer, intent(in) :: dir","tags":"","url":"proc/dfnonp.html"},{"title":"dfp – HPC DNS Post-Processing Fortran Core","text":"public  subroutine dfp(n, h, x, dx, nd, dir) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd integer, intent(in) :: dir","tags":"","url":"proc/dfp.html"},{"title":"ptdslv – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ptdslv(r, n, l, w, nd) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(inout), DIMENSION(nd,n) :: r integer, intent(in) :: n real(kind=real64), intent(in), DIMENSION(n) :: l real(kind=real64), intent(in), DIMENSION(n) :: w integer, intent(in) :: nd","tags":"","url":"proc/ptdslv.html"},{"title":"d2fp – HPC DNS Post-Processing Fortran Core","text":"public  subroutine d2fp(n, h, x, dx, nd, dir) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd integer, intent(in) :: dir","tags":"","url":"proc/d2fp.html"},{"title":"tdslv – HPC DNS Post-Processing Fortran Core","text":"public  subroutine tdslv(r, n, l, nd) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(inout), DIMENSION(nd,n) :: r integer, intent(in) :: n real(kind=real64), intent(in), DIMENSION(n) :: l integer, intent(in) :: nd","tags":"","url":"proc/tdslv.html"},{"title":"d2fnonp – HPC DNS Post-Processing Fortran Core","text":"public  subroutine d2fnonp(n, h, x, dx, nd, dir) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd integer, intent(in) :: dir","tags":"","url":"proc/d2fnonp.html"},{"title":"m_openmpi_init – HPC DNS Post-Processing Fortran Core","text":"public  subroutine m_openmpi_init() $    ! The following is put on hold because it looks like a crazy idea $    ! now creating separate exclusive communicator for the master nodes only \n$    ! the name of the new communicator is MPI_COMM_ROOTS\n$    ! if we want quickly broadcast something, then we can use two BCAST calls\n$    color = 1\n$    if (iammaster) color = 0\n$    call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid_world,MPI_COMM_ROOTS,mpi_err) Arguments None","tags":"","url":"proc/m_openmpi_init.html"},{"title":"m_openmpi_exit – HPC DNS Post-Processing Fortran Core","text":"public  subroutine m_openmpi_exit() Arguments None","tags":"","url":"proc/m_openmpi_exit.html"},{"title":"openmpi_get_command_line – HPC DNS Post-Processing Fortran Core","text":"public  subroutine openmpi_get_command_line() Arguments None","tags":"","url":"proc/openmpi_get_command_line.html"},{"title":"rxn_rate – HPC DNS Post-Processing Fortran Core","text":"public  function rxn_rate(c) Computes the chemical reaction rate based on the progress variable c. This uses a piecewise exponential/Arrhenius model depending on whether the progress variable \nis below c_cut, above c_ref, or intermediate. Arguments Type Intent Optional Attributes Name real(kind=real64) :: c The progress variable (0.0 to 1.0). Return Value real(kind=real64)","tags":"","url":"proc/rxn_rate.html"},{"title":"threshold_min_max – HPC DNS Post-Processing Fortran Core","text":"public  function threshold_min_max(c, minc, maxc) Arguments Type Intent Optional Attributes Name real(kind=real64) :: c real(kind=real64) :: minc real(kind=real64) :: maxc Return Value real(kind=real64)","tags":"","url":"proc/threshold_min_max.html"},{"title":"positive – HPC DNS Post-Processing Fortran Core","text":"public  function positive(c) Arguments Type Intent Optional Attributes Name real(kind=real64) :: c Return Value real(kind=real64)","tags":"","url":"proc/positive.html"},{"title":"negative – HPC DNS Post-Processing Fortran Core","text":"public  function negative(c) Arguments Type Intent Optional Attributes Name real(kind=real64) :: c Return Value real(kind=real64)","tags":"","url":"proc/negative.html"},{"title":"m_calculate_init – HPC DNS Post-Processing Fortran Core","text":"public  subroutine m_calculate_init() Initializes the workspace arrays and matrices. Pre-allocates transposed workspace buffers ( xsrc , xdst , rsrc , rdst )\nand performs the LU decomposition setup via ludcmp for the tridiagonal compact schemes. Arguments None","tags":"","url":"proc/m_calculate_init.html"},{"title":"m_calculate_finalize – HPC DNS Post-Processing Fortran Core","text":"public  subroutine m_calculate_finalize() Arguments None","tags":"","url":"proc/m_calculate_finalize.html"},{"title":"ddx1d – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ddx1d(dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(1,nxp) :: dst real(kind=real64), intent(in), dimension(1,nxp) :: src","tags":"","url":"proc/ddx1d.html"},{"title":"ddx – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ddx(dst, src) Computes the first-order derivative in the X-direction. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst 3D output derivative field (nxp, nyp, nzp). real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src 3D input scalar field (nxp, nyp, nzp).","tags":"","url":"proc/ddx.html"},{"title":"ddy – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ddy(dst, src) Computes the first-order derivative in the Y-direction. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst 3D output derivative field (nxp, nyp, nzp). real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src 3D input scalar field (nxp, nyp, nzp).","tags":"","url":"proc/ddy.html"},{"title":"ddz – HPC DNS Post-Processing Fortran Core","text":"public  subroutine ddz(dst, src) Computes the first-order derivative in the Z-direction. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst 3D output derivative field (nxp, nyp, nzp). real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src 3D input scalar field (nxp, nyp, nzp).","tags":"","url":"proc/ddz.html"},{"title":"d2dx1d – HPC DNS Post-Processing Fortran Core","text":"public  subroutine d2dx1d(dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp) :: dst real(kind=real64), intent(in), dimension(nxp) :: src","tags":"","url":"proc/d2dx1d.html"},{"title":"d2dx – HPC DNS Post-Processing Fortran Core","text":"public  subroutine d2dx(dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src","tags":"","url":"proc/d2dx.html"},{"title":"d2dy – HPC DNS Post-Processing Fortran Core","text":"public  subroutine d2dy(dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src","tags":"","url":"proc/d2dy.html"},{"title":"d2dz – HPC DNS Post-Processing Fortran Core","text":"public  subroutine d2dz(dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src","tags":"","url":"proc/d2dz.html"},{"title":"tp – HPC DNS Post-Processing Fortran Core","text":"public  subroutine tp(a, b, nx) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out) :: a (nb,nx) real(kind=real64), intent(in) :: b (nx,nb) integer, intent(in) :: nx","tags":"","url":"proc/tp.html"},{"title":"tp2 – HPC DNS Post-Processing Fortran Core","text":"public  subroutine tp2(a, b, n1, n2) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out) :: a (n1,n2) real(kind=real64), intent(in) :: b (n2,n1) integer, intent(in) :: n1 integer, intent(in) :: n2","tags":"","url":"proc/tp2.html"},{"title":"m_parameters – HPC DNS Post-Processing Fortran Core","text":"Uses iso_fortran_env m_openmpi Variables Type Visibility Attributes Name Initial integer, public :: nxp integer, public :: nyp integer, public :: nzp real(kind=real64), public :: hxp real(kind=real64), public :: hyp real(kind=real64), public :: hzp real(kind=real64), public :: l_0 integer, public :: startnum integer, public :: endnum integer, public :: skipnum integer, public :: shiftnum real(kind=real64), public :: scp real(kind=real64), public :: prp real(kind=real64), public :: lep real(kind=real64), public :: vis0p real(kind=real64), public :: rod real(kind=real64), public :: prof_wr real(kind=real64), public :: min_wr real(kind=real64), public :: min_fsd real(kind=real64), public :: min_c real(kind=real64), public :: refwr real(kind=real64), public :: pre real(kind=real64), public :: ac real(kind=real64), public :: bc real(kind=real64), public :: c_cut real(kind=real64), public :: c_ref integer, public :: syp integer, public :: eyp integer, public :: twod real(kind=real64), public :: SL_u integer, public :: omitnum integer, public, allocatable :: omit_t (:,:) integer, public, allocatable :: file_dist (:) integer, public, allocatable :: export_offset (:) real(kind=real64), public, parameter :: pi = 3.14159265358979323846_real64 real(kind=real64), public, parameter :: me = 1.00e-20_real64 Functions public  function to_omit (num) Arguments Type Intent Optional Attributes Name integer, intent(in) :: num Return Value logical Subroutines public  subroutine read_intro () Arguments None","tags":"","url":"module/m_parameters.html"},{"title":"m_arrays – HPC DNS Post-Processing Fortran Core","text":"Uses iso_fortran_env m_parameters Variables Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:,:,:) :: u real(kind=real64), public, allocatable, dimension(:,:,:) :: v real(kind=real64), public, allocatable, dimension(:,:,:) :: w real(kind=real64), public, allocatable, dimension(:,:,:) :: y Subroutines public  subroutine m_arrays_init () Arguments None public  subroutine m_arrays_finalize () Arguments None","tags":"","url":"module/m_arrays.html"},{"title":"post – HPC DNS Post-Processing Fortran Core","text":"Uses m_parameters Compact iso_fortran_env m_terms m_calculate m_arrays Subroutines public  subroutine main () Arguments None","tags":"","url":"module/post.html"},{"title":"Compact – HPC DNS Post-Processing Fortran Core","text":"This module handles the generation of tridiagonal/pentadiagonal matrices,\nLU decomposition calculations, and tridiagonal solver operations (such as stdlu, ptdlu, etc.)\nfor periodic and non-periodic boundary conditions. Since compact finite difference schemes\nare implicit, these solvers are implemented internally to perform numerical differentiation\nby solving the implicit relations efficiently. Uses iso_fortran_env Variables Type Visibility Attributes Name Initial real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: lxf real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: lxs real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: wxf real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: wxs real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: lyf real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: lys real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: wyf real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: wys real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: lzf real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: lzs real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: wzf real(kind=real64), public, DIMENSION(:), ALLOCATABLE :: wzs integer, public :: nxc integer, public :: nyc integer, public :: nzc real(kind=real64), public, parameter :: ezero = 1.0e-14 Subroutines public  subroutine ludcmp (nx, ny, nz, xp, yp, zp) Entry point for LU decomposition calculations. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: nx Grid size in x-direction. integer, intent(in) :: ny Grid size in x-direction.\nGrid size in y-direction. integer, intent(in) :: nz Grid size in x-direction.\nGrid size in y-direction.\nGrid size in z-direction. integer, intent(in) :: xp Periodic flag for x-direction (0 = periodic, other = non-periodic). integer, intent(in) :: yp Periodic flag for x-direction (0 = periodic, other = non-periodic).\nPeriodic flag for y-direction (0 = periodic, other = non-periodic). integer, intent(in) :: zp Periodic flag for x-direction (0 = periodic, other = non-periodic).\nPeriodic flag for y-direction (0 = periodic, other = non-periodic).\nPeriodic flag for z-direction (0 = periodic, other = non-periodic). public  subroutine ludcmp_allocate (nx, ny, nz, xp, yp, zp) LU 분해를 위한 포트란 workspace 배열 메모리를 동적 할당하는 서브루틴입니다. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: nx Grid size in x-direction. integer, intent(in) :: ny Grid size in x-direction.\nGrid size in y-direction. integer, intent(in) :: nz Grid size in x-direction.\nGrid size in y-direction.\nGrid size in z-direction. integer, intent(in) :: xp Periodic flag for x-direction (0 = periodic, other = non-periodic). integer, intent(in) :: yp Periodic flag for x-direction (0 = periodic, other = non-periodic).\nPeriodic flag for y-direction (0 = periodic, other = non-periodic). integer, intent(in) :: zp Periodic flag for x-direction (0 = periodic, other = non-periodic).\nPeriodic flag for y-direction (0 = periodic, other = non-periodic).\nPeriodic flag for z-direction (0 = periodic, other = non-periodic). public  subroutine ludcmp_deallocate (xp, yp, zp) Arguments Type Intent Optional Attributes Name integer, intent(in) :: xp integer, intent(in) :: yp integer, intent(in) :: zp public  subroutine ludcmp_testalloc () Arguments None public  subroutine ludcmp_calculate (nx, ny, nz, xp, yp, zp) Arguments Type Intent Optional Attributes Name integer, intent(in) :: nx integer, intent(in) :: ny integer, intent(in) :: nz integer, intent(in) :: xp integer, intent(in) :: yp integer, intent(in) :: zp public  subroutine test_nonp_lud1 (xx, coef) Arguments Type Intent Optional Attributes Name integer :: xx real(kind=real64), intent(out), DIMENSION(xx) :: coef public  subroutine test_nonp_lud2 (xx, coef) Arguments Type Intent Optional Attributes Name integer :: xx real(kind=real64), intent(out), DIMENSION(xx) :: coef public  subroutine test_p_lud1 (xx, coef1, coef2) Arguments Type Intent Optional Attributes Name integer :: xx real(kind=real64), intent(out), DIMENSION(xx) :: coef1 real(kind=real64), intent(out), DIMENSION(xx) :: coef2 public  subroutine test_p_lud2 (xx, coef1, coef2) Arguments Type Intent Optional Attributes Name integer :: xx real(kind=real64), intent(out), DIMENSION(xx) :: coef1 real(kind=real64), intent(out), DIMENSION(xx) :: coef2 public  subroutine nonp_lud (xyz, xx) Arguments Type Intent Optional Attributes Name integer :: xyz integer :: xx public  subroutine p_lud (xyz, xx) Arguments Type Intent Optional Attributes Name integer :: xyz integer :: xx public  subroutine stdlu (a, n, l) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: a (n) integer :: n real(kind=real64), intent(out) :: l (n) public  subroutine ptdlu (a, n, l, w) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: a integer :: n real(kind=real64), intent(out) :: l (n) real(kind=real64), intent(out) :: w (n) public  subroutine rhs1np (n, h, x, dx, nd) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd public  subroutine dfnonp (n, h, x, dx, nd, dir) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd integer, intent(in) :: dir public  subroutine dfp (n, h, x, dx, nd, dir) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd integer, intent(in) :: dir public  subroutine ptdslv (r, n, l, w, nd) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(inout), DIMENSION(nd,n) :: r integer, intent(in) :: n real(kind=real64), intent(in), DIMENSION(n) :: l real(kind=real64), intent(in), DIMENSION(n) :: w integer, intent(in) :: nd public  subroutine d2fp (n, h, x, dx, nd, dir) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd integer, intent(in) :: dir public  subroutine tdslv (r, n, l, nd) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(inout), DIMENSION(nd,n) :: r integer, intent(in) :: n real(kind=real64), intent(in), DIMENSION(n) :: l integer, intent(in) :: nd public  subroutine d2fnonp (n, h, x, dx, nd, dir) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=real64), intent(in) :: h real(kind=real64), intent(in), DIMENSION(nd,n) :: x real(kind=real64), intent(out), DIMENSION(nd,n) :: dx integer, intent(in) :: nd integer, intent(in) :: dir","tags":"","url":"module/compact.html"},{"title":"m_openmpi – HPC DNS Post-Processing Fortran Core","text":"Variables Type Visibility Attributes Name Initial logical, public :: iammaster integer(kind=MPI_INTEGER_KIND), public :: myid_world integer(kind=MPI_INTEGER_KIND), public :: numprocs_world integer(kind=MPI_INTEGER_KIND), public :: numprocs_hydro integer(kind=MPI_INTEGER_KIND), public :: numprocs_stats integer(kind=MPI_INTEGER_KIND), public :: numprocs_parts integer(kind=MPI_INTEGER_KIND), public :: myid integer(kind=MPI_INTEGER_KIND), public :: numprocs integer(kind=MPI_INTEGER_KIND), public :: master integer(kind=MPI_INTEGER_KIND), public :: mpi_err integer(kind=MPI_INTEGER_KIND), public :: mpi_info integer(kind=MPI_INTEGER_KIND), public :: mpi_provide integer(kind=MPI_INTEGER_KIND), public :: id_to integer(kind=MPI_INTEGER_KIND), public :: id_from integer(kind=MPI_INTEGER_KIND), public :: tag integer(kind=MPI_INTEGER_KIND), public :: count integer(kind=MPI_INTEGER_KIND), public :: id_root_hydro integer(kind=MPI_INTEGER_KIND), public :: id_root_stats integer(kind=MPI_INTEGER_KIND), public :: id_root_parts integer(kind=MPI_INTEGER_KIND), public :: MPI_COMM_TASK integer(kind=MPI_INTEGER_KIND), public :: MPI_COMM_ROOTS integer(kind=MPI_INTEGER_KIND), public :: sendtag integer(kind=MPI_INTEGER_KIND), public :: recvtag integer(kind=MPI_INTEGER_KIND), public :: request integer(kind=MPI_INTEGER_KIND), public :: request1 integer(kind=MPI_INTEGER_KIND), public :: request2 integer(kind=MPI_INTEGER_KIND), public :: request3 integer(kind=MPI_INTEGER_KIND), public :: mpi_request integer(kind=MPI_INTEGER_KIND), public :: id_l integer(kind=MPI_INTEGER_KIND), public :: id_r integer(kind=mpi_INTEGER_KIND), public :: mpi_status (MPI_STATUS_SIZE) integer(kind=MPI_INTEGER_KIND), public :: color integer(kind=MPI_INTEGER_KIND), public :: key character(len=5), public :: task character(len=5), public :: split = \"nevah\" character(len=10), public :: run_name_local logical, public :: task_split = .false. Subroutines public  subroutine m_openmpi_init () $    ! The following is put on hold because it looks like a crazy idea Read more… Arguments None public  subroutine m_openmpi_exit () Arguments None public  subroutine openmpi_get_command_line () Arguments None","tags":"","url":"module/m_openmpi.html"},{"title":"m_calculate – HPC DNS Post-Processing Fortran Core","text":"This module calculates spatial derivatives (first and second spatial derivatives in X, Y, Z directions like ddx, ddy, ddz, etc.)\nusing high-order compact finite difference schemes. It also calculates chemical reaction rates,\npositive/negative component extraction, and threshold operations, incorporating memory cache\nefficiency (cache blocking) and transpose optimization operations ( tp2 ). Uses iso_fortran_env m_parameters Compact Functions public  function rxn_rate (c) Computes the chemical reaction rate based on the progress variable c. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64) :: c The progress variable (0.0 to 1.0). Return Value real(kind=real64) public  function threshold_min_max (c, minc, maxc) Arguments Type Intent Optional Attributes Name real(kind=real64) :: c real(kind=real64) :: minc real(kind=real64) :: maxc Return Value real(kind=real64) public  function positive (c) Arguments Type Intent Optional Attributes Name real(kind=real64) :: c Return Value real(kind=real64) public  function negative (c) Arguments Type Intent Optional Attributes Name real(kind=real64) :: c Return Value real(kind=real64) Subroutines public  subroutine m_calculate_init () Initializes the workspace arrays and matrices. Read more… Arguments None public  subroutine m_calculate_finalize () Arguments None public  subroutine ddx1d (dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(1,nxp) :: dst real(kind=real64), intent(in), dimension(1,nxp) :: src public  subroutine ddx (dst, src) Computes the first-order derivative in the X-direction. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst 3D output derivative field (nxp, nyp, nzp). real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src 3D input scalar field (nxp, nyp, nzp). public  subroutine ddy (dst, src) Computes the first-order derivative in the Y-direction. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst 3D output derivative field (nxp, nyp, nzp). real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src 3D input scalar field (nxp, nyp, nzp). public  subroutine ddz (dst, src) Computes the first-order derivative in the Z-direction. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst 3D output derivative field (nxp, nyp, nzp). real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src 3D input scalar field (nxp, nyp, nzp). public  subroutine d2dx1d (dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp) :: dst real(kind=real64), intent(in), dimension(nxp) :: src public  subroutine d2dx (dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src public  subroutine d2dy (dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src public  subroutine d2dz (dst, src) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out), dimension(nxp,nyp,nzp) :: dst real(kind=real64), intent(in), dimension(nxp,nyp,nzp) :: src public  subroutine tp (a, b, nx) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out) :: a (nb,nx) real(kind=real64), intent(in) :: b (nx,nb) integer, intent(in) :: nx public  subroutine tp2 (a, b, n1, n2) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(out) :: a (n1,n2) real(kind=real64), intent(in) :: b (n2,n1) integer, intent(in) :: n1 integer, intent(in) :: n2","tags":"","url":"module/m_calculate.html"},{"title":"post_dns – HPC DNS Post-Processing Fortran Core","text":"Uses post m_openmpi m_build_info Compact Variables Type Attributes Name Initial character(len=100) :: num1char = \"\"","tags":"","url":"program/post_dns.html"},{"title":"test_calculate – HPC DNS Post-Processing Fortran Core","text":"Uses Compact Variables Type Attributes Name Initial real(kind=8), parameter :: pi = 3.14159265358979323846d0 real(kind=8), parameter :: me = 1.00d-20 integer :: nxp integer :: nyp integer :: nzp real(kind=8) :: hxp real(kind=8) :: hyp real(kind=8) :: hzp real(kind=8) :: l_0 real(kind=8), allocatable, dimension(:,:,:) :: aaa real(kind=8), allocatable, dimension(:,:,:) :: bbb real(kind=8), allocatable, dimension(:,:,:) :: ccc real(kind=8), allocatable, dimension(:,:,:) :: ddd real(kind=8), allocatable, dimension(:,:) :: aa real(kind=8), allocatable, dimension(:,:) :: bb real(kind=8), allocatable, dimension(:,:) :: cc real(kind=8), allocatable, dimension(:,:) :: dd real(kind=8), allocatable, dimension(:,:) :: ee integer :: ierr real(kind=8) :: xx real(kind=8) :: yy real(kind=8) :: zz real(kind=8) :: fxyz integer :: i integer :: j integer :: k real(kind=4), dimension(2) :: startt real(kind=4), dimension(2) :: endt real(kind=4) :: result","tags":"","url":"program/test_calculate.html"},{"title":"benchmark_transpose – HPC DNS Post-Processing Fortran Core","text":"Uses m_parameters m_calculate Variables Type Attributes Name Initial real(kind=8), allocatable, dimension(:,:,:) :: aaa real(kind=8), allocatable, dimension(:,:,:) :: bbb integer :: ierr integer :: iter integer :: num_iters real(kind=8) :: t1 real(kind=8) :: t2 character(len=32) :: arg","tags":"","url":"program/benchmark_transpose.html"},{"title":"test_calculate – HPC DNS Post-Processing Fortran Core","text":"Uses m_arrays m_parameters m_calculate Variables Type Attributes Name Initial real(kind=8), allocatable, dimension(:,:,:) :: aaa real(kind=8), allocatable, dimension(:,:,:) :: bbb real(kind=8), allocatable, dimension(:,:,:) :: ccc real(kind=8), allocatable, dimension(:,:,:) :: ddd integer :: ierr real(kind=8) :: xx real(kind=8) :: yy real(kind=8) :: zz real(kind=8) :: fxyz integer :: i integer :: j integer :: k real(kind=4), dimension(2) :: startt real(kind=4), dimension(2) :: endt real(kind=4) :: result","tags":"","url":"program/test_calculate~2.html"},{"title":"test_calculate – HPC DNS Post-Processing Fortran Core","text":"Uses m_parameters m_calculate Variables Type Attributes Name Initial real(kind=8), allocatable, dimension(:,:,:) :: aaa real(kind=8), allocatable, dimension(:,:,:) :: bbb real(kind=8), allocatable, dimension(:,:,:) :: ccc real(kind=8), allocatable, dimension(:,:,:) :: ddd integer :: ierr real(kind=8) :: xx real(kind=8) :: yy real(kind=8) :: zz real(kind=8) :: fxyz integer :: i integer :: j integer :: k real(kind=4), dimension(2) :: startt real(kind=4), dimension(2) :: endt real(kind=4) :: result","tags":"","url":"program/test_calculate~3.html"},{"title":"post_dns.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code ! This code has been written since 2011.01.08 ! This code is written by Dongkyu Lee (THDHRKDG) ! Purpose of this code is to postprocess results of stagnating DNS code PROGRAM post_dns USE m_openmpi USE post USE Compact USE m_build_info IMPLICIT NONE CHARACTER ( 100 ) :: num1char = \"\" !First, make sure the right number of inputs have been provided IF ( COMMAND_ARGUMENT_COUNT () > 1 ) THEN WRITE ( * , * ) 'ERROR, TOO MANY COMMAND-LINE ARGUMENTS(MORE THAN ONE). STOPPING' STOP ELSE IF ( COMMAND_ARGUMENT_COUNT () > 0 ) THEN CALL GET_COMMAND_ARGUMENT ( 1 , num1char ) !first, read in the two values IF ( num1char == \"-h\" ) THEN WRITE ( * , * ) \"usage: x-edge-cold-bc-uPrime-hybrid [-h|-v]\" WRITE ( * , * ) \"\" WRITE ( * , * ) \"optional arguments:\" WRITE ( * , * ) \" -h                show this help message and exit\" WRITE ( * , * ) \" -v                print version information\" WRITE ( * , * ) \" -x                print latex equations\" ELSE IF ( num1char == \"-v\" ) THEN WRITE ( * , * ) trim ( build_info_str ) ELSE IF ( num1char == \"-x\" ) THEN WRITE ( * , * ) trim ( latex_equations_str ) ELSE WRITE ( * , * ) 'ERROR, OPTION NOT SUPPORTED ' , num1char END IF STOP ELSE CALL m_openmpi_init if ( iammaster ) write ( * , * ) trim ( build_info_str ) CALL main CALL m_openmpi_exit ENDIF END PROGRAM","tags":"","url":"sourcefile/post_dns.f90.html"},{"title":"m_parameters.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code module m_parameters use , intrinsic :: iso_fortran_env , only : real64 use m_openmpi implicit none integer :: nxp , nyp , nzp real ( real64 ) :: hxp , hyp , hzp real ( real64 ) :: l_0 integer :: startnum , endnum , skipnum , shiftnum real ( real64 ) :: scp , prp , lep , vis0p , rod real ( real64 ) :: prof_wr , min_wr , min_fsd , min_c , refwr real ( real64 ) :: pre , ac , bc , c_cut , c_ref integer :: syp , eyp , twod real ( real64 ) :: SL_u integer :: omitnum integer , allocatable :: omit_t (:,:) integer , allocatable :: file_dist (:) integer , allocatable :: export_offset (:) real ( real64 ), parameter :: pi = 3.14159265358979323846_real64 real ( real64 ), parameter :: me = 1.00e-20_real64 contains logical function to_omit ( num ) integer , intent ( in ) :: num integer :: i to_omit = . false . do i = 1 , omitnum if ( num . ge . omit_t ( i , 1 ). and . num . le . omit_t ( i , 2 )) then to_omit = . true . endif enddo end function to_omit subroutine read_intro character ( LEN = 10 ) :: cdum integer :: ierr , i integer :: first_file integer :: file_count real * 8 :: tmp1 , tmp2 , tmp3 open ( 100 , FILE = 'post-edge-cold-bc-hybrid-intro' ) open ( 101 , FILE = 'otape' ) read ( 100 , * ) cdum , l_0 write ( 101 , * ) cdum , l_0 read ( 100 , * ) cdum , startnum write ( 101 , * ) cdum , startnum read ( 100 , * ) cdum , endnum write ( 101 , * ) cdum , endnum read ( 100 , * ) cdum , skipnum write ( 101 , * ) cdum , skipnum read ( 100 , * ) cdum , shiftnum write ( 101 , * ) cdum , shiftnum read ( 100 , * ) cdum , vis0p write ( 101 , * ) cdum , vis0p read ( 100 , * ) cdum , scp write ( 101 , * ) cdum , scp read ( 100 , * ) cdum , lep write ( 101 , * ) cdum , lep read ( 100 , * ) cdum , min_wr write ( 101 , * ) cdum , min_wr read ( 100 , * ) cdum , prof_wr write ( 101 , * ) cdum , prof_wr read ( 100 , * ) cdum , min_fsd write ( 101 , * ) cdum , min_fsd read ( 100 , * ) cdum , min_c write ( 101 , * ) cdum , min_c read ( 100 , * ) cdum , pre write ( 101 , * ) cdum , pre read ( 100 , * ) cdum , ac write ( 101 , * ) cdum , ac read ( 100 , * ) cdum , bc write ( 101 , * ) cdum , bc read ( 100 , * ) cdum , c_cut write ( 101 , * ) cdum , c_cut read ( 100 , * ) cdum , c_ref write ( 101 , * ) cdum , c_ref read ( 100 , * ) cdum , syp write ( 101 , * ) cdum , syp read ( 100 , * ) cdum , eyp write ( 101 , * ) cdum , eyp read ( 100 , * ) cdum , SL_u write ( 101 , * ) cdum , SL_u read ( 100 , * ) cdum , omitnum write ( 101 , * ) cdum , omitnum if ( omitnum . gt . 0 ) THEN allocate ( omit_t ( omitnum , 2 ), stat = ierr ) do i = 1 , omitnum read ( 100 , * ) cdum , omit_t ( i , 1 ) ! begining fullsave number write ( 101 , * ) cdum , omit_t ( i , 1 ) read ( 100 , * ) cdum , omit_t ( i , 2 ) ! ending fullsave number write ( 101 , * ) cdum , omit_t ( i , 2 ) enddo endif prp = scp / lep refwr = pre * 1. * exp ( - ac / ( 1. + bc * c_ref )) ! wrate at c_ref rod = vis0p / prp / lep ! vis0p dynamic viscosity, rod= density*mass diffusivity = rho*D close ( 100 ) close ( 101 ) allocate ( file_dist ( startnum : endnum ), stat = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of file_dist failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if allocate ( export_offset ( startnum : endnum ), stat = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of export_offset failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if file_count = 0 distloop : DO i = startnum , endnum , skipnum IF ( . not . to_omit ( i ) ) THEN file_dist ( i ) = mod ( file_count , numprocs ) export_offset ( i ) = file_count file_count = file_count + 1 ENDIF ENDDO distloop first_file = startnum fileloop : DO i = startnum , endnum , skipnum IF ( . not . to_omit ( i ) ) THEN first_file = i exit fileloop ENDIF ENDDO fileloop OPEN ( first_file , FORM = 'unformatted' , STATUS = 'unknown' ) READ ( first_file ) tmp1 , nxp , nyp , nzp , tmp2 , tmp3 CLOSE ( first_file ) hyp = l_0 * pi / REAL ( nyp ) hxp = hyp hzp = hyp end subroutine read_intro end module m_parameters","tags":"","url":"sourcefile/m_parameters.f90.html"},{"title":"m_arrays.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code module m_arrays use , intrinsic :: iso_fortran_env , only : real64 use m_parameters implicit none real ( real64 ), allocatable , dimension (:,:,:) :: u , v , w , y contains subroutine m_arrays_init integer :: ierr ALLOCATE ( u ( nxp , nyp , nzp ), STAT = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of u failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if u = 0. ALLOCATE ( v ( nxp , nyp , nzp ), STAT = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of v failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if v = 0. ALLOCATE ( w ( nxp , nyp , nzp ), STAT = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of w failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if w = 0. ALLOCATE ( y ( nxp , nyp , nzp ), STAT = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of y failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if y = 0. end subroutine m_arrays_init subroutine m_arrays_finalize DEALLOCATE ( u ) DEALLOCATE ( v ) DEALLOCATE ( w ) DEALLOCATE ( y ) end subroutine m_arrays_finalize end module m_arrays","tags":"","url":"sourcefile/m_arrays.f90.html"},{"title":"post.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code MODULE post use , intrinsic :: iso_fortran_env , only : real64 USE Compact USE m_parameters USE m_calculate USE m_arrays USE m_terms IMPLICIT NONE PRIVATE INTEGER :: countnum INTEGER :: nprogress INTEGER :: ipass INTEGER :: num_ ! hybrid real ( real64 ) :: tnow real ( real64 ), DIMENSION (:,:,:,:), ALLOCATABLE :: old_scalar , new_scalar PUBLIC :: main CONTAINS SUBROUTINE main INTEGER :: fread , i INTEGER , PARAMETER :: eofread = - 1 ipass = 0 CALL READ_INTRO CALL ALLOCATE_ARRAYS if ( iammaster ) CALL PRINT_BANNER ! PASS 1 ipass = 1 nprogress = 0 countnum = 0 if ( numprocs . eq . 1 ) then firstloop_serial : DO fread = startnum , endnum , skipnum IF ( to_omit ( fread ) ) THEN CALL PRINT_SKIP_LOG ( fread ) ELSE countnum = countnum + 1 nprogress = nprogress + 1 CALL READ_FILE ( fread ) CALL m_terms_calculate_pass1 ( fread ) END IF END DO firstloop_serial else tag = 1 if ( iammaster ) then dispatchloop1 : DO fread = startnum , endnum , skipnum IF ( to_omit ( fread ) ) THEN CALL PRINT_SKIP_LOG ( fread ) ELSE countnum = countnum + 1 CALL MPI_RECV ( id_to , 1 , MPI_INTEGER , MPI_ANY_SOURCE , tag , MPI_COMM_TASK , mpi_status , mpi_err ) CALL MPI_SEND ( fread , 1 , MPI_INTEGER8 , id_to , tag , MPI_COMM_TASK , mpi_err ) ENDIF END DO dispatchloop1 end_of_dispatch1 : DO i = 1 , numprocs - 1 CALL MPI_RECV ( id_to , 1 , MPI_INTEGER , MPI_ANY_SOURCE , tag , MPI_COMM_TASK , mpi_status , mpi_err ) CALL MPI_SEND ( eofread , 1 , MPI_INTEGER8 , id_to , tag , MPI_COMM_TASK , mpi_err ) END DO end_of_dispatch1 else fetchloop1 : do CALL MPI_SEND ( myid , 1 , MPI_INTEGER , master , tag , MPI_COMM_TASK , mpi_err ) CALL MPI_RECV ( fread , 1 , MPI_INTEGER8 , master , tag , MPI_COMM_TASK , mpi_status , mpi_err ) if ( fread < 0 ) exit nprogress = nprogress + 1 CALL READ_FILE ( fread ) CALL m_terms_calculate_pass1 ( fread ) end do fetchloop1 end if CALL MPI_BCAST ( countnum , 1 , MPI_INTEGER8 , master , MPI_COMM_TASK , mpi_err ) end if CALL m_terms_average_pass1 ( countnum ) if ( iammaster ) write ( * , * ) '1st loop finished' ! PASS 2 optional_pass2 : IF ( pass2_required ) THEN ipass = 2 nprogress = 0 if ( numprocs . eq . 1 ) then secondloop_serial : DO fread = startnum , endnum , skipnum IF ( to_omit ( fread ) ) THEN CALL PRINT_SKIP_LOG ( fread ) ELSE nprogress = nprogress + 1 CALL READ_FILE ( fread ) CALL m_terms_calculate_pass2 ( fread ) END IF END DO secondloop_serial else tag = 2 if ( iammaster ) then dispatchloop2 : DO fread = startnum , endnum , skipnum IF ( to_omit ( fread ) ) THEN CALL PRINT_SKIP_LOG ( fread ) ELSE CALL MPI_RECV ( id_to , 1 , MPI_INTEGER , MPI_ANY_SOURCE , tag , MPI_COMM_TASK , mpi_status , mpi_err ) CALL MPI_SEND ( fread , 1 , MPI_INTEGER8 , id_to , tag , MPI_COMM_TASK , mpi_err ) ENDIF END DO dispatchloop2 end_of_dispatch2 : DO i = 1 , numprocs - 1 CALL MPI_RECV ( id_to , 1 , MPI_INTEGER , MPI_ANY_SOURCE , tag , MPI_COMM_TASK , mpi_status , mpi_err ) CALL MPI_SEND ( eofread , 1 , MPI_INTEGER8 , id_to , tag , MPI_COMM_TASK , mpi_err ) END DO end_of_dispatch2 else fetchloop2 : do CALL MPI_SEND ( myid , 1 , MPI_INTEGER , master , tag , MPI_COMM_TASK , mpi_err ) CALL MPI_RECV ( fread , 1 , MPI_INTEGER8 , master , tag , MPI_COMM_TASK , mpi_status , mpi_err ) if ( fread < 0 ) exit nprogress = nprogress + 1 CALL READ_FILE ( fread ) CALL m_terms_calculate_pass2 ( fread ) end do fetchloop2 end if end if CALL m_terms_average_pass2 ( countnum ) ENDIF optional_pass2 if ( iammaster ) then CALL m_terms_write_result WRITE ( * , * ) ' Avergaing RAW data is FINISHED' WRITE ( * , * ) 'qEdge_X.dat is generated' end if CALL DEALLOCATES_CLOSE END SUBROUTINE main SUBROUTINE PRINT_SKIP_LOG ( fread ) INTEGER , INTENT ( IN ) :: fread INTEGER :: idx WRITE ( * , '(a47,i7,a4,i5,a3,i5)' ) & ' Current fullsavenum = ' , fread , ' || ' , ( fread - startnum + 1 ), ' / ' , ( endnum - startnum + 1 ) DO idx = 1 , omitnum IF ( fread . ge . omit_t ( idx , 1 ) . and . fread . le . omit_t ( idx , 2 )) THEN WRITE ( * , '(a12,i6,a20,i6)' ) & '      Skip. ' , omit_t ( idx , 1 ), ' <= fullsavenum <= ' , omit_t ( idx , 2 ) EXIT END IF END DO END SUBROUTINE PRINT_SKIP_LOG !======================================================================================== ! End of main routine !======================================================================================== SUBROUTINE PRINT_BANNER WRITE ( * , * ) ' This program, x-edge-cold-bc-5-hybrid, is written by D. Kim, 2018' WRITE ( * , * ) ' It is to study the statistics of the flame parameters at the leading edge' WRITE ( * , * ) ' in turbulent premixed flames.' WRITE ( * , '(a40,i5,a11,i5,a1)' ) '  Postprocess will be done from \"FORT.' , startnum , '\" to \"FORT.' , endnum , '\"' END SUBROUTINE PRINT_BANNER SUBROUTINE READ_FILE ( num ) INTEGER , INTENT ( IN ) :: num real ( real64 ), DIMENSION ( 2 ) :: tmpr INTEGER :: nx , ny , nz real ( real64 ) :: tmp1 , tmp2 real ( real64 ) :: dt , dummyu INTEGER :: ncyc INTEGER :: u_num CHARACTER ( len = 64 ) :: filename character ( len = 30 ) :: date integer :: date_values ( 8 ) WRITE ( filename , '(A,I0)' ) 'fort.' , num OPEN ( newunit = u_num , FILE = trim ( filename ), FORM = 'unformatted' , STATUS = 'unknown' ) READ ( u_num ) tnow , nx , ny , nz , tmp1 , tmp2 IF (( nx . ne . nxp ) . or . ( ny . ne . nyp ) . or . ( nz . ne . nzp )) THEN WRITE ( 0 , * ) \"Array dimension mismatch\" , nx , ny , nz , \" != \" , nxp , nyp , nzp STOP - 1 ENDIF READ ( u_num ) ncyc , dt , dummyu READ ( u_num ) tmpr ( 1 : 2 ) READ ( u_num ) tmpr ( 1 : 2 ) READ ( u_num ) tmpr ( 1 : 2 ) num_ = num IF ( num . le . shiftnum ) THEN ! WRITE(*,*) '    with an old fort data from Nueman-0X' READ ( u_num ) u , v , w , old_scalar y (:,:,:) = old_scalar ( 2 ,:,:,:) ELSE ! WRITE(*,*) '    with a new fort data from Comb-Cluster' READ ( u_num ) u , v , w , new_scalar u = u + dummyu y = new_scalar (:,:,:, 2 ) ENDIF CLOSE ( u_num ) call date_and_time ( values = date_values ) write ( date , '(I4.4,\"-\",I2.2,\"-\",I2.2,\" \",I2.2,\":\",I2.2,\":\",I2.2)' ) & date_values ( 1 ), date_values ( 2 ), date_values ( 3 ), & date_values ( 5 ), date_values ( 6 ), date_values ( 7 ) WRITE ( * , '(a,a,i2,a,i1,a,i4,a,i4,a,i4)' ) & date , \"PID\" , myid , \"|PASS\" , ipass , \"|fort.\" , num , & \"|\" , nprogress , \"/\" , endnum - startnum + 1 END SUBROUTINE READ_FILE SUBROUTINE ALLOCATE_ARRAYS INTEGER :: ierr CALL m_arrays_init CALL m_calculate_init CALL m_terms_init ALLOCATE ( old_scalar ( 2 , nxp , nyp , nzp ), STAT = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of old_scalar failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if old_scalar = 0. ! Main variables ALLOCATE ( new_scalar ( nxp , nyp , nzp , 2 ), STAT = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of new_scalar failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if new_scalar = 0. WRITE ( * , '(a6,i3,a8,i3,a8,i3)' ) '  NX = ' , nxp , ' / NY = ' , nyp , ' / NZ = ' , nzp WRITE ( * , * ) ' Preparing memory space for COMPACT SCHEME' ! CALL ludcmp(nxp,nyp,nzp,1,0,0)      ! 1,1,0 WRITE ( * , '(a22,i3,a3,i3,a4,i3)' ) '  Grid number range : ' , syp , ' ~ ' , eyp , ' of ' , nyp WRITE ( * , * ) END SUBROUTINE ALLOCATE_ARRAYS SUBROUTINE DEALLOCATES_CLOSE CALL m_arrays_finalize CALL m_calculate_finalize CALL m_terms_finalize DEALLOCATE ( old_scalar ) DEALLOCATE ( new_scalar ) IF ( omitnum . gt . 0 ) DEALLOCATE ( omit_t ) DEALLOCATE ( file_dist ) DEALLOCATE ( export_offset ) END SUBROUTINE DEALLOCATES_CLOSE END MODULE post","tags":"","url":"sourcefile/post.f90.html"},{"title":"test_compact.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code program test_calculate use Compact implicit none real * 8 , parameter :: pi = 3.14159265358979323846d0 real * 8 , parameter :: me = 1.00d-20 integer :: nxp , nyp , nzp real * 8 :: hxp , hyp , hzp real * 8 :: l_0 real * 8 , allocatable , dimension (:,:,:) :: aaa , bbb , ccc , ddd real * 8 , allocatable , dimension (:,:) :: aa , bb , cc , dd , ee integer :: ierr real * 8 :: xx , yy , zz , fxyz integer :: i , j , k real * 4 , dimension ( 2 ) :: startt real * 4 , dimension ( 2 ) :: endt real * 4 :: result nxp = 512 nyp = 256 nzp = 256 l_0 = 2.0d0 hyp = l_0 * pi / REAL ( nyp ) hxp = hyp hzp = hyp allocate ( aa ( 1 , nxp ), stat = ierr ); aa = 0.0 allocate ( bb ( 1 , nxp ), stat = ierr ); bb = 0.0 allocate ( cc ( 1 , nxp ), stat = ierr ); cc = 0.0 allocate ( dd ( 1 , nxp ), stat = ierr ); dd = 0.0 allocate ( ee ( 1 , nxp ), stat = ierr ); ee = 0.0 allocate ( aaa ( nxp , nyp , nzp ), stat = ierr ); aaa = 0.0 allocate ( bbb ( nxp , nyp , nzp ), stat = ierr ); bbb = 0.0 allocate ( ccc ( nxp , nyp , nzp ), stat = ierr ); ccc = 0.0 allocate ( ddd ( nxp , nyp , nzp ), stat = ierr ); ddd = 0.0 call ludcmp ( nxp , nyp , nzp , 1 , 0 , 0 ) do i = 1 , nxp xx = dfloat ( i - 1 ) * hxp aa ( 1 , i ) = sin ( 1.1d0 * xx ) dd ( 1 , i ) = 1.1d0 * cos ( 1.1d0 * xx ) end do call rhs1np ( nxp , hxp , aa , bb , 1 ) call dfnonp ( nxp , hxp , aa , cc , 1 , 1 ) print * , lxf print * , lxs print * , aa print * , bb print * , cc print * , dd ee = (( cc - dd ) / dd ) write ( * , * ) \"relerr_min_max\" , minval ( ee ( 1 , nxp / 4 : 3 * nxp / 4 )), maxval ( ee ( 1 , nxp / 4 : 3 * nxp / 4 )) write ( * , * ) \"relerr_min_max\" , minval ( ee ), maxval ( ee ) write ( * , * ) \"  exact_min_max\" , minval ( dd ), maxval ( dd ) write ( * , * ) \"compact_min_max\" , minval ( cc ), maxval ( cc ) write ( * , * ) \"test ddx\" do k = 1 , nzp do j = 1 , nyp do i = 1 , nxp xx = i * hxp yy = j * hyp zz = k * hzp aaa ( i , j , k ) = sin ( 1.1 * xx ) * sin ( 3.0 * yy ) * sin ( 2.0 * zz ) end do end do end do do k = 1 , nzp do j = 1 , nyp call dfnonp ( nxp , hxp , aaa (:, j , k ), bbb (:, j , k ), 1 , 1 ) end do end do do k = 1 , nzp do j = 1 , nyp do i = 1 , nxp ! nxp/4,3*nxp/4 xx = i * hxp yy = j * hyp zz = k * hzp fxyz = ( 1.1 * cos ( 1.1 * xx ) * sin ( 3.0 * yy ) * sin ( 2.0 * zz )) ccc ( i , j , k ) = ( bbb ( i , j , k ) - fxyz ) / ( fxyz ) if (( abs ( ccc ( i , j , k )) > 0.01 ) . and . ( abs ( bbb ( i , j , k )) > 1.0e-14 )) write ( * , * ) bbb ( i , j , k ), fxyz end do end do end do write ( * , * ) \"relerr_min_max\" , minval ( ccc ), maxval ( ccc ) deallocate ( aa ) deallocate ( bb ) deallocate ( cc ) deallocate ( dd ) deallocate ( ee ) deallocate ( aaa ) deallocate ( bbb ) deallocate ( ccc ) deallocate ( ddd ) end program","tags":"","url":"sourcefile/test_compact.f90.html"},{"title":"benchmark_transpose.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code program benchmark_transpose use m_parameters use m_calculate implicit none real * 8 , allocatable , dimension (:,:,:) :: aaa , bbb integer :: ierr , iter , num_iters real * 8 :: t1 , t2 character ( len = 32 ) :: arg ! Read command-line arguments for grid sizes if ( command_argument_count () >= 3 ) then call get_command_argument ( 1 , arg ) read ( arg , * ) nxp call get_command_argument ( 2 , arg ) read ( arg , * ) nyp call get_command_argument ( 3 , arg ) read ( arg , * ) nzp else ! Default matching test_calculate nxp = 512 nyp = 256 nzp = 256 end if ! Read iteration count num_iters = 10 if ( command_argument_count () >= 4 ) then call get_command_argument ( 4 , arg ) read ( arg , * ) num_iters end if l_0 = 2.0 hyp = l_0 * pi / REAL ( nyp ) hxp = hyp hzp = hyp allocate ( aaa ( nxp , nyp , nzp ), stat = ierr ) if ( ierr /= 0 ) then print * , \"Error allocating array aaa\" stop 1 end if allocate ( bbb ( nxp , nyp , nzp ), stat = ierr ) if ( ierr /= 0 ) then print * , \"Error allocating array bbb\" stop 1 end if ! Initialize dummy data call random_number ( aaa ) call m_calculate_init ! Warmup run call ddx ( bbb , aaa ) ! Benchmark runs call cpu_time ( t1 ) do iter = 1 , num_iters call ddx ( bbb , aaa ) end do call cpu_time ( t2 ) ! Print execution time per call in seconds print '(F10.6)' , ( t2 - t1 ) / num_iters call m_calculate_finalize deallocate ( aaa ) deallocate ( bbb ) end program benchmark_transpose","tags":"","url":"sourcefile/benchmark_transpose.f90.html"},{"title":"test_field.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code program test_calculate use m_parameters use m_calculate use m_arrays implicit none real * 8 , allocatable , dimension (:,:,:) :: aaa , bbb , ccc , ddd integer :: ierr real * 8 :: xx , yy , zz , fxyz integer :: i , j , k real * 4 , dimension ( 2 ) :: startt real * 4 , dimension ( 2 ) :: endt real * 4 :: result nxp = 512 nyp = 256 nzp = 256 l_0 = 2.0 hyp = l_0 * pi / REAL ( nyp ) hxp = hyp hzp = hyp allocate ( aaa ( nxp , nyp , nzp ), stat = ierr ); aaa = 0.0 allocate ( bbb ( nxp , nyp , nzp ), stat = ierr ); bbb = 0.0 allocate ( ccc ( nxp , nyp , nzp ), stat = ierr ); ccc = 0.0 allocate ( ddd ( nxp , nyp , nzp ), stat = ierr ); ddd = 0.0 call m_arrays_init call m_calculate_init call READ_FILE ( 1000 ) write ( * , * ) \"dimension - \" , nxp , nyp , nzp write ( * , * ) \"spacing   - \" , hxp , hyp , hzp do k = 1 , nzp do j = 1 , nyp do i = 1 , nxp xx = i * hxp yy = j * hyp zz = k * hzp aaa ( i , j , k ) = sin ( 1.1 * xx ) * sin ( 3.0 * yy ) * sin ( 2.0 * zz ) end do end do end do write ( * , * ) \"test ddx\" call ETIME ( startt , result ) call ddx ( bbb , y ) call ETIME ( endt , result ) print * , \"usert\" , endt ( 1 ) - startt ( 1 ) print * , \"systt\" , endt ( 2 ) - startt ( 2 ) do k = 1 , nzp do j = 1 , nyp do i = nxp / 4 , 3 * nxp / 4 xx = i * hxp yy = j * hyp zz = k * hzp fxyz = ( 1.1 * cos ( 1.1 * xx ) * sin ( 3.0 * yy ) * sin ( 2.0 * zz )) ccc ( i , j , k ) = ( bbb ( i , j , k ) - fxyz ) / ( fxyz ) ! if ((abs(ccc(i,j,k)) > 0.01 ) .and. (abs(bbb(i,j,k)) > 1.0e-14 )) write(*,*) bbb(i,j,k), fxyz end do end do end do write ( * , * ) \"relerr_min_max\" , minval ( ccc ), maxval ( ccc ) OPEN ( 2000 , FORM = 'unformatted' , STATUS = 'unknown' ) write ( 2000 ) bbb CLOSE ( 2000 ) call m_calculate_finalize deallocate ( aaa ) deallocate ( bbb ) deallocate ( ccc ) deallocate ( ddd ) end program !=============================================================================== SUBROUTINE READ_FILE ( num ) use m_parameters use m_arrays REAL * 8 :: old_scalar ( 2 , nxp , nyp , nzp ) REAL * 8 :: new_scalar ( nxp , nyp , nzp , 2 ) INTEGER , INTENT ( IN ) :: num REAL , DIMENSION ( 2 ) :: tmpr INTEGER :: nx , ny , nz REAL :: tmp1 , tmp2 REAL :: dt , dummyu INTEGER :: ncyc REAL * 4 :: e , t ( 2 ) REAL * 4 :: e0 , t0 ( 2 ) REAL * 4 :: e1 , t1 ( 2 ) e0 = etime ( t0 ) OPEN ( num , FORM = 'unformatted' , STATUS = 'unknown' ) READ ( num ) tnow , nx , ny , nz , tmp1 , tmp2 IF (( nx . ne . nxp ) . or . ( ny . ne . nyp ) . or . ( nz . ne . nzp )) THEN WRITE ( 0 , * ) \"Array dimension mismatch\" , nx , ny , nz , \" != \" , nxp , nyp , nzp STOP - 1 ENDIF READ ( num ) ncyc , dt , dummyu READ ( num ) tmpr ( 1 : 2 ) READ ( num ) tmpr ( 1 : 2 ) READ ( num ) tmpr ( 1 : 2 ) num_ = num IF ( num . le . shiftnum ) THEN ! WRITE(*,*) '    with an old fort data from Nueman-0X' READ ( num ) u , v , w , old_scalar y (:,:,:) = old_scalar ( 2 ,:,:,:) ELSE ! WRITE(*,*) '    with a new fort data from Comb-Cluster' READ ( num ) u , v , w , new_scalar u = u + dummyu y = new_scalar (:,:,:, 2 ) ENDIF CLOSE ( num ) e = etime ( t ) WRITE ( * , '(a,i2,a,i1,a,i4,a,i4,a,i4,a,f8.2,a,f8.2,a,f8.2)' ) & \"PID\" , myid , \"|PASS\" , ipass , \"|fort.\" , num , & \"|\" , nprogress , \"/\" , endnum - startnum + 1 , & \"|E:\" , e , \"|U:\" , t ( 1 ), \"|S:\" , t ( 2 ) END SUBROUTINE READ_FILE SUBROUTINE WRITE_FILE ( num ) use m_parameters use m_arrays REAL * 8 :: old_scalar ( 2 , nxp , nyp , nzp ) REAL * 8 :: new_scalar ( nxp , nyp , nzp , 2 ) INTEGER , INTENT ( IN ) :: num REAL , DIMENSION ( 2 ) :: tmpr INTEGER :: nx , ny , nz REAL :: tmp1 , tmp2 REAL :: dt , dummyu INTEGER :: ncyc REAL * 4 :: e , t ( 2 ) REAL * 4 :: e0 , t0 ( 2 ) REAL * 4 :: e1 , t1 ( 2 ) e0 = etime ( t0 ) OPEN ( num , FORM = 'unformatted' , STATUS = 'unknown' ) READ ( num ) tnow , nx , ny , nz , tmp1 , tmp2 IF (( nx . ne . nxp ) . or . ( ny . ne . nyp ) . or . ( nz . ne . nzp )) THEN WRITE ( 0 , * ) \"Array dimension mismatch\" , nx , ny , nz , \" != \" , nxp , nyp , nzp STOP - 1 ENDIF READ ( num ) ncyc , dt , dummyu READ ( num ) tmpr ( 1 : 2 ) READ ( num ) tmpr ( 1 : 2 ) READ ( num ) tmpr ( 1 : 2 ) num_ = num IF ( num . le . shiftnum ) THEN ! WRITE(*,*) '    with an old fort data from Nueman-0X' READ ( num ) u , v , w , old_scalar y (:,:,:) = old_scalar ( 2 ,:,:,:) ELSE ! WRITE(*,*) '    with a new fort data from Comb-Cluster' READ ( num ) u , v , w , new_scalar u = u + dummyu y = new_scalar (:,:,:, 2 ) ENDIF CLOSE ( num ) e = etime ( t ) WRITE ( * , '(a,i2,a,i1,a,i4,a,i4,a,i4,a,f8.2,a,f8.2,a,f8.2)' ) & \"PID\" , myid , \"|PASS\" , ipass , \"|fort.\" , num , & \"|\" , nprogress , \"/\" , endnum - startnum + 1 , & \"|E:\" , e , \"|U:\" , t ( 1 ), \"|S:\" , t ( 2 ) END SUBROUTINE WRITE_FILE","tags":"","url":"sourcefile/test_field.f90.html"},{"title":"Compact.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code !> @author Ignis !> @brief High-order compact finite difference scheme (generalized Padé scheme) solver with specific order of accuracy. !! !! This module handles the generation of tridiagonal/pentadiagonal matrices, !! LU decomposition calculations, and tridiagonal solver operations (such as stdlu, ptdlu, etc.) !! for periodic and non-periodic boundary conditions. Since compact finite difference schemes !! are implicit, these solvers are implemented internally to perform numerical differentiation !! by solving the implicit relations efficiently. MODULE Compact use , intrinsic :: iso_fortran_env , only : real64 IMPLICIT NONE real ( real64 ), DIMENSION (:), ALLOCATABLE :: lxf , lxs , wxf , wxs , & !< x-방향 LU Decomposition 밴드 계수 lyf , lys , wyf , wys , & !< y-방향 LU Decomposition 밴드 계수 lzf , lzs , wzf , wzs !< z-방향 LU Decomposition 밴드 계수 INTEGER :: nxc , nyc , nzc !< 각 방향의 실제 격자 사이즈 수치 (x, y, z) real ( real64 ), PARAMETER :: ezero = 1.0e-14 CONTAINS !> Entry point for LU decomposition calculations. !! !! Prepares the workspace allocations and runs the decomposition calculation for all three directions. !! !! @param nx Grid size in x-direction. !! @param ny Grid size in y-direction. !! @param nz Grid size in z-direction. !! @param xp Periodic flag for x-direction (0 = periodic, other = non-periodic). !! @param yp Periodic flag for y-direction (0 = periodic, other = non-periodic). !! @param zp Periodic flag for z-direction (0 = periodic, other = non-periodic). SUBROUTINE ludcmp ( nx , ny , nz , xp , yp , zp ) INTEGER , INTENT ( IN ) :: nx , ny , nz INTEGER , INTENT ( IN ) :: xp , yp , zp INTEGER :: ierr nxc = nx nyc = ny nzc = nz CALL ludcmp_allocate ( nx , ny , nz , xp , yp , zp ) CALL ludcmp_calculate ( nx , ny , nz , xp , yp , zp ) END SUBROUTINE ludcmp !> LU 분해를 위한 포트란 workspace 배열 메모리를 동적 할당하는 서브루틴입니다. !! !! 경계 조건(xp, yp, zp = 0 주기적 경계 조건, 1 비주기적 경계 조건)에 따라 배열 크기와 !! 할당 여부를 결정하며, 할당에 실패하면 에러를 출력하고 즉시 프로그램을 안전하게 종료(STOP)시킵니다. !! !! @param nx Grid size in x-direction. !! @param ny Grid size in y-direction. !! @param nz Grid size in z-direction. !! @param xp Periodic flag for x-direction (0 = periodic, other = non-periodic). !! @param yp Periodic flag for y-direction (0 = periodic, other = non-periodic). !! @param zp Periodic flag for z-direction (0 = periodic, other = non-periodic). SUBROUTINE ludcmp_allocate ( nx , ny , nz , xp , yp , zp ) include 'mpif.h' INTEGER , INTENT ( IN ) :: nx , ny , nz INTEGER , INTENT ( IN ) :: xp , yp , zp INTEGER :: ierr INTEGER :: mpi_err_abort nxc = nx nyc = ny nzc = nz !       IF(nyc /= nzc) PRINT*,'ny should be equal nz' !      xp, yp, zp = 0 : periodic ALLOCATE ( lxf ( nxc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF ALLOCATE ( lxs ( nxc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF IF ( xp . eq . 0 ) THEN ALLOCATE ( wxf ( nxc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF ALLOCATE ( wxs ( nxc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF ENDIF ALLOCATE ( lyf ( nyc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF ALLOCATE ( lys ( nyc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF IF ( yp . eq . 0 ) THEN ALLOCATE ( wyf ( nyc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF ALLOCATE ( wys ( nyc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF ENDIF ALLOCATE ( lzf ( nzc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF ALLOCATE ( lzs ( nzc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF IF ( zp . eq . 0 ) THEN ALLOCATE ( wzf ( nzc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' CALL MPI_ABORT ( MPI_COMM_WORLD , 1 , mpi_err_abort ) ENDIF ALLOCATE ( wzs ( nzc ), STAT = ierr ) IF ( ierr /= 0 ) THEN PRINT * , 'work array for lud allocation failed' STOP 1 ENDIF ENDIF END SUBROUTINE ludcmp_allocate SUBROUTINE ludcmp_deallocate ( xp , yp , zp ) INTEGER , INTENT ( IN ) :: xp , yp , zp !       IF(nyc /= nzc) PRINT*,'ny should be equal nz' !      xp, yp, zp = 0 : periodic DEALLOCATE ( lxf ) DEALLOCATE ( lxs ) IF ( xp . eq . 0 ) THEN DEALLOCATE ( wxf ) DEALLOCATE ( wxs ) ENDIF DEALLOCATE ( lyf ) DEALLOCATE ( lys ) IF ( yp . eq . 0 ) THEN DEALLOCATE ( wyf ) DEALLOCATE ( wys ) ENDIF DEALLOCATE ( lzf ) DEALLOCATE ( lzs ) IF ( zp . eq . 0 ) THEN DEALLOCATE ( wzf ) DEALLOCATE ( wzs ) ENDIF END SUBROUTINE ludcmp_deallocate SUBROUTINE ludcmp_testalloc IF (. not . ALLOCATED ( lxf )) print * , \"lxf not allocated\" IF (. not . ALLOCATED ( lxs )) print * , \"lxs not allocated\" IF (. not . ALLOCATED ( wxf )) print * , \"wxf not allocated\" IF (. not . ALLOCATED ( wxs )) print * , \"wxs not allocated\" IF (. not . ALLOCATED ( lyf )) print * , \"lyf not allocated\" IF (. not . ALLOCATED ( lys )) print * , \"lys not allocated\" IF (. not . ALLOCATED ( wyf )) print * , \"wyf not allocated\" IF (. not . ALLOCATED ( wys )) print * , \"wys not allocated\" IF (. not . ALLOCATED ( lzf )) print * , \"lzf not allocated\" IF (. not . ALLOCATED ( lzs )) print * , \"lzs not allocated\" IF (. not . ALLOCATED ( wzf )) print * , \"wzf not allocated\" IF (. not . ALLOCATED ( wzs )) print * , \"wzs not allocated\" END SUBROUTINE ludcmp_testalloc SUBROUTINE ludcmp_calculate ( nx , ny , nz , xp , yp , zp ) INTEGER , INTENT ( IN ) :: nx , ny , nz INTEGER , INTENT ( IN ) :: xp , yp , zp INTEGER :: ierr nxc = nx nyc = ny nzc = nz ! CALL ludcmp_testalloc !       IF(nyc /= nzc) PRINT*,'ny should be equal nz' !      xp, yp, zp = 0 : periodic IF ( xp . eq . 0 ) THEN CALL p_lud ( 1 , nxc ) ELSE CALL nonp_lud ( 1 , nxc ) ENDIF IF ( yp . eq . 0 ) THEN CALL p_lud ( 2 , nyc ) ELSE call nonp_lud ( 2 , nyc ) ENDIF IF ( zp . eq . 0 ) THEN CALL p_lud ( 3 , nzc ) ELSE call nonp_lud ( 3 , nzc ) ENDIF END SUBROUTINE ludcmp_calculate SUBROUTINE test_nonp_lud1 ( xx , coef ) INTEGER :: xx real ( real64 ), DIMENSION ( xx ) :: aa real ( real64 ), DIMENSION ( xx ), INTENT ( OUT ) :: coef aa = 3. aa ( 1 ) = 0.5 ; aa ( 2 ) = 4. aa ( xx - 1 ) = 4. ; aa ( xx ) = 0.5 CALL stdlu ( aa , xx , coef ) END SUBROUTINE test_nonp_lud1 SUBROUTINE test_nonp_lud2 ( xx , coef ) INTEGER :: xx real ( real64 ), DIMENSION ( xx ) :: aa real ( real64 ), DIMENSION ( xx ), INTENT ( OUT ) :: coef aa = 5.5 aa ( 1 ) = 2. / 1 1. ; aa ( 2 ) = 1 0. aa ( xx - 1 ) = 1 0. ; aa ( xx ) = 2. / 1 1. CALL stdlu ( aa , xx , coef ) END SUBROUTINE test_nonp_lud2 SUBROUTINE test_p_lud1 ( xx , coef1 , coef2 ) INTEGER :: xx real ( real64 ) :: a real ( real64 ), DIMENSION ( xx ), INTENT ( OUT ) :: coef1 , coef2 a = 3. ! first derivative CALL ptdlu ( a , xx , coef1 , coef2 ) ! x-direction END SUBROUTINE test_p_lud1 SUBROUTINE test_p_lud2 ( xx , coef1 , coef2 ) INTEGER :: xx real ( real64 ) :: a real ( real64 ), DIMENSION ( xx ), INTENT ( OUT ) :: coef1 , coef2 a = 1 1. / 2. ! second derivative CALL ptdlu ( a , xx , coef1 , coef2 ) ! x-direction END SUBROUTINE test_p_lud2 SUBROUTINE nonp_lud ( xyz , xx ) INTEGER :: xyz , xx real ( real64 ), DIMENSION ( xx ) :: aa aa = 3. aa ( 1 ) = 0.5 ; aa ( 2 ) = 4. aa ( xx - 1 ) = 4. ; aa ( xx ) = 0.5 ! first derivative IF ( xyz . eq . 1 ) CALL stdlu ( aa , xx , lxf ) ! x-direction IF ( xyz . eq . 2 ) CALL stdlu ( aa , xx , lyf ) ! y-direction IF ( xyz . eq . 3 ) CALL stdlu ( aa , xx , lzf ) ! z-direction aa = 5.5 aa ( 1 ) = 2. / 1 1. ; aa ( 2 ) = 1 0. aa ( xx - 1 ) = 1 0. ; aa ( xx ) = 2. / 1 1. ! second derivative IF ( xyz . eq . 1 ) CALL stdlu ( aa , xx , lxs ) ! x-direction IF ( xyz . eq . 2 ) CALL stdlu ( aa , xx , lys ) ! y-direction IF ( xyz . eq . 3 ) CALL stdlu ( aa , xx , lzs ) ! z-direction END SUBROUTINE nonp_lud SUBROUTINE p_lud ( xyz , xx ) INTEGER :: xyz , xx real ( real64 ) :: a a = 3. ! first derivative IF ( xyz . eq . 1 ) CALL ptdlu ( a , xx , lxf , wxf ) ! x-direction IF ( xyz . eq . 2 ) CALL ptdlu ( a , xx , lyf , wyf ) ! y-direction IF ( xyz . eq . 3 ) CALL ptdlu ( a , xx , lzf , wzf ) ! z-direction a = 1 1. / 2. ! second derivative IF ( xyz . eq . 1 ) CALL ptdlu ( a , xx , lxs , wxs ) ! x-direction IF ( xyz . eq . 2 ) CALL ptdlu ( a , xx , lys , wys ) ! y-direction IF ( xyz . eq . 3 ) CALL ptdlu ( a , xx , lzs , wzs ) ! z-direction END SUBROUTINE p_lud SUBROUTINE stdlu ( a , n , l ) INTEGER :: n real ( real64 ), INTENT ( IN ) :: a ( n ) real ( real64 ), INTENT ( OUT ) :: l ( n ) real ( real64 ) :: d INTEGER :: i l ( 1 ) = 1.0d0 / a ( 1 ) DO i = 2 , n d = a ( i ) - l ( i - 1 ) l ( i ) = 1.0d0 / d ENDDO END SUBROUTINE stdlu SUBROUTINE ptdlu ( a , n , l , w ) INTEGER :: n real ( real64 ), INTENT ( IN ) :: a real ( real64 ), INTENT ( OUT ) :: l ( n ), w ( n ) INTEGER :: i real ( real64 ) :: aa ( n ), d DO i = 1 , n - 1 aa ( i ) = a ENDDO i = n - 1 call stdlu ( aa , i , l ) w ( 1 ) = 1.0 DO i = 2 , n - 2 w ( i ) =- l ( i - 1 ) * w ( i - 1 ) ENDDO w ( n - 1 ) = 1.0 - l ( n - 2 ) * w ( n - 2 ) DO i = 1 , n - 1 w ( i ) = w ( i ) * l ( i ) ENDDO d = a DO i = 1 , n - 1 d = d - w ( i ) * w ( i ) / l ( i ) ENDDO l ( n ) = 1. / d END SUBROUTINE ptdlu SUBROUTINE rhs1np ( n , h , x , dx , nd ) INTEGER , INTENT ( IN ) :: n , nd real ( real64 ), INTENT ( IN ) :: h real ( real64 ), INTENT ( IN ), DIMENSION ( nd , n ) :: x real ( real64 ), INTENT ( OUT ), DIMENSION ( nd , n ) :: dx INTEGER :: i , j real ( real64 ) :: r1 , r2 , r3 , a , b , c , h1 , t1 , t2 , t3 , t4 h1 = 1.d0 / h r1 = 7.d0 / 3.d0 r2 = 1.d0 / 1 2.d0 r3 = 3. a =- 1.25 b = 1. c = 0.25 DO j = 1 , nd dx ( j , n - 1 ) = x ( j , n ) - x ( j , n - 2 ) dx ( j , n ) =- ( a * x ( j , n ) + b * x ( j , n - 1 ) + c * x ( j , n - 2 )) dx ( j , 1 ) = ( a * x ( j , 1 ) + b * x ( j , 2 ) + c * x ( j , 3 )) dx ( j , 2 ) = x ( j , 3 ) - x ( j , 1 ) IF ( x ( j , n ). eq . x ( j , n - 1 ). and . x ( j , n - 1 ). eq . x ( j , n - 2 )) dx ( j , n ) = 0. IF ( x ( j , 1 ). eq . x ( j , 2 ). and . x ( j , 2 ). eq . x ( j , 3 )) dx ( j , 1 ) = 0. dx ( j , n - 1 ) = dx ( j , n - 1 ) * h1 * r3 dx ( j , n ) = dx ( j , n ) * h1 dx ( j , 1 ) = dx ( j , 1 ) * h1 dx ( j , 2 ) = dx ( j , 2 ) * h1 * r3 ENDDO DO i = 3 , n - 2 DO j = 1 , nd t1 = x ( j , i + 1 ) - x ( j , i - 1 ) t2 = x ( j , i + 2 ) - x ( j , i - 2 ) dx ( j , i ) = h1 * ( r1 * t1 + r2 * t2 ) ENDDO ENDDO END SUBROUTINE rhs1np SUBROUTINE dfnonp ( n , h , x , dx , nd , dir ) INTEGER , INTENT ( IN ) :: n , nd , dir real ( real64 ), INTENT ( IN ) :: h real ( real64 ), INTENT ( IN ), DIMENSION ( nd , n ) :: x real ( real64 ), INTENT ( OUT ), DIMENSION ( nd , n ) :: dx INTEGER :: i , j real ( real64 ) :: r1 , r2 , r3 , a , b , c , h1 , t1 , t2 , t3 , t4 CALL rhs1np ( n , h , x , dx , nd ) IF ( dir . eq . 1 ) CALL tdslv ( dx , n , lxf , nd ) ! x-direction IF ( dir . eq . 2 ) CALL tdslv ( dx , n , lyf , nd ) ! y-direction IF ( dir . eq . 3 ) CALL tdslv ( dx , n , lzf , nd ) ! z-direction END SUBROUTINE dfnonp SUBROUTINE dfp ( n , h , x , dx , nd , dir ) INTEGER , INTENT ( IN ) :: n , nd , dir real ( real64 ), INTENT ( IN ) :: h real ( real64 ), INTENT ( IN ), DIMENSION ( nd , n ) :: x real ( real64 ), INTENT ( OUT ), DIMENSION ( nd , n ) :: dx INTEGER :: i , j real ( real64 ) :: r1 , r2 , h1 ! print *, \"dfnonp received (nd,n)\", nd, n h1 = 1. / h r1 = 7. / 3. r2 = 1. / 1 2. DO j = 1 , nd dx ( j , n - 1 ) = ( r1 * ( x ( j , n ) - x ( j , n - 2 )) + r2 * ( x ( j , 1 ) - x ( j , n - 3 ))) dx ( j , n ) = ( r1 * ( x ( j , 1 ) - x ( j , n - 1 )) + r2 * ( x ( j , 2 ) - x ( j , n - 2 ))) dx ( j , 1 ) = ( r1 * ( x ( j , 2 ) - x ( j , n )) + r2 * ( x ( j , 3 ) - x ( j , n - 1 ))) dx ( j , 2 ) = ( r1 * ( x ( j , 3 ) - x ( j , 1 )) + r2 * ( x ( j , 4 ) - x ( j , n ))) dx ( j , n - 1 ) = dx ( j , n - 1 ) * h1 dx ( j , n ) = dx ( j , n ) * h1 dx ( j , 1 ) = dx ( j , 1 ) * h1 dx ( j , 2 ) = dx ( j , 2 ) * h1 ENDDO DO i = 3 , n - 2 DO j = 1 , nd dx ( j , i ) = ( r1 * ( x ( j , i + 1 ) - x ( j , i - 1 )) + r2 * ( x ( j , i + 2 ) - x ( j , i - 2 ))) dx ( j , i ) = dx ( j , i ) * h1 ENDDO ENDDO IF ( dir . eq . 1 ) CALL ptdslv ( dx , n , lxf , wxf , nd ) ! x-direction IF ( dir . eq . 2 ) CALL ptdslv ( dx , n , lyf , wyf , nd ) ! y-direction IF ( dir . eq . 3 ) CALL ptdslv ( dx , n , lzf , wzf , nd ) ! z-direction END SUBROUTINE dfp SUBROUTINE ptdslv ( r , n , l , w , nd ) INTEGER , INTENT ( IN ) :: n , nd real ( real64 ), INTENT ( INOUT ), DIMENSION ( nd , n ) :: r real ( real64 ), INTENT ( IN ), DIMENSION ( n ) :: l , w INTEGER i , j real ( real64 ), DIMENSION ( nd ) :: sum DO j = 1 , nd sum ( j ) = w ( 1 ) * r ( j , 1 ) r ( j , 1 ) = r ( j , 1 ) * l ( 1 ) ENDDO DO i = 2 , n - 1 DO j = 1 , nd r ( j , i ) = r ( j , i ) - r ( j , i - 1 ) sum ( j ) = sum ( j ) + w ( i ) * r ( j , i ) r ( j , i ) = r ( j , i ) * l ( i ) ENDDO ENDDO DO j = 1 , nd r ( j , n ) = l ( n ) * ( r ( j , n ) - sum ( j )) r ( j , n - 1 ) = r ( j , n - 1 ) - w ( n - 1 ) * r ( j , n ) ENDDO DO i = n - 2 , 1 , - 1 DO j = 1 , nd r ( j , i ) = r ( j , i ) - l ( i ) * r ( j , i + 1 ) - w ( i ) * r ( j , n ) ENDDO ENDDO END SUBROUTINE ptdslv SUBROUTINE d2fp ( n , h , x , dx , nd , dir ) INTEGER , INTENT ( IN ) :: n , nd , dir real ( real64 ), INTENT ( IN ) :: h real ( real64 ), INTENT ( IN ), DIMENSION ( nd , n ) :: x real ( real64 ), INTENT ( OUT ), DIMENSION ( nd , n ) :: dx INTEGER :: i , j real ( real64 ) :: h2 , r1 , r2 , t1 , t2 h2 = 1. / ( h * h ) r1 = 6. r2 = 3. / 8. DO j = 1 , nd t1 = ( x ( j , n ) - 2. * x ( j , n - 1 ) + x ( j , n - 2 )) t2 = ( x ( j , 1 ) - 2. * x ( j , n - 1 ) + x ( j , n - 3 )) IF ( x ( j , n ). eq . x ( j , n - 1 ). and . x ( j , n - 1 ). eq . x ( j , n - 2 )) t1 = 0. IF ( x ( j , 1 ). eq . x ( j , n - 1 ). and . x ( j , n - 1 ). eq . x ( j , n - 3 )) t2 = 0. dx ( j , n - 1 ) = ( r1 * t1 + r2 * t2 ) t1 = ( x ( j , 1 ) - 2. * x ( j , n ) + x ( j , n - 1 )) t2 = ( x ( j , 2 ) - 2. * x ( j , n ) + x ( j , n - 2 )) IF ( x ( j , 1 ). eq . x ( j , n ). and . x ( j , n ). eq . x ( j , n - 1 )) t1 = 0. IF ( x ( j , 2 ). eq . x ( j , n ). and . x ( j , n ). eq . x ( j , n - 2 )) t2 = 0. !        dx(j,n)=(r1*(x(j,1)-2.*x(j,n)+x(j,n-1)) & !               +r2*(x(j,2)-2.*x(j,n)+x(j,n-2))) dx ( j , n ) = ( r1 * t1 + r2 * t2 ) t1 = ( x ( j , 2 ) - 2. * x ( j , 1 ) + x ( j , n )) t2 = ( x ( j , 3 ) - 2. * x ( j , 1 ) + x ( j , n - 1 )) IF ( x ( j , 2 ). eq . x ( j , 1 ). and . x ( j , 1 ). eq . x ( j , n )) t1 = 0. IF ( x ( j , 3 ). eq . x ( j , 1 ). and . x ( j , 1 ). eq . x ( j , n - 1 )) t2 = 0. !        dx(j,1)=(r1*(x(j,2)-2.*x(j,1)+x(j,n)) & !               +r2*(x(j,3)-2.*x(j,1)+x(j,n-1))) dx ( j , 1 ) = ( r1 * t1 + r2 * t2 ) t1 = ( x ( j , 3 ) - 2. * x ( j , 2 ) + x ( j , 1 )) t2 = ( x ( j , 4 ) - 2. * x ( j , 2 ) + x ( j , n )) IF ( x ( j , 3 ). eq . x ( j , 2 ). and . x ( j , 2 ). eq . x ( j , 1 )) t1 = 0. IF ( x ( j , 4 ). eq . x ( j , 2 ). and . x ( j , 2 ). eq . x ( j , n )) t2 = 0. !        dx(j,2)=(r1*(x(j,3)-2.*x(j,2)+x(j,1)) & !               +r2*(x(j,4)-2.*x(j,2)+x(j,n))) dx ( j , 2 ) = ( r1 * t1 + r2 * t2 ) dx ( j , n - 1 ) = dx ( j , n - 1 ) * h2 dx ( j , n ) = dx ( j , n ) * h2 dx ( j , 1 ) = dx ( j , 1 ) * h2 dx ( j , 2 ) = dx ( j , 2 ) * h2 ENDDO DO i = 3 , n - 2 DO j = 1 , nd t1 = ( x ( j , i + 1 ) - 2. * x ( j , i ) + x ( j , i - 1 )) t2 = ( x ( j , i + 2 ) - 2. * x ( j , i ) + x ( j , i - 2 )) IF ( x ( j , i + 1 ). eq . x ( j , i ). and . x ( j , i ). eq . x ( j , i - 1 )) t1 = 0. IF ( x ( j , i + 2 ). eq . x ( j , i ). and . x ( j , i ). eq . x ( j , i - 2 )) t2 = 0. !        dx(j,i)=(r1*(x(j,i+1)-2.*x(j,i)+x(j,i-1)) & !               +r2*(x(j,i+2)-2.*x(j,i)+x(j,i-2))) dx ( j , i ) = ( r1 * t1 + r2 * t2 ) dx ( j , i ) = dx ( j , i ) * h2 ENDDO ENDDO IF ( dir . eq . 1 ) CALL ptdslv ( dx , n , lxs , wxs , nd ) ! x-direction IF ( dir . eq . 2 ) CALL ptdslv ( dx , n , lys , wys , nd ) ! y-direction IF ( dir . eq . 3 ) CALL ptdslv ( dx , n , lzs , wzs , nd ) ! z-direction END SUBROUTINE d2fp SUBROUTINE tdslv ( r , n , l , nd ) INTEGER , INTENT ( IN ) :: n , nd real ( real64 ), INTENT ( INOUT ), DIMENSION ( nd , n ) :: r real ( real64 ), INTENT ( IN ), DIMENSION ( n ) :: l INTEGER i , j real ( real64 ) t1 DO j = 1 , nd r ( j , 1 ) = r ( j , 1 ) * l ( 1 ) ENDDO DO i = 2 , n DO j = 1 , nd t1 = r ( j , i ) - r ( j , i - 1 ) r ( j , i ) = l ( i ) * t1 ENDDO ENDDO DO i = n - 1 , 1 , - 1 DO j = 1 , nd r ( j , i ) = r ( j , i ) - l ( i ) * r ( j , i + 1 ) ENDDO ENDDO END SUBROUTINE tdslv SUBROUTINE d2fnonp ( n , h , x , dx , nd , dir ) INTEGER , INTENT ( IN ) :: n , nd , dir real ( real64 ), INTENT ( IN ) :: h real ( real64 ), INTENT ( IN ), DIMENSION ( nd , n ) :: x real ( real64 ), INTENT ( OUT ), DIMENSION ( nd , n ) :: dx INTEGER :: i , j real ( real64 ) :: h2 , r1 , r2 , r3 , a , b , c , e , t1 , t2 h2 = 1. / ( h * h ) r1 = 6. r2 = 3. / 8. r3 = 1 2. a = 1 3. / 1 1. b =- 2 7. / 1 1. c = 1 5. / 1 1. e =- 1. / 1 1. DO j = 1 , nd dx ( j , 1 ) = ( a * x ( j , 1 ) + b * x ( j , 2 ) + c * x ( j , 3 ) + e * x ( j , 4 )) dx ( j , 2 ) = ( x ( j , 3 ) - 2. * x ( j , 2 ) + x ( j , 1 )) dx ( j , n - 1 ) = ( x ( j , n ) - 2. * x ( j , n - 1 ) + x ( j , n - 2 )) dx ( j , n ) = ( a * x ( j , n ) + b * x ( j , n - 1 ) + c * x ( j , n - 2 ) + e * x ( j , n - 3 )) IF ( x ( j , 1 ). eq . x ( j , 2 ). and . x ( j , 2 ). eq . x ( j , 3 ). and . x ( j , 3 ). eq . x ( j , 4 )) dx ( j , 1 ) = 0. IF ( x ( j , 3 ). eq . x ( j , 2 ). and . x ( j , 2 ). eq . x ( j , 1 )) dx ( j , 2 ) = 0. IF ( x ( j , n ). eq . x ( j , n - 1 ). and . x ( j , n - 1 ). eq . x ( j , n - 2 ). and . x ( j , n - 2 ). eq . x ( j , n - 3 )) dx ( j , n ) = 0. IF ( x ( j , n ). eq . x ( j , n - 1 ). and . x ( j , n - 1 ). eq . x ( j , n - 2 )) dx ( j , n - 1 ) = 0. dx ( j , 1 ) = dx ( j , 1 ) * h2 dx ( j , 2 ) = dx ( j , 2 ) * h2 * r3 dx ( j , n - 1 ) = dx ( j , n - 1 ) * h2 * r3 dx ( j , n ) = dx ( j , n ) * h2 ENDDO DO i = 3 , n - 2 DO j = 1 , nd t1 = ( x ( j , i + 1 ) - 2. * x ( j , i ) + x ( j , i - 1 )) t2 = ( x ( j , i + 2 ) - 2. * x ( j , i ) + x ( j , i - 2 )) IF ( x ( j , i + 1 ). eq . x ( j , i ). and . x ( j , i ). eq . x ( j , i - 1 )) t1 = 0. IF ( x ( j , i + 2 ). eq . x ( j , i ). and . x ( j , i ). eq . x ( j , i - 2 )) t2 = 0. !        dx(j,i)=(r1*(x(j,i+1)-2.*x(j,i)+x(j,i-1)) & !               +r2*(x(j,i+2)-2.*x(j,i)+x(j,i-2))) dx ( j , i ) = ( r1 * t1 + r2 * t2 ) dx ( j , i ) = dx ( j , i ) * h2 ENDDO ENDDO IF ( dir . eq . 1 ) CALL tdslv ( dx , n , lxs , nd ) ! x-direction IF ( dir . eq . 2 ) CALL tdslv ( dx , n , lys , nd ) ! y-direction IF ( dir . eq . 3 ) CALL tdslv ( dx , n , lzs , nd ) ! z-direction END SUBROUTINE d2fnonp END MODULE Compact","tags":"","url":"sourcefile/compact.f90.html"},{"title":"m_openmpi.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code !================================================================================ ! Module contains interface to OpenMPI ! ! Time-stamp: <2009-08-20 14:22:13 (chumakov)> !================================================================================ module m_openmpi !================================================================================ implicit none include 'mpif.h' ! Uncomment this for the systems that do not have OpenMPI ! In OpenMPI, the parameter MPI_INTEGER_KIND is defined in 'mpif.h' ! With other MPI implementations, this parameter has to be defined manually. ! integer MPI_INTEGER_KIND ! parameter (MPI_INTEGER_KIND = 4) ! --- MPI variables logical :: iammaster integer ( kind = MPI_INTEGER_KIND ) :: myid_world , numprocs_world integer ( kind = MPI_INTEGER_KIND ) :: numprocs_hydro , numprocs_stats , numprocs_parts integer ( kind = MPI_INTEGER_KIND ) :: myid , numprocs , master , mpi_err , mpi_info , mpi_provide integer ( kind = MPI_INTEGER_KIND ) :: id_to , id_from , tag , count integer ( kind = MPI_INTEGER_KIND ) :: id_root_hydro , id_root_stats , id_root_parts ! communicator for separate tasks integer ( kind = MPI_INTEGER_KIND ) :: MPI_COMM_TASK ! exclusive communicator for root processes of tasks integer ( kind = MPI_INTEGER_KIND ) :: MPI_COMM_ROOTS integer ( kind = MPI_INTEGER_KIND ) :: sendtag , recvtag integer ( kind = MPI_INTEGER_KIND ) :: request , request1 , request2 , request3 , mpi_request integer ( kind = MPI_INTEGER_KIND ) :: id_l , id_r integer ( kind = mpi_INTEGER_KIND ) :: mpi_status ( MPI_STATUS_SIZE ) integer ( kind = MPI_INTEGER_KIND ) :: color , key character * 5 :: task , split = \"nevah\" character * 10 :: run_name_local logical :: task_split = . false . !================================================================================ contains !================================================================================ subroutine m_openmpi_init implicit none integer ( kind = mpi_INTEGER_KIND ) :: n integer * 4 :: np_local integer :: i ! first getting the run name form the command line ! (it's local, not  global run_name) ! also getting the parameter \"split\" which governs the process splitting: ! split=\"split\" means that hydro, statistics and particles are assigned three ! separate process groups (they differ by the char*5 parameter \"task\"). ! split=\"never\" (default if the parameter is missing) means that all ! processes do all tasks. (does not work for the particles at this point) ! call openmpi_get_command_line ! initializing MPI environment !call MPI_INIT_THREAD(MPI_THREAD_SERIALIZED, mpi_provide, mpi_err) call MPI_INIT ( mpi_err ) call MPI_Comm_size ( MPI_COMM_WORLD , numprocs_world , mpi_err ) call MPI_Comm_rank ( MPI_COMM_WORLD , myid_world , mpi_err ) !-------------------------------------------------------------------------------- !  Looking at the command line parameter called \"split\".  If it equals \"split\" !  then we define task_split=.true.  If not, task_split remains .false. (default) !-------------------------------------------------------------------------------- if ( split == \"split\" ) task_split = . true . !-------------------------------------------------------------------------------- !  First check if we need to do any task splitting.  If we don't (split=\"never\") !  then we define task=\"hydro\" and do a ficticious split with uniform color of !  all processors. !-------------------------------------------------------------------------------- task = 'hydro' color = 0 myid = myid_world call MPI_COMM_SPLIT ( MPI_COMM_WORLD , color , myid , MPI_COMM_TASK , mpi_err ) call MPI_COMM_SIZE ( MPI_COMM_TASK , numprocs , mpi_err ) call MPI_COMM_RANK ( MPI_COMM_TASK , myid , mpi_err ) ! each task will have its master process master = 0 iammaster = . false . if ( myid . eq . master ) iammaster = . true . !!$    ! The following is put on hold because it looks like a crazy idea !!$    ! now creating separate exclusive communicator for the master nodes only !!$    ! the name of the new communicator is MPI_COMM_ROOTS !!$    ! if we want quickly broadcast something, then we can use two BCAST calls !!$    color = 1 !!$    if (iammaster) color = 0 !!$    call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid_world,MPI_COMM_ROOTS,mpi_err) return end subroutine m_openmpi_init !================================================================================ subroutine m_openmpi_exit call MPI_COMM_FREE ( MPI_COMM_TASK , mpi_err ) call MPI_FINALIZE ( mpi_err ) return end subroutine m_openmpi_exit !================================================================================ subroutine openmpi_get_command_line implicit none character ( len = 80 ) :: tmp_str ! reading the run_name from the command line if ( command_argument_count (). eq . 0 ) then call get_command_argument ( 0 , tmp_str ) print * , 'Format: ' , trim ( tmp_str ), ' (run name) [\"split\"/\"never\"]' stop end if call get_command_argument ( 1 , run_name_local ) if ( len_trim ( run_name_local ). ne . 10 ) then print * , 'Run name: \"' , run_name_local , '\"' print * , '          \"1234567890\"' print * , 'Length of run name is less than 10, sorry.' stop end if ! getting the split parameter, if it's there if ( command_argument_count (). eq . 2 ) call get_command_argument ( 2 , split ) end subroutine openmpi_get_command_line !================================================================================ end module m_openmpi","tags":"","url":"sourcefile/m_openmpi.f90.html"},{"title":"test_calculate.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code program test_calculate use m_parameters use m_calculate implicit none real * 8 , allocatable , dimension (:,:,:) :: aaa , bbb , ccc , ddd integer :: ierr real * 8 :: xx , yy , zz , fxyz integer :: i , j , k real * 4 , dimension ( 2 ) :: startt real * 4 , dimension ( 2 ) :: endt real * 4 :: result nxp = 512 nyp = 256 nzp = 256 l_0 = 2.0 hyp = l_0 * pi / REAL ( nyp ) hxp = hyp hzp = hyp allocate ( aaa ( nxp , nyp , nzp ), stat = ierr ); aaa = 0.0 allocate ( bbb ( nxp , nyp , nzp ), stat = ierr ); bbb = 0.0 allocate ( ccc ( nxp , nyp , nzp ), stat = ierr ); ccc = 0.0 allocate ( ddd ( nxp , nyp , nzp ), stat = ierr ); ddd = 0.0 call m_calculate_init write ( * , * ) \"dimension - \" , nxp , nyp , nzp write ( * , * ) \"spacing   - \" , hxp , hyp , hzp do k = 1 , nzp do j = 1 , nyp do i = 1 , nxp xx = i * hxp yy = j * hyp zz = k * hzp aaa ( i , j , k ) = sin ( 1.1 * xx ) * sin ( 3.0 * yy ) * sin ( 2.0 * zz ) end do end do end do write ( * , * ) \"test ddx\" call ETIME ( startt , result ) call ddx ( bbb , aaa ) call ETIME ( endt , result ) print * , \"usert\" , endt ( 1 ) - startt ( 1 ) print * , \"systt\" , endt ( 2 ) - startt ( 2 ) do k = 1 , nzp do j = 1 , nyp do i = nxp / 4 , 3 * nxp / 4 xx = i * hxp yy = j * hyp zz = k * hzp fxyz = ( 1.1 * cos ( 1.1 * xx ) * sin ( 3.0 * yy ) * sin ( 2.0 * zz )) ccc ( i , j , k ) = ( bbb ( i , j , k ) - fxyz ) / ( fxyz ) if (( abs ( ccc ( i , j , k )) > 0.01 ) . and . ( abs ( bbb ( i , j , k )) > 1.0e-14 )) write ( * , * ) bbb ( i , j , k ), fxyz end do end do end do write ( * , * ) \"relerr_min_max\" , minval ( ccc ), maxval ( ccc ) write ( * , * ) \"test ddy\" call ETIME ( startt , result ) call ddy ( bbb , aaa ) call ETIME ( endt , result ) print * , \"usert\" , endt ( 1 ) - startt ( 1 ) print * , \"systt\" , endt ( 2 ) - startt ( 2 ) do k = 1 , nzp do j = 1 , nyp do i = nxp / 4 , 3 * nxp / 4 xx = i * hxp yy = j * hyp zz = k * hzp fxyz = ( 3.0 * sin ( 1.1 * xx ) * cos ( 3.0 * yy ) * sin ( 2.0 * zz )) ccc ( i , j , k ) = ( bbb ( i , j , k ) - fxyz ) / ( fxyz ) if (( abs ( ccc ( i , j , k )) > 0.01 ) . and . ( abs ( bbb ( i , j , k )) > 1.0e-14 )) write ( * , * ) bbb ( i , j , k ), fxyz end do end do end do write ( * , * ) \"relerr_min_max\" , minval ( ccc ), maxval ( ccc ) write ( * , * ) \"test ddz\" call ETIME ( startt , result ) call ddz ( bbb , aaa ) call ETIME ( endt , result ) print * , \"usert\" , endt ( 1 ) - startt ( 1 ) print * , \"systt\" , endt ( 2 ) - startt ( 2 ) do k = 1 , nzp do j = 1 , nyp do i = nxp / 4 , 3 * nxp / 4 xx = i * hxp yy = j * hyp zz = k * hzp fxyz = ( 2.0 * sin ( 1.1 * xx ) * sin ( 3.0 * yy ) * cos ( 2.0 * zz )) ccc ( i , j , k ) = ( bbb ( i , j , k ) - fxyz ) / ( fxyz ) if (( abs ( ccc ( i , j , k )) > 0.01 ) . and . ( abs ( bbb ( i , j , k )) > 1.0e-14 )) write ( * , * ) bbb ( i , j , k ), fxyz end do end do end do write ( * , * ) \"relerr_min_max\" , minval ( ccc ), maxval ( ccc ) write ( * , * ) \"test d2dx\" call ETIME ( startt , result ) call d2dx ( bbb , aaa ) call ETIME ( endt , result ) print * , \"usert\" , endt ( 1 ) - startt ( 1 ) print * , \"systt\" , endt ( 2 ) - startt ( 2 ) do k = 1 , nzp do j = 1 , nyp do i = nxp / 4 , 3 * nxp / 4 xx = i * hxp yy = j * hyp zz = k * hzp fxyz = - ( 1.21 * sin ( 1.1 * xx ) * sin ( 3.0 * yy ) * sin ( 2.0 * zz )) ccc ( i , j , k ) = ( bbb ( i , j , k ) - fxyz ) / ( fxyz ) if (( abs ( ccc ( i , j , k )) > 0.01 ) . and . ( abs ( fxyz ) > 1.0e-14 )) write ( * , * ) bbb ( i , j , k ), fxyz end do end do end do write ( * , * ) \"relerr_min_max\" , minval ( ccc ), maxval ( ccc ) write ( * , * ) \"test d2dy\" call ETIME ( startt , result ) call d2dy ( bbb , aaa ) call ETIME ( endt , result ) print * , \"usert\" , endt ( 1 ) - startt ( 1 ) print * , \"systt\" , endt ( 2 ) - startt ( 2 ) do k = 1 , nzp do j = 1 , nyp do i = nxp / 4 , 3 * nxp / 4 xx = i * hxp yy = j * hyp zz = k * hzp fxyz = - ( 9.0 * sin ( 1.1 * xx ) * sin ( 3.0 * yy ) * sin ( 2.0 * zz )) ccc ( i , j , k ) = ( bbb ( i , j , k ) - fxyz ) / ( fxyz ) if (( abs ( ccc ( i , j , k )) > 0.01 ) . and . ( abs ( fxyz ) > 1.0e-14 )) write ( * , * ) bbb ( i , j , k ), fxyz end do end do end do write ( * , * ) \"relerr_min_max\" , minval ( ccc ), maxval ( ccc ) write ( * , * ) \"test d2dz\" call ETIME ( startt , result ) call d2dz ( bbb , aaa ) call ETIME ( endt , result ) print * , \"usert\" , endt ( 1 ) - startt ( 1 ) print * , \"systt\" , endt ( 2 ) - startt ( 2 ) do k = 1 , nzp do j = 1 , nyp do i = nxp / 4 , 3 * nxp / 4 xx = i * hxp yy = j * hyp zz = k * hzp fxyz = - ( 4.0 * sin ( 1.1 * xx ) * sin ( 3.0 * yy ) * sin ( 2.0 * zz )) ccc ( i , j , k ) = ( bbb ( i , j , k ) - fxyz ) / ( fxyz ) if (( abs ( ccc ( i , j , k )) > 0.01 ) . and . ( abs ( fxyz ) > 1.0e-14 )) write ( * , * ) bbb ( i , j , k ), fxyz end do end do end do write ( * , * ) \"relerr_min_max\" , minval ( ccc ), maxval ( ccc ) call m_calculate_finalize deallocate ( aaa ) deallocate ( bbb ) deallocate ( ccc ) deallocate ( ddd ) end program","tags":"","url":"sourcefile/test_calculate.f90.html"},{"title":"m_calculate.f90 – HPC DNS Post-Processing Fortran Core","text":"Source Code !> @author Google DeepMind Team & Ignis !> @brief DNS post-processing mathematical operations and derivatives, matching appropriate compact schemes in X, Y, Z directions for a defined flow domain and optimizing calculations from a cache perspective. !! !! This module calculates spatial derivatives (first and second spatial derivatives in X, Y, Z directions like ddx, ddy, ddz, etc.) !! using high-order compact finite difference schemes. It also calculates chemical reaction rates, !! positive/negative component extraction, and threshold operations, incorporating memory cache !! efficiency (cache blocking) and transpose optimization operations (`tp2`). module m_calculate use , intrinsic :: iso_fortran_env , only : real64 use Compact use m_parameters implicit none real ( real64 ), allocatable , dimension (:,:) :: xsrc real ( real64 ), allocatable , dimension (:,:) :: xdst real ( real64 ), allocatable , dimension (:,:) :: rsrc real ( real64 ), allocatable , dimension (:,:) :: rdst integer , parameter :: nb = BLOCKSIZE private :: nb private :: xsrc , xdst , rsrc , rdst contains !> Initializes the workspace arrays and matrices. !! !! Pre-allocates transposed workspace buffers (`xsrc`, `xdst`, `rsrc`, `rdst`) !! and performs the LU decomposition setup via `ludcmp` for the tridiagonal compact schemes. subroutine m_calculate_init integer :: ierr call ludcmp ( nxp , nyp , nzp , 1 , 0 , 0 ) ! 1,1,0 allocate ( xsrc ( nb , nxp ), stat = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of xsrc failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if allocate ( xdst ( nb , nxp ), stat = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of xdst failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if allocate ( rsrc ( nxp , nzp ), stat = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of rsrc failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if allocate ( rdst ( nxp , nzp ), stat = ierr ) if ( ierr /= 0 ) then write ( 0 , * ) \"Error: allocation of rdst failed on process\" , myid call MPI_ABORT ( MPI_COMM_TASK , 1 , mpi_err ) end if end subroutine m_calculate_init subroutine m_calculate_finalize deallocate ( xsrc ) deallocate ( xdst ) deallocate ( rsrc ) deallocate ( rdst ) end subroutine m_calculate_finalize subroutine ddx1d ( dst , src ) real ( real64 ), dimension ( 1 , nxp ), intent ( in ) :: src real ( real64 ), dimension ( 1 , nxp ), intent ( out ) :: dst call dfnonp ( nxp , hxp , src , dst , 1 , 1 ) end subroutine ddx1d !> Computes the first-order derivative in the X-direction. !! !! @param src 3D input scalar field (nxp, nyp, nzp). !! @param dst 3D output derivative field (nxp, nyp, nzp). subroutine ddx ( dst , src ) real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( in ) :: src real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( out ) :: dst integer :: i , j , k integer :: ju do k = 1 , nzp do j = 1 , nyp , nb ju = min ( j + nb - 1 , nyp ) call tp2 ( xsrc , src (:, j : ju , k ), nb , nxp ) call dfnonp ( nxp , hxp , xsrc , xdst , nb , 1 ) call tp2 ( dst (:, j : ju , k ), xdst , nxp , nb ) end do end do end subroutine ddx !> Computes the first-order derivative in the Y-direction. !! !! @param src 3D input scalar field (nxp, nyp, nzp). !! @param dst 3D output derivative field (nxp, nyp, nzp). subroutine ddy ( dst , src ) real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( in ) :: src real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( out ) :: dst integer :: i , j , k do k = 1 , nzp call dfp ( nyp , hyp , src (:,:, k ), dst (:,:, k ), nxp , 2 ) end do end subroutine ddy !> Computes the first-order derivative in the Z-direction. !! !! @param src 3D input scalar field (nxp, nyp, nzp). !! @param dst 3D output derivative field (nxp, nyp, nzp). subroutine ddz ( dst , src ) real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( in ) :: src real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( out ) :: dst integer :: i , j , k do j = 1 , nyp do k = 1 , nzp rsrc (:, k ) = src (:, j , k ) end do call dfp ( nzp , hzp , rsrc , rdst , nxp , 3 ) do k = 1 , nzp dst (:, j , k ) = rdst (:, k ) end do end do end subroutine ddz subroutine d2dx1d ( dst , src ) real ( real64 ), dimension ( nxp ), intent ( in ) :: src real ( real64 ), dimension ( nxp ), intent ( out ) :: dst call d2fnonp ( nxp , hxp , src , dst , 1 , 1 ) end subroutine d2dx1d subroutine d2dx ( dst , src ) real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( in ) :: src real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( out ) :: dst integer :: i , j , k integer :: ju do k = 1 , nzp do j = 1 , nyp , nb ju = min ( j + nb - 1 , nyp ) call tp2 ( xsrc , src (:, j : ju , k ), nb , nxp ) call d2fnonp ( nxp , hxp , xsrc , xdst , nb , 1 ) call tp2 ( dst (:, j : ju , k ), xdst , nxp , nb ) end do end do end subroutine d2dx subroutine d2dy ( dst , src ) real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( in ) :: src real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( out ) :: dst integer :: i , j , k do k = 1 , nzp call d2fp ( nyp , hyp , src (:,:, k ), dst (:,:, k ), nxp , 2 ) end do end subroutine d2dy subroutine d2dz ( dst , src ) real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( in ) :: src real ( real64 ), dimension ( nxp , nyp , nzp ), intent ( out ) :: dst integer :: i , j , k do j = 1 , nyp do k = 1 , nzp rsrc (:, k ) = src (:, j , k ) end do call d2fp ( nzp , hzp , rsrc , rdst , nxp , 3 ) do k = 1 , nzp dst (:, j , k ) = rdst (:, k ) end do end do end subroutine d2dz subroutine tp ( a , b , nx ) ! a(nb,nx) = transpose(b(nx,nb)) integer , intent ( in ) :: nx real ( real64 ), intent ( out ) :: a ( nb , nx ) real ( real64 ), intent ( in ) :: b ( nx , nb ) call tp2 ( a , b , nb , nx ) end subroutine tp subroutine tp2 ( a , b , n1 , n2 ) ! a = transpose(b) implicit none integer , intent ( in ) :: n1 , n2 real ( real64 ), intent ( out ) :: a ( n1 , n2 ) real ( real64 ), intent ( in ) :: b ( n2 , n1 ) integer :: i , j , ii , jj DO jj = 1 , n2 , nb DO ii = 1 , n1 , nb DO j = jj , min ( jj + nb - 1 , n2 ) DO i = ii , min ( ii + nb - 1 , n1 ) a ( i , j ) = b ( j , i ) ENDDO ENDDO ENDDO ENDDO end subroutine tp2 !> Computes the chemical reaction rate based on the progress variable c. !! !! This uses a piecewise exponential/Arrhenius model depending on whether the progress variable !! is below c_cut, above c_ref, or intermediate. !! !! @param c The progress variable (0.0 to 1.0). !! @return The computed reaction rate. real ( real64 ) function rxn_rate ( c ) real ( real64 ) :: c if ( c . lt . 0._real64 ) c = 0._real64 if ( c . gt . 1._real64 ) c = 1._real64 if ( c . le . c_cut ) then rxn_rate = min_wr else if ( c . gt . c_ref ) then rxn_rate = pre * ( 1. - c ) * exp ( - ac / ( 1. + bc * c )) else rxn_rate = & (( refwr - min_wr ) * exp ( prof_wr * ( c - c_ref )) + min_wr - refwr * exp ( prof_wr * ( c_cut - c_ref ))) & / ( 1. - exp ( prof_wr * ( c_cut - c_ref ))) endif end function rxn_rate real ( real64 ) function threshold_min_max ( c , minc , maxc ) real ( real64 ) :: c real ( real64 ) :: minc , maxc if (( c . lt . minc ) . or . ( c . gt . maxc )) then threshold_min_max = 0._real64 else threshold_min_max = 1.0_real64 end if end function threshold_min_max real ( real64 ) function positive ( c ) real ( real64 ) :: c if ( c > 0.0_real64 ) then positive = c else positive = 0._real64 end if end function positive real ( real64 ) function negative ( c ) real ( real64 ) :: c if ( c < 0.0_real64 ) then negative = c else negative = 0._real64 end if end function negative end module m_calculate","tags":"","url":"sourcefile/m_calculate.f90.html"}]}