oqp_banner Subroutine

public subroutine oqp_banner(infos)

Uses

  • proc~~oqp_banner~~UsesGraph proc~oqp_banner oqp_banner iso_c_binding iso_c_binding proc~oqp_banner->iso_c_binding module~messages messages proc~oqp_banner->module~messages module~oqp_tagarray_driver oqp_tagarray_driver proc~oqp_banner->module~oqp_tagarray_driver module~parallel parallel proc~oqp_banner->module~parallel module~types types proc~oqp_banner->module~types comm_IOFILE comm_IOFILE module~messages->comm_IOFILE comm_PAR comm_PAR module~messages->comm_PAR module~io_constants io_constants module~messages->module~io_constants module~precision precision module~messages->module~precision module~oqp_tagarray_driver->iso_c_binding tagarray tagarray module~oqp_tagarray_driver->tagarray module~parallel->iso_c_binding iso_fortran_env iso_fortran_env module~parallel->iso_fortran_env module~parallel->module~precision mpi mpi module~parallel->mpi module~types->iso_c_binding module~types->module~parallel module~atomic_structure_m atomic_structure_m module~types->module~atomic_structure_m module~basis_tools basis_tools module~types->module~basis_tools module~functionals functionals module~types->module~functionals module~types->module~precision module~types->tagarray module~atomic_structure_m->iso_c_binding module~basis_tools->module~parallel module~basis_tools->iso_fortran_env module~basis_tools->module~atomic_structure_m module~basis_tools->module~io_constants module~basis_tools->module~precision module~constants constants module~basis_tools->module~constants module~functionals->iso_c_binding module~functionals->module~precision xc_f03_lib_m xc_f03_lib_m module~functionals->xc_f03_lib_m module~precision->iso_fortran_env module~constants->module~precision

Arguments

Type IntentOptional Attributes Name
type(information), intent(inout) :: infos

Calls

proc~~oqp_banner~~CallsGraph proc~oqp_banner oqp_banner interface~data_has_tags data_has_tags proc~oqp_banner->interface~data_has_tags interface~tagarray_get_data tagarray_get_data proc~oqp_banner->interface~tagarray_get_data none~get_hostnames par_env_t%get_hostnames proc~oqp_banner->none~get_hostnames none~init~14 par_env_t%init proc~oqp_banner->none~init~14 mpi_bcast mpi_bcast none~get_hostnames->mpi_bcast mpi_comm_free mpi_comm_free none~get_hostnames->mpi_comm_free mpi_comm_rank mpi_comm_rank none~get_hostnames->mpi_comm_rank mpi_comm_size mpi_comm_size none~get_hostnames->mpi_comm_size mpi_comm_split mpi_comm_split none~get_hostnames->mpi_comm_split mpi_comm_split_type mpi_comm_split_type none~get_hostnames->mpi_comm_split_type mpi_gather mpi_gather none~get_hostnames->mpi_gather mpi_get_processor_name mpi_get_processor_name none~get_hostnames->mpi_get_processor_name none~init~14->mpi_comm_rank none~init~14->mpi_comm_size

Called by

proc~~oqp_banner~~CalledByGraph proc~oqp_banner oqp_banner proc~oqp_banner_c oqp_banner_C proc~oqp_banner_c->proc~oqp_banner

Source Code

  subroutine oqp_banner(infos)
    use messages, only: show_message, with_abort
    use types, only: information
!$  use omp_lib, only: omp_get_max_threads
    use oqp_tagarray_driver
    use iso_c_binding, only: c_char
    use parallel, only: par_env_t
    implicit none
    type(information), intent(inout) :: infos
    integer :: iw, CPU_core, i
    character(len=28) :: cdate
    character(len=:), allocatable :: hostnames
    type(par_env_t) :: pe

  ! Section of Tagarray for the log filename
  ! We are getting lot file name from Python via tagarray

    character(len=1,kind=c_char), contiguous, pointer :: log_filename(:)
    character(len=*), parameter :: subroutine_name = "oqp_banner"
    character(len=*), parameter :: tags_general(1) = (/ character(len=80) :: &
          OQP_log_filename /)

    call data_has_tags(infos%dat, tags_general, module_name, subroutine_name, with_abort)
    call tagarray_get_data(infos%dat, OQP_log_filename, log_filename)
    allocate(character(ubound(log_filename,1)) :: infos%log_filename)
    do i = 1, ubound(log_filename,1)
       infos%log_filename(i:i) = log_filename(i)
    end do
    call pe%init(infos%mpiinfo%comm, infos%mpiinfo%usempi)


    open (newunit=iw, file=infos%log_filename, position="append")

    write(iw, '(/,10x, "***********************************************************")')
    write(iw, '(10x,   "*                                                         *")')
    write(iw, '(10x,   "*             OpenQP: Open Quantum Platform               *")')
    write(iw, '(10x,   "*                                                         *")')
    write(iw, '(10x,   "*                Version: 1.0 Aug, 2024                   *")')
    write(iw, '(10x,   "*                                                         *")')
    write(iw, '(10x,   "***********************************************************")')
    write(iw, '(10x,   "*     The most efficient implementation of MRSF-TDDFT.    *")')
    write(iw, '(10x,   "***********************************************************")')
    write(iw, '(10x,   "*                                                         *")')
    write(iw, '(10x,   "*   OpenQP was initiated by Prof. Cheol Ho Choi in 2012.  *")')
    write(iw, '(10x,   "*                                                         *")')
    write(iw, '(10x,   "*   It has since been developed by:                       *")')
    write(iw, '(10x,   "*   Dr. Vladimir Mironov                                  *")')
    write(iw, '(10x,   "*   Dr. Konstantin Komarov                                *")')
    write(iw, '(10x,   "*   Mr. Igor Gerasimov                                    *")')
    write(iw, '(10x,   "*   Dr. Hiroya Nakata                                     *")')
    write(iw, '(10x,   "*   Dr. Mohsen Mazaherifar                                *")')
    write(iw, '(10x,   "*   Mr. Alireza Lashkaripour                              *")')
    write(iw, '(10x,   "*                                                         *")')
    write(iw, '(10x,   "*   In 2024, Prof. Jingbai Li at Hoffmann Institute of    *")')
    write(iw, '(10x,   "*   Advanced Materials began developing PyOQP.            *")')
    write(iw, '(10x,   "*                                                         *")')
    write(iw, '(10x,   "***********************************************************")')

    call fdate(cdate)
    call pe%get_hostnames(hostnames)
    CPU_core = 1
  !$  CPU_core = omp_get_max_threads()

    if (pe%use_mpi) then
        write(iw, '(/20x,A,"Job Details:",/,22x,"Start Time: ",A,/,22x,"Host List: ",A,/,22x,"Resources Allocated:",/,24x,"OpenMP Threads: ",I4,/,24x,"MPI Processors: ",I4)') &
                  ' ', cdate, hostnames, CPU_core, pe%size
    else
        write(iw, '(/20x,A,"Job Details:",/,22x,"Start Time: ",A,/,22x,"Host: ",A,/,22x,"Resources Allocated:",/,24x,"OpenMP Threads: ",I4)') &
                  ' ', cdate, hostnames, CPU_core
    endif
    close (iw)

  end subroutine oqp_banner