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_nml ) write(io_fid_nml,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) ! date and time information
    real(RP) :: time2    ! CPU time
    !---------------------------------------------------------------------------

    if ( random_fix ) then
       ! birthday of SCALE
       time1(1) = 2011 ! The year
       time1(2) = 12   ! The month
       time1(3) = 5    ! The day of the month
       time1(4) = 9    ! Time difference with UTC in minutes
       time1(5) = 10   ! The hour of the day
       time1(6) = 20   ! The minutes of the hour
       time1(7) = 41   ! The seconds of the minute
       time1(8) = 0    ! The milliseconds of the second
       time2    = 0.0_rp
    else
       call date_and_time(values=time1)
       call cpu_time(time2)
    endif

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

    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