DISPATCH
scalar_mod.f90
1 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
2 !> $Id: 60b088a98f28fc5591c7a1458e11be1042278487 $
3 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
4 MODULE scalar_mod
5  USE io_mod
6  USE trace_mod
7  implicit none
8  public
9  !
10  integer, private:: verbose=0
11  type, private:: node_t
12  type(node_t), pointer:: next=>null()
13  end type
14  type(node_t), private, pointer:: head=>null(), tail=>null()
15  integer, private, save:: id=0
16  !
17  integer, private:: nalloc=0
18  interface log
19  module procedure scalar_log_scalar
20  end interface
21  interface exp
22  module procedure scalar_exp_scalar
23  end interface
24 CONTAINS
25 
26 FUNCTION scalar_log_scalar(in) RESULT (out)
27  real, dimension(:,:,:), intent(in):: in
28  real, dimension(size(in,1),size(in,2),size(in,3)):: out
29  integer:: i
30  do i=1,size(in,3)
31  out(:,:,i) = log(in(:,:,i))
32  end do
33 END FUNCTION
34 
35 FUNCTION scalar_exp_scalar(in) RESULT (out)
36  real, dimension(:,:,:), intent(in):: in
37  real, dimension(size(in,1),size(in,2),size(in,3)):: out
38  integer:: i
39  do i=1,size(in,3)
40  out(:,:,i) = exp(in(:,:,i))
41  end do
42 END FUNCTION
43 
44 !===============================================================================
45 SUBROUTINE allocate_scalars_a (n, v1, v2, v3, v4, v5, v6, v7, v8, v9, v10)
46  integer:: n(3)
47  real, dimension(:,:,:), allocatable, optional:: v1, v2, v3, v4, v5, v6, v7, v8, v9, v10
48  !.............................................................................
49  call trace_begin('allocate_scalars_a')
50  if (present(v1)) allocate(v1(n(1),n(2),n(3)))
51  if (present(v2)) allocate(v2(n(1),n(2),n(3)))
52  if (present(v3)) allocate(v3(n(1),n(2),n(3)))
53  if (present(v4)) allocate(v4(n(1),n(2),n(3)))
54  if (present(v5)) allocate(v5(n(1),n(2),n(3)))
55  if (present(v6)) allocate(v6(n(1),n(2),n(3)))
56  if (present(v7)) allocate(v7(n(1),n(2),n(3)))
57  if (present(v8)) allocate(v8(n(1),n(2),n(3)))
58  if (present(v9)) allocate(v9(n(1),n(2),n(3)))
59  if (present(v10)) allocate(v10(n(1),n(2),n(3)))
60  if (present(v1)) call io%bits_mem(storage_size(v1),product(shape(v1)),'v1')
61  if (present(v2)) call io%bits_mem(storage_size(v2),product(shape(v2)),'v2')
62  if (present(v3)) call io%bits_mem(storage_size(v3),product(shape(v3)),'v3')
63  if (present(v4)) call io%bits_mem(storage_size(v4),product(shape(v4)),'v4')
64  if (present(v5)) call io%bits_mem(storage_size(v5),product(shape(v5)),'v5')
65  if (present(v6)) call io%bits_mem(storage_size(v6),product(shape(v6)),'v6')
66  if (present(v7)) call io%bits_mem(storage_size(v7),product(shape(v7)),'v7')
67  if (present(v8)) call io%bits_mem(storage_size(v8),product(shape(v8)),'v8')
68  if (present(v9)) call io%bits_mem(storage_size(v9),product(shape(v9)),'v9')
69  if (present(v10)) call io%bits_mem(storage_size(v10),product(shape(v10)),'v10')
70  call trace_end
71 END SUBROUTINE
72 
73 !===============================================================================
74 SUBROUTINE allocate_scalars (n, v1, v2, v3, v4, v5, v6, v7, v8, v9, v10)
75  integer:: n(3)
76  real, dimension(:,:,:), pointer, optional:: v1, v2, v3, v4, v5, v6, v7, v8, v9, v10
77  !.............................................................................
78  call trace_begin('allocate_scalars')
79  if (present(v1)) allocate(v1(n(1),n(2),n(3)))
80  if (present(v2)) allocate(v2(n(1),n(2),n(3)))
81  if (present(v3)) allocate(v3(n(1),n(2),n(3)))
82  if (present(v4)) allocate(v4(n(1),n(2),n(3)))
83  if (present(v5)) allocate(v5(n(1),n(2),n(3)))
84  if (present(v6)) allocate(v6(n(1),n(2),n(3)))
85  if (present(v7)) allocate(v7(n(1),n(2),n(3)))
86  if (present(v8)) allocate(v8(n(1),n(2),n(3)))
87  if (present(v9)) allocate(v9(n(1),n(2),n(3)))
88  if (present(v10)) allocate(v10(n(1),n(2),n(3)))
89  if (present(v1)) call io%bits_mem(storage_size(v1),product(shape(v1)),'v1')
90  if (present(v2)) call io%bits_mem(storage_size(v2),product(shape(v2)),'v2')
91  if (present(v3)) call io%bits_mem(storage_size(v3),product(shape(v3)),'v3')
92  if (present(v4)) call io%bits_mem(storage_size(v4),product(shape(v4)),'v4')
93  if (present(v5)) call io%bits_mem(storage_size(v5),product(shape(v5)),'v5')
94  if (present(v6)) call io%bits_mem(storage_size(v6),product(shape(v6)),'v6')
95  if (present(v7)) call io%bits_mem(storage_size(v7),product(shape(v7)),'v7')
96  if (present(v8)) call io%bits_mem(storage_size(v8),product(shape(v8)),'v8')
97  if (present(v9)) call io%bits_mem(storage_size(v9),product(shape(v9)),'v9')
98  if (present(v10)) call io%bits_mem(storage_size(v10),product(shape(v10)),'v10')
99  call trace_end
100 END SUBROUTINE
101 
102 !===============================================================================
103 SUBROUTINE deallocate_scalars_a (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10)
104  integer:: n(3)
105  real, dimension(:,:,:), allocatable, optional:: v1, v2, v3, v4, v5, v6, v7, v8, v9, v10
106  !.............................................................................
107  call trace_begin('deallocate_scalars_a')
108  if (present(v1)) call io%bits_mem(storage_size(v1),-product(shape(v1)),'v1')
109  if (present(v2)) call io%bits_mem(storage_size(v2),-product(shape(v2)),'v2')
110  if (present(v3)) call io%bits_mem(storage_size(v3),-product(shape(v3)),'v3')
111  if (present(v4)) call io%bits_mem(storage_size(v4),-product(shape(v4)),'v4')
112  if (present(v5)) call io%bits_mem(storage_size(v5),-product(shape(v5)),'v5')
113  if (present(v6)) call io%bits_mem(storage_size(v6),-product(shape(v6)),'v6')
114  if (present(v7)) call io%bits_mem(storage_size(v7),-product(shape(v7)),'v7')
115  if (present(v8)) call io%bits_mem(storage_size(v8),-product(shape(v8)),'v8')
116  if (present(v9)) call io%bits_mem(storage_size(v9),-product(shape(v9)),'v9')
117  if (present(v10)) call io%bits_mem(storage_size(v10),-product(shape(v10)),'v10')
118  if (present(v1)) deallocate(v1)
119  if (present(v2)) deallocate(v2)
120  if (present(v3)) deallocate(v3)
121  if (present(v4)) deallocate(v4)
122  if (present(v5)) deallocate(v5)
123  if (present(v6)) deallocate(v6)
124  if (present(v7)) deallocate(v7)
125  if (present(v8)) deallocate(v8)
126  if (present(v9)) deallocate(v9)
127  if (present(v10)) deallocate(v10)
128  call trace_end
129 END SUBROUTINE
130 
131 !===============================================================================
132 SUBROUTINE deallocate_scalars (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10)
133  integer:: n(3)
134  real, dimension(:,:,:), pointer, optional:: v1, v2, v3, v4, v5, v6, v7, v8, v9, v10
135  !.............................................................................
136  call trace_begin('deallocate_scalars')
137  if (present(v1)) call io%bits_mem(storage_size(v1),-product(shape(v1)),'v1')
138  if (present(v2)) call io%bits_mem(storage_size(v2),-product(shape(v2)),'v2')
139  if (present(v3)) call io%bits_mem(storage_size(v3),-product(shape(v3)),'v3')
140  if (present(v4)) call io%bits_mem(storage_size(v4),-product(shape(v4)),'v4')
141  if (present(v5)) call io%bits_mem(storage_size(v5),-product(shape(v5)),'v5')
142  if (present(v6)) call io%bits_mem(storage_size(v6),-product(shape(v6)),'v6')
143  if (present(v7)) call io%bits_mem(storage_size(v7),-product(shape(v7)),'v7')
144  if (present(v8)) call io%bits_mem(storage_size(v8),-product(shape(v8)),'v8')
145  if (present(v9)) call io%bits_mem(storage_size(v9),-product(shape(v9)),'v9')
146  if (present(v10)) call io%bits_mem(storage_size(v10),-product(shape(v10)),'v10')
147  if (present(v1)) deallocate(v1)
148  if (present(v2)) deallocate(v2)
149  if (present(v3)) deallocate(v3)
150  if (present(v4)) deallocate(v4)
151  if (present(v5)) deallocate(v5)
152  if (present(v6)) deallocate(v6)
153  if (present(v7)) deallocate(v7)
154  if (present(v8)) deallocate(v8)
155  if (present(v9)) deallocate(v9)
156  if (present(v10)) deallocate(v10)
157  call trace_end
158 END SUBROUTINE
159 
160 !===============================================================================
161 SUBROUTINE scalar_stats (f, label)
162  real, dimension(:,:,:):: f
163  character(len=*):: label
164  integer:: ix, iy, iz
165  real(8):: s0, s1, s2, s3
166  s1 = 0d0
167  s2 = 0d0
168  s0 = f(1,1,1)
169  s3 = f(1,1,1)
170  do iz=1,size(f,3)
171  do iy=1,size(f,2)
172  do ix=1,size(f,1)
173  s1 = s1 + f(ix,iy,iz)
174  s2 = s2 + f(ix,iy,iz)**2
175  s0 = min(s0,f(ix,iy,iz))
176  s3 = max(s3,f(ix,iy,iz))
177  end do
178  end do
179  end do
180  s1 = s1/size(f)
181  s2 = sqrt(s2/size(f)-s1**2)
182  print*,'scalar_stats:', trim(label), ': min, aver, rms, max =', s0, s1, s2, s3
183 END SUBROUTINE
184 
185 !===============================================================================
186 END MODULE scalar_mod
Definition: io_mod.f90:4