da_random_seed.inc

1 subroutine da_random_seed
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
6 
7    implicit none
8 
9    integer              :: seed_size
10    integer, allocatable :: seed_array(:)
11 
12    if (trace_use) call da_trace_entry("da_random_seed")
13 
14    !----------------------------------------------------------------------------
15    !  Check that right seed_size is being used:
16    !----------------------------------------------------------------------------
17 
18    call random_seed(size=seed_size)              ! Get size of seed array.
19    allocate(seed_array(1:seed_size))
20    seed_array(1:seed_size) = 0
21 
22    if (put_rand_seed) then            ! Manually set random seed.
23       if (seed_size /= 2) then
24          write(unit=stdout,fmt='(a)') &
25             ' Warning: only setting first two values of seed_array'
26       end if
27      
28       seed_array(1) = seed_array1
29       seed_array(2) = seed_array2
30       write(unit=stdout,fmt='(a,i16)')' Setting seed_array(1) = ', seed_array1
31       write(unit=stdout,fmt='(a,i16)')' Setting seed_array(2) = ', seed_array2
32       call random_seed(put=seed_array(1:seed_size)) ! Set random seed.
33    else                                 ! Random seed set "randomly"
34       call random_seed
35       call random_seed(get=seed_array(1:seed_size))
36       write(unit=stdout,fmt='(a,10i16)') 'Random number seed array = ', seed_array
37    end if
38    
39    deallocate(seed_array)
40 
41    if (trace_use) call da_trace_exit("da_random_seed")
42 
43 end subroutine da_random_seed
44 
45