global.F90

Go to the documentation of this file.

!! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
module global_oct_m
  use hardware_oct_m
  use kind_oct_m
  use loct_oct_m
  use mpi_oct_m
  use varinfo_oct_m
#ifdef HAVE_OPENMP
  use omp_lib
#endif
 
  implicit none
 
  private
 
  ! ---------------------------------------------------------
  public ::           &
    conf_t,           &
    global_init,      &
    global_end,       &
    optional_default, &
    assert_die,       &
    not_in_openmp,    &
    operator(+),      &
    bitand,           &
    i4, i8, r4, r8,   &
    i4_to_i8,         &
    i8_to_i4
  ! Make these kind variables from kind_oct_m public here so that they are
  ! available basically everywhere in the code. They still need to be in a
  ! separate module because they are also needed in hardware_oct_m and some
  ! other low-level modules.
 
 
  integer, public, parameter :: MAX_PATH_LEN=512
  integer, public, parameter :: MAX_OUTPUT_TYPES=43
 
  type conf_t
    ! Components are public by default
    logical :: devel_version
    logical :: report_memory
    character(len=256) :: share
    character(len=256) :: git_commit
    character(len=50)  :: config_time
    character(len=20)  :: version
    character(len=256) :: cc
    character(len=256) :: cflags
    character(len=256) :: cxx
    character(len=256) :: cxxflags
    character(len=256) :: fc
    character(len=256) :: fcflags
    integer            :: target_states_block_size
  end type conf_t
 
  type(conf_t),      public :: conf
 
  float, public, parameter :: r_small = cnst(1e-8)
 
  float, public, parameter :: r_min_atom_dist = cnst(1e-3)
 
  float, public, parameter :: m_pi        = cnst(3.1415926535897932384626433832795029)
  float, public, parameter :: m_e         = cnst(2.7182818284590452353602874713526625)
  float, public, parameter :: m_zero      = cnst(0.0)
  float, public, parameter :: m_one       = cnst(1.0)
  float, public, parameter :: m_two       = cnst(2.0)
  float, public, parameter :: m_three     = cnst(3.0)
  float, public, parameter :: m_four      = cnst(4.0)
  float, public, parameter :: m_five      = cnst(5.0)
  float, public, parameter :: m_half      = cnst(0.5)
  float, public, parameter :: m_third     = m_one/m_three
  float, public, parameter :: m_twothird  = m_two/m_three
  float, public, parameter :: m_fourth    = m_one/m_four
  cmplx, public, parameter :: m_z0        = (cnst(0.0), cnst(0.0))
  cmplx, public, parameter :: m_z1        = (cnst(1.0), cnst(0.0))
  cmplx, public, parameter :: m_z2        = (cnst(2.0), cnst(0.0))
  cmplx, public, parameter :: m_z2i       = (cnst(0.0), cnst(2.0))
  cmplx, public, parameter :: m_zi        = (cnst(0.0), cnst(1.0))
 
  float, public, parameter :: m_epsilon   =  epsilon(m_one)
  float, public, parameter :: m_tiny      =  tiny(m_one)
  float, public, parameter :: m_huge      =  huge(m_one)
  float, public, parameter :: m_min_exp_arg = cnst(-650)
  float, public, parameter :: m_max_exp_arg = cnst(700)
 
 
  float, public, parameter :: p_a_b =  cnst(0.52917720859)
  float, public, parameter :: p_ang =  m_one / p_a_b
  float, public, parameter :: p_ry  =  cnst(13.60569193)
  float, public, parameter :: p_ev  =  m_one / p_ry
  float, public, parameter :: p_kb  =  cnst(8.617343e-5)/(m_two*p_ry)  
  float, public, parameter :: p_c   =  cnst(137.035999679)
  float, public, parameter :: p_g   =  cnst(2.0023193043768)   
  float, public, parameter :: p_proton_charge = cnst(-1.0)
  float, public, parameter :: p_ep  =  m_one/(m_four*m_pi)
  float, public, parameter :: p_mu  =  m_four*m_pi/(p_c**2)
 
  integer, public :: stderr, stdin, stdout
 
  integer, public :: s_epoch_sec, s_epoch_usec
 
  character(len=80), public          :: sub_stack(50)
  float, public                      :: time_stack(50)
  integer, public                    :: no_sub_stack = 0
 
  logical, public :: in_profiling_mode = .false.
 
  integer,    public :: global_alloc_err
  integer(i8), public :: global_sizeof
  character(len=100), public :: global_alloc_errmsg
 
  ! The code directories should be defined here, and not hard coded in the Fortran files.
  character(len=*), public, parameter :: GS_DIR = "gs/"
  character(len=*), public, parameter :: td_dir = "td/"
  character(len=*), public, parameter :: static_dir = "static/"
  character(len=*), public, parameter :: em_resp_dir = "em_resp/"
  character(len=*), public, parameter :: EM_RESP_FD_DIR = "em_resp_fd/"
  character(len=*), public, parameter :: KDOTP_DIR = "kdotp/"
  character(len=*), public, parameter :: vib_modes_dir = "vib_modes/"
  character(len=*), public, parameter :: vdw_dir = "vdw/"
  character(len=*), public, parameter :: casida_dir = "casida/"
  character(len=*), public, parameter :: oct_dir = "opt-control/"
  character(len=*), public, parameter :: pcm_dir = "pcm/"
  character(len=*), public, parameter :: partition_dir = "partition/"
 
  ! End of declaration of public objects.
  ! ---------------------------------------------------------
 
  interface optional_default
    module procedure doptional_default, zoptional_default, ioptional_default, loptional_default
    module procedure looptional_default, soptional_default
  end interface optional_default
 
 
  interface
    subroutine assert_die(s, f, l)
      implicit none
      character(len=*), intent(in) :: s, f
      integer, intent(in) :: l
    end subroutine assert_die
  end interface
 
  interface operator (+)
    module procedure cat
  end interface operator (+)
 
  interface bitand
    module procedure bitand48
    module procedure bitand84
    module procedure bitand88
    module procedure bitand44
  end interface bitand
 
  interface i4_to_i8
    module procedure i4_to_i8_0, i4_to_i8_1
  end interface i4_to_i8
 
  interface i8_to_i4
    module procedure i8_to_i4_0, i8_to_i4_1
  end interface i8_to_i4
 
