...
32
33
34 implicit none
35
36
37 integer*4 :: nn_loc, mpi_id ,nmat_rnd
38 integer*4, dimension(nmat_rnd) :: rand_mat
39 integer*4, dimension(nn_loc) :: loc_n_num
40
41 real*8, dimension(nn_loc) :: xs_loc, ys_loc, zs_loc
42 real*8, dimension(nn_loc), intent(inout) :: lambda_rnd, mu_rnd, rho_rnd
43
44 character*70 :: file_rnd
45 integer*4 :: size_values, unit_rnd, i, js, jr
46 integer*4, dimension(nn_loc) :: nearest_el
47
48 real*8 :: dist_sq, dist_sq_min
49 real*8, dimension(nn_loc) :: dist
50
51 real*8, dimension(:,:), allocatable :: values
52
54 file_rnd = 'NH-FILES/NHCheck00000.dat'
55
56 if (mpi_id .lt. 10) then
57 write(file_rnd(21:21),'(i1)') mpi_id;
58 else if (mpi_id .lt. 100) then
59 write(file_rnd(20:21),'(i2)') mpi_id;
60 else if (mpi_id .lt. 1000) then
61 write(file_rnd(19:21),'(i3)') mpi_id;
62 else if (mpi_id .lt. 10000) then
63 write(file_rnd(18:21),'(i4)') mpi_id;
64 else
65 write(file_rnd(17:21),'(i5)') mpi_id
66 endif
67
68 unit_rnd = 50 + mpi_id
69
70 open(unit_rnd,file=file_rnd)
71 read(unit_rnd,*) size_values
72
73 allocate(values(size_values,6))
74 values = 0.d0;
75
76 do i = 1, size_values
77 read(unit_rnd,*) values(i,1),values(i,2),values(i,3),values(i,4),values(i,5),values(i,6)
78 enddo
79
80 close(unit_rnd)
81
82
83 do js = 1, nn_loc
84
85 dist_sq_min = 1.d30
86 nearest_el(js) = -1
87
88 do jr = 1, size_values
89
90 dist_sq = (xs_loc(js) - values(jr,1))**2 + (ys_loc(js) - values(jr,2))**2 &
91 + (zs_loc(js) - values(jr,3))**2
92
93 if ( dist_sq < dist_sq_min ) then
94 dist_sq_min = dist_sq
95 nearest_el(js) = jr
96 endif
97
98 enddo
99
100
101 mu_rnd(js) = values(nearest_el(js),6) * values(nearest_el(js),4)**2
102
103 lambda_rnd(js) = values(nearest_el(js),6) * values(nearest_el(js),5)**2 - 2.d0 * mu_rnd(js)
104 rho_rnd(js) = values(nearest_el(js),6);
105
106 enddo
107
108
109 deallocate(values)
110
111
112
1.9.8