neko.f90

Go to the documentation of this file.

! Copyright (c) 2019-2025, The Neko Authors
! All rights reserved.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
!
!   * Redistributions of source code must retain the above copyright
!     notice, this list of conditions and the following disclaimer.
!
!   * Redistributions in binary form must reproduce the above
!     copyright notice, this list of conditions and the following
!     disclaimer in the documentation and/or other materials provided
!     with the distribution.
!
!   * Neither the name of the authors nor the names of its
!     contributors may be used to endorse or promote products derived
!     from this software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
module neko
  use num_types, only : rp, sp, dp, qp, c_rp
  use comm
  use utils
  use logger
  use mask
  use math, only : abscmp, rzero, izero, row_zero, rone, copy, cmult, cadd, &
       cfill, glsum, glmax, glmin, chsign, vlmax, vlmin, invcol1, invcol3, &
       invers2, vcross, vdot2, vdot3, vlsc3, vlsc2, add2, add3, add4, sub2, &
       sub3, add2s1, add2s2, addsqr2s2, cmult2, invcol2, col2, col3, subcol3, &
       add3s2, subcol4, addcol3, addcol4, ascol5, p_update, x_update, glsc2, &
       glsc3, glsc4, sort, masked_copy_0, cfill_mask, relcmp, glimax, glimin, &
       swap, reord, flipv, cadd2, pi, absval
  use speclib
  use dofmap, only : dofmap_t
  use space, only : space_t, gl, gll, gj
  use htable
  use uset
  use stack
  use tuple
  use mesh, only : mesh_t, neko_msh_max_zlbls
  use point, only : point_t
  use mesh_field, only : mesh_fld_t
  use map
  use import_field_utils, only : import_fields
  use mxm_wrapper, only : mxm
  use global_interpolation
  use file
  use field, only : field_t, field_ptr_t
  use field_math
  use neko_mpi_types
  use gather_scatter
  use krylov
  use coefs, only : coef_t
  use bc, only : bc_t
  use zero_dirichlet, only : zero_dirichlet_t
  use bc_list, only : bc_list_t
  use dirichlet, only : dirichlet_t
  use ax_product, only : ax_t, ax_helm_factory
  use parmetis, only : parmetis_partgeom, parmetis_partmeshkway
  use neko_config
  use case, only : case_t
  use output_controller, only : output_controller_t
  use output, only : output_t
  use simulation, only : simulation_step, simulation_init, simulation_finalize
  use operators, only : dudxyz, opgrad, ortho, cdtp, conv1, curl, cfl,&
       lambda2op, strain_rate, div, grad
  use mathops, only : opchsign, opcolv, opcolv3c, opadd2cm, opadd2col
  use projection
  use user_intf
  use signal
  use time_state
  use jobctrl, only : jobctrl_init, jobctrl_set_time_limit, &
       jobctrl_time_limit, jobctrl_jobtime
  use device
  use device_math, only : device_copy, device_rzero, device_rone, &
       device_cmult, device_cmult2, device_cadd, device_cfill, device_add2, &
       device_add2s1, device_add2s2, device_addsqr2s2, device_add3s2, &
       device_invcol1, device_invcol2, device_col2, device_col3, &
       device_subcol3, device_sub2, device_sub3, device_addcol3, &
       device_addcol4, device_vdot3, device_vlsc3, device_glsc3, &
       device_glsc3_many, device_add2s2_many, device_glsc2, device_glsum, &
       device_glmax, device_glmin, device_masked_copy_0, device_cfill_mask, &
       device_add3, device_cadd2, device_absval
  use map_1d, only : map_1d_t
  use map_2d, only : map_2d_t
  use cpr, only : cpr_t, cpr_init, cpr_free
  use fluid_stats, only : fluid_stats_t
  use field_list, only : field_list_t
  use user_source_term, only : user_source_term_t
  use vector, only : vector_t, vector_ptr_t
  use vector_list, only : vector_list_t
  use matrix, only : matrix_t
  use tensor
  use simulation_component, only : simulation_component_t, &
       simulation_component_wrapper_t, simulation_component_factory, &
       simulation_component_allocator, simulation_component_allocate, &
       register_simulation_component
  use boundary_operation, only : boundary_operation_t
  use boundary_flux, only : boundary_flux_t
  use probes, only : probes_t
  use spectral_error, only : spectral_error_t
  use profiler, only : profiler_start, profiler_stop, &
       profiler_start_region, profiler_end_region
  use system, only : system_cpu_name, system_cpuid
  use drag_torque, only : drag_torque_zone, drag_torque_facet, drag_torque_pt
  use registry, only : neko_registry, neko_const_registry, registry_t
  use scratch_registry, only : neko_scratch_registry, scratch_registry_t
  use simcomp_executor, only : neko_simcomps
  use data_streamer, only : data_streamer_t
  use time_interpolator, only : time_interpolator_t
  use point_interpolator, only : point_interpolator_t
  use point_zone, only : point_zone_t
  use box_point_zone, only : box_point_zone_t
  use sphere_point_zone, only : sphere_point_zone_t
  use point_zone_registry, only : neko_point_zone_registry
  use field_dirichlet, only : field_dirichlet_t
  use field_dirichlet_vector, only : field_dirichlet_vector_t
  use field_neumann, only : field_neumann_t
  use runtime_stats, only : neko_rt_stats
  use json_module, only : json_file
  use json_utils, only : json_get, json_get_or_default, json_extract_item
  use bc_list, only : bc_list_t
  use les_model, only : les_model_t, les_model_allocate, register_les_model, &
       les_model_factory, les_model_allocator
  use field_writer, only : field_writer_t
  use derivative_simcomp, only : derivative_t
  use divergence_simcomp, only : divergence_t
  use curl_simcomp, only : curl_t
  use gradient_simcomp, only : gradient_t
  use weak_gradient_simcomp, only : weak_gradient_t
  use force_torque, only : force_torque_t
  use lambda2, only : lambda2_t
  use time_based_controller, only : time_based_controller_t
  use time_step_controller, only : time_step_controller_t
  use source_term, only : source_term_t, source_term_allocate, &
       register_source_term, source_term_factory, source_term_allocator
  use user_access_singleton, only : neko_user_access
  use ale_manager, only : neko_ale
  use, intrinsic :: iso_fortran_env
  use mpi_f08
  !$ use omp_lib
  implicit none
 