contains
 
  ! ---------------------------------------------------------
  subroutine global_init(is_serial)
    logical, optional, intent(in) :: is_serial
 
    character(len=256) :: share
 
    ! initialize mpi
    call mpi_mod_init(optional_default(is_serial, .false.))
 
    ! Get epoch time at node startup, just after the barrier to synchronize nodes first.
    call loct_gettimeofday(s_epoch_sec, s_epoch_usec)
 
    call hardware_init()
 
    ! Get the environment variable OCTOPUS_SHARE that overrides SHARE_DIR/share/octopus.
    call loct_getenv("OCTOPUS_SHARE", share)
 
    if (share /= "") then
      conf%share = trim(share)
    else
      conf%share = share_dir
    end if
    conf%git_commit  = git_commit
    conf%config_time = build_time
    conf%version     = package_version
    conf%cc          = cc
    ! split to have all flags in case they don`t fit in one line
    conf%cflags     = &
      cflags //&
      cflags_extra
    conf%cxx        = cxx
    conf%cxxflags   = &
      cxxflags //&
      cxxflags_extra
    conf%fc         = fc
    conf%fcflags    = &
      fcflags //&
      fcflags_extra
 
    ! initialize info for the input variables
    call varinfo_init(trim(conf%share)//'/varinfo')
 
    conf%target_states_block_size = -1
 
  end subroutine global_init
 
 
  ! ---------------------------------------------------------
  subroutine global_end()
 
    call hardware_end()
    call mpi_mod_end()
    call varinfo_end()
 
  end subroutine global_end
 
  !----------------------------------------------------------
 
  float pure function doptional_default(opt, def) result(val)
    float, optional, intent(in) :: opt
    float,           intent(in) :: def
 
    val = def
    if (present(opt)) val = opt
  end function doptional_default
 
  !----------------------------------------------------------
 
  cmplx pure function zoptional_default(opt, def) result(val)
    cmplx, optional, intent(in) :: opt
    cmplx,           intent(in) :: def
 
    val = def
    if (present(opt)) val = opt
  end function zoptional_default
 
  !----------------------------------------------------------
 
  integer pure function ioptional_default(opt, def) result(val)
    integer, optional, intent(in) :: opt
    integer,           intent(in) :: def
 
    val = def
    if (present(opt)) val = opt
  end function ioptional_default
 
  !----------------------------------------------------------
 
  integer(i8) pure function loptional_default(opt, def) result(val)
    integer(i8), optional, intent(in) :: opt
    integer(i8),           intent(in) :: def
 
    val = def
    if (present(opt)) val = opt
  end function loptional_default
 
  !----------------------------------------------------------
 
  logical pure function looptional_default(opt, def) result(val)
    logical, optional, intent(in) :: opt
    logical,           intent(in) :: def
 
    val = def
    if (present(opt)) val = opt
  end function looptional_default
 
  !----------------------------------------------------------
 
  character(len=80) pure function soptional_default(opt, def) result(val)
    character(len=*), optional, intent(in) :: opt
    character(len=*),           intent(in) :: def
 
    val = def
    if (present(opt)) val = opt
  end function soptional_default
 
  !-----------------------------------------------------------
 
  logical &
#ifndef have_openmp
    pure &
#endif
    function not_in_openmp()
 
#ifdef HAVE_OPENMP
    not_in_openmp = .not. omp_in_parallel()
#else
    not_in_openmp = .true.
#endif
 
  end function not_in_openmp
 
  !-----------------------------------------------------------
 
  function cat(str1, str2)
    character(len=*), intent(in) :: str1
    character(len=*), intent(in) :: str2
 
    character(len=len(str1) + len(str2)) :: cat
    cat = str1//str2
 
  end function cat
 
  ! -----------------------------------------------------------
 
  integer(i8) pure function bitand48(val1, val2)
    integer(i4), intent(in) :: val1
    integer(i8), intent(in) :: val2
 
    bitand48 = iand(int(val1, 8), val2)
 
  end function bitand48
 
  ! -----------------------------------------------------------
 
  integer(i8) pure function bitand84(val1, val2)
    integer(i8), intent(in) :: val1
    integer(i4), intent(in) :: val2
 
    bitand84 = iand(val1, int(val2, 8))
 
  end function bitand84
 
  ! -----------------------------------------------------------
 
  integer(i8) pure function bitand88(val1, val2)
    integer(i8), intent(in) :: val1
    integer(i8), intent(in) :: val2
 
    bitand88 = iand(val1, val2)
 
  end function bitand88
 
  ! -----------------------------------------------------------
 
  integer(i4) pure function bitand44(val1, val2)
    integer(i4), intent(in) :: val1
    integer(i4), intent(in) :: val2
 
    bitand44 = iand(val1, val2)
 
  end function bitand44
 
  ! -----------------------------------------------------------
 
  integer(i8) pure function i4_to_i8_0(ii)
    integer(i4), intent(in) :: ii
 
    i4_to_i8_0 = int(ii, i8)
  end function i4_to_i8_0
 
  ! -----------------------------------------------------------
 
  integer(i4) pure function i8_to_i4_0(ii)
    integer(i8), intent(in) :: ii
 
    i8_to_i4_0 = int(ii, i4)
  end function i8_to_i4_0
 
  ! -----------------------------------------------------------
 
  pure function i4_to_i8_1(ii)
    integer(i4), intent(in) :: ii(:)
    integer(i8) :: i4_to_i8_1(lbound(ii, 1, kind=i8):ubound(ii, 1, kind=i8))
 
    i4_to_i8_1 = int(ii, i8)
  end function i4_to_i8_1
 
  ! -----------------------------------------------------------
 
  pure function i8_to_i4_1(ii)
    integer(i8), intent(in) :: ii(:)
    integer(i4) :: i8_to_i4_1(lbound(ii, 1, kind=i8):ubound(ii, 1, kind=i8))
 
    i8_to_i4_1 = int(ii, i4)
  end function i8_to_i4_1
end module global_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: