10 integer,
private:: verbose=0
11 type,
private:: node_t
12 type(node_t),
pointer:: next=>null()
14 type(node_t),
private,
pointer:: head=>null(), tail=>null()
15 integer,
private,
save:: id=0
17 integer,
private:: nalloc=0
19 module procedure scalar_log_scalar
22 module procedure scalar_exp_scalar
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
31 out(:,:,i) =
log(in(:,:,i))
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
40 out(:,:,i) =
exp(in(:,:,i))
45 SUBROUTINE allocate_scalars_a (n, v1, v2, v3, v4, v5, v6, v7, v8, v9, v10)
47 real,
dimension(:,:,:),
allocatable,
optional:: v1, v2, v3, v4, v5, v6, v7, v8, v9, v10
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')
74 SUBROUTINE allocate_scalars (n, v1, v2, v3, v4, v5, v6, v7, v8, v9, v10)
76 real,
dimension(:,:,:),
pointer,
optional:: v1, v2, v3, v4, v5, v6, v7, v8, v9, v10
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')
103 SUBROUTINE deallocate_scalars_a (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10)
105 real,
dimension(:,:,:),
allocatable,
optional:: v1, v2, v3, v4, v5, v6, v7, v8, v9, v10
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)
132 SUBROUTINE deallocate_scalars (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10)
134 real,
dimension(:,:,:),
pointer,
optional:: v1, v2, v3, v4, v5, v6, v7, v8, v9, v10
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)
161 SUBROUTINE scalar_stats (f, label)
162 real,
dimension(:,:,:):: f
163 character(len=*):: label
165 real(8):: s0, s1, s2, s3
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))
181 s2 = sqrt(s2/
size(f)-s1**2)
182 print*,
'scalar_stats:', trim(label),
': min, aver, rms, max =', s0, s1, s2, s3