da_random_seed.inc

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