scale_random.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
module scale_random
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: random_setup
  public :: random_get

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: random_reset

  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  logical, private :: random_fix = .false.

  integer, private, allocatable :: random_seedvar(:)

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine random_setup
    use scale_process, only: &
       prc_mpistop
    implicit none

    namelist / param_random / &
       random_fix

    integer :: nseeds, ierr
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[RANDOM] / Categ[COMMON] / Origin[SCALElib]'

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_random,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       write(*,*) 'xxx Not appropriate names in namelist PARAM_RANDOM. Check!'
       call prc_mpistop
    endif
    if( io_lnml ) write(io_fid_log,nml=param_random)

    call random_seed
    call random_seed(size=nseeds)

    allocate( random_seedvar(nseeds))

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** Array size for random seed:', nseeds
    if ( random_fix ) then
       if( io_l ) write(io_fid_log,*) '*** random seed is fixed.'
    endif

    return
  end subroutine random_setup

  !-----------------------------------------------------------------------------
  subroutine random_reset
    use scale_process, only: &
       prc_myrank
    implicit none

    integer :: time1(8)
    real(RP) :: time2
    !---------------------------------------------------------------------------

    if ( random_fix ) then
       time1(1) = 2011
       time1(2) = 12
       time1(3) = 5
       time1(4) = 10
       time1(5) = 20
       time1(6) = 41 ! birthday of SCALE
       time2    = 0.0_rp
    else
       call date_and_time(values=time1)
       call cpu_time(time2)
    endif

    random_seedvar(:) = &
         + ( time1(1) - 1970 ) * 32140800 &
         + time1(2) * 2678400 &
         + time1(3) * 86400 &
         + time1(4) * 60 &
         + time1(5) * 3600 &
         + time1(6) * 60 &
         + time1(7) &
         + int(time2*1.e6_rp) + prc_myrank

    call random_seed(put=random_seedvar)

    return
  end subroutine random_reset

  !-----------------------------------------------------------------------------
  subroutine random_get( var )
    implicit none

    real(RP), intent(out) :: var(:,:,:)
    !---------------------------------------------------------------------------

    call random_reset
    call random_number(var)

    return
  end subroutine random_get

end module scale_random