contains
 
  subroutine neko_init(C, filename)
    type(case_t), target, intent(inout), optional :: C
    character(len=*), intent(in), optional :: filename
    character(len=NEKO_FNAME_LEN) :: case_file, args
    character(len=LOG_SIZE) :: log_buf
    character(len=10) :: suffix
    character(10) :: time
    character(8) :: date
    integer :: argc, i
 
    call date_and_time(time = time, date = date)
 
    call comm_init
    call neko_mpi_types_init
    call jobctrl_init
    call device_init
 
    call neko_log%init()
    call neko_registry%init()
    call neko_const_registry%init()
    call neko_scratch_registry%init()
 
    call neko_log%header(neko_version, neko_build_info)
 
    if (present(c)) then
 
       if (present(filename)) then
          case_file = filename
       else
          !
          ! Command line arguments
          !
          argc = command_argument_count()
 
          if (argc .lt. 1) then
             if (pe_rank .eq. 0) write(*,*) 'Usage: ./neko <case file>'
             stop
          end if
 
          call get_command_argument(1, case_file)
       end if
 
       call filename_suffix(case_file, suffix)
 
       if (trim(suffix) .ne. 'case' .and. trim(suffix) .ne. 'json') then
          call neko_error('Invalid case file')
       end if
 
       if (argc .gt. 1) then
          write(log_buf, '(a)') 'Running with command line arguments: '
          call neko_log%message(log_buf, neko_log_quiet)
          do i = 2, argc
             call get_command_argument(i, args)
             call neko_log%message(args, neko_log_quiet)
          end do
       end if
 
       !
       ! Job information
       !
       call neko_job_info(date, time)
 
       !
       ! Create case
       !
       call c%init(case_file)
 
       !
       ! Setup runtime statistics
       !
       call neko_rt_stats%init(c%params)
 
 
       !
       ! Create simulation components
       !
       call neko_simcomps%init(c)
 
    end if
 
  end subroutine neko_init
 
  subroutine neko_solve(C)
    type(case_t), target, intent(inout) :: C
    type(time_step_controller_t) :: dt_controller
    type(json_file) :: dt_params
    real(kind=dp) :: tstep_loop_start_time
 
    call json_get(c%params, 'case.time', dt_params)
    call dt_controller%init(dt_params)
 
    call c%time%reset()
    call simulation_init(c, dt_controller)
 
    call profiler_start
    tstep_loop_start_time = mpi_wtime()
 
    do while (.not. (c%time%is_done() .or. jobctrl_time_limit()))
       call simulation_step(c, dt_controller, tstep_loop_start_time)
    end do
    call profiler_stop
 
    call simulation_finalize(c)
 
  end subroutine neko_solve
 
  subroutine neko_finalize(C)
    type(case_t), intent(inout), optional :: c
 
    call neko_rt_stats%report()
    call neko_rt_stats%free()
 
    call neko_scratch_registry%free()
 
    if (present(c)) then
       call c%free()
    end if
 
    call neko_simcomps%free()
 
    call neko_registry%free()
    call neko_user_access%free()
    call neko_log%free()
 
    call device_finalize
    call neko_mpi_types_free
    call comm_free
  end subroutine neko_finalize
 
 
  subroutine neko_job_info(date, time)
    character(10), optional, intent(in) :: time
    character(8), optional, intent(in) :: date
    character(len=LOG_SIZE) :: log_buf
    integer :: nthrds, rw, sw
 
    call neko_log%section("Job Information")
 
    if (present(time) .and. present(date)) then
       write(log_buf, '(A,A,A,A,1x,A,1x,A,A,A,A,A)') 'Start time: ', &
            time(1:2), ':', time(3:4), &
            '/', date(1:4), '-', date(5:6), '-', date(7:8)
       call neko_log%message(log_buf, neko_log_quiet)
    end if
    write(log_buf, '(a)') 'Running on: '
    sw = 10
    if (pe_size .lt. 1e1) then
       write(log_buf(13:), '(i1,a)') pe_size, ' MPI '
       if (pe_size .eq. 1) then
          write(log_buf(19:), '(a)') 'rank'
          sw = 9
       else
          write(log_buf(19:), '(a)') 'ranks'
       end if
       rw = 1
    else if (pe_size .lt. 1e2) then
       write(log_buf(13:), '(i2,a)') pe_size, ' MPI ranks'
       rw = 2
    else if (pe_size .lt. 1e3) then
       write(log_buf(13:), '(i3,a)') pe_size, ' MPI ranks'
       rw = 3
    else if (pe_size .lt. 1e4) then
       write(log_buf(13:), '(i4,a)') pe_size, ' MPI ranks'
       rw = 4
    else if (pe_size .lt. 1e5) then
       write(log_buf(13:), '(i5,a)') pe_size, ' MPI ranks'
       rw = 5
    else
       write(log_buf(13:), '(i6,a)') pe_size, ' MPI ranks'
       rw = 6
    end if
    nthrds = 1
    !$omp parallel
    !$omp master
    !$ nthrds = omp_get_num_threads()
    !$omp end master
    !$omp end parallel
    if (nthrds .gt. 1) then
       if (nthrds .lt. 1e1) then
          write(log_buf(13 + rw + sw:), '(a,i1,a)') ', using ', &
               nthrds, ' thrds each'
       else if (nthrds .lt. 1e2) then
          write(log_buf(13 + rw + sw:), '(a,i2,a)') ', using ', &
               nthrds, ' thrds each'
       else if (nthrds .lt. 1e3) then
          write(log_buf(13 + rw + sw:), '(a,i3,a)') ', using ', &
               nthrds, ' thrds each'
       else if (nthrds .lt. 1e4) then
          write(log_buf(13 + rw + sw:), '(a,i4,a)') ', using ', &
               nthrds, ' thrds each'
       end if
    end if
    call neko_log%message(log_buf, neko_log_quiet)
 
    write(log_buf, '(a)') 'CPU type  : '
    call system_cpu_name(log_buf(13:))
    call neko_log%message(log_buf, neko_log_quiet)
 
    write(log_buf, '(a)') 'Bcknd type: '
    if (neko_bcknd_sx .eq. 1) then
       write(log_buf(13:), '(a)') 'SX-Aurora'
    else if (neko_bcknd_xsmm .eq. 1) then
       write(log_buf(13:), '(a)') 'CPU (libxsmm)'
    else if (neko_bcknd_cuda .eq. 1) then
       write(log_buf(13:), '(a)') 'Accelerator (CUDA)'
    else if (neko_bcknd_hip .eq. 1) then
       write(log_buf(13:), '(a)') 'Accelerator (HIP)'
    else if (neko_bcknd_opencl .eq. 1) then
       write(log_buf(13:), '(a)') 'Accelerator (OpenCL)'
    else
       write(log_buf(13:), '(a)') 'CPU'
    end if
    call neko_log%message(log_buf, neko_log_quiet)
 
    if (neko_bcknd_hip .eq. 1 .or. neko_bcknd_cuda .eq. 1 .or. &
         neko_bcknd_opencl .eq. 1) then
       write(log_buf, '(a)') 'Dev. name : '
       call device_name(log_buf(13:))
       call neko_log%message(log_buf, neko_log_quiet)
    end if
    write(log_buf, '(a)') 'Real type : '
    select case (rp)
    case (real32)
       write(log_buf(13:), '(a)') 'single precision'
    case (real64)
       write(log_buf(13:), '(a)') 'double precision'
    case (real128)
       write(log_buf(13:), '(a)') 'quad precision'
    end select
    call neko_log%message(log_buf, neko_log_quiet)
    call neko_log%end()
  end subroutine neko_job_info
end module neko