Choral
real_type.F90
Go to the documentation of this file.
1 
32 
33 module real_type
34 
35  implicit none
36 
37  private
38 
39  !! CONSTANTS
40  public :: sp, dp, rp
41  public :: real_tol !! tested
42  public :: pi !! tested
43 
44  !! DERIVED TYPES
45  public :: r_1d, r_2d
46 
47  !! ROUTINES
48  public :: equal !! tested
49  public :: re !! tested
50  public :: allocmem, freemem, print
51 
52 
53  ! %----------------------------------------%
54  ! | |
55  ! | CONSTANTS |
56  ! | |
57  ! %----------------------------------------%
58 
60  integer, parameter :: sp = selected_real_kind(6, 37)
61 
63  integer, parameter :: dp = selected_real_kind(12)
64 
66  integer, parameter :: tp = selected_real_kind(17)
67 
69  integer, parameter :: qp = selected_real_kind(32)
70 
73 #if RPC==4
74  integer , parameter :: rp = sp
75  real(RP), parameter :: real_tol = 1e-6_rp
76 
77 #elif RPC==8
78  integer , parameter :: rp = dp
79  real(RP), parameter :: real_tol = 1e-14_rp
80 
81 #elif RPC==12
82  integer , parameter :: rp = tp
83  real(RP), parameter :: real_tol = 1e-18_rp
84 
85 #elif RPC==16
86  integer , parameter :: rp = qp
87  real(RP), parameter :: real_tol = 1e-28_rp
88 
89 # else
90  integer, parameter :: rp = dp
91  real(RP), parameter :: real_tol = 1e-14_rp
92 
93 #endif
94 
96  real(RP), parameter :: pi=3.1415926535897932384626433832795028_rp
97 
98  ! %----------------------------------------%
99  ! | |
100  ! | DERIVED TYPE |
101  ! | |
102  ! %----------------------------------------%
103 
106  type r_1d
107  real(RP), dimension(:), allocatable :: y
108  contains
109  final :: r_1d_clear
110  end type r_1d
111 
114  type r_2d
115  real(RP), dimension(:,:), allocatable :: y
116  contains
117  final :: r_2d_clear
118  end type r_2d
119 
120  ! %----------------------------------------%
121  ! | |
122  ! | INTERFACES |
123  ! | |
124  ! %----------------------------------------%
125 
127  interface clear
128  module procedure r_1d_clear
129  module procedure r_2d_clear
130  end interface clear
131 
132  !! constructor
133  interface r_1d
134  module procedure r_1d_create
135  end interface r_1d
136  interface r_2d
137  module procedure r_2d_create
138  end interface r_2d
139 
141  interface print
142  module procedure r2d_print
143  end interface print
144 
146  interface equal
147  module procedure real_equal
148  end interface equal
149 
153  interface re
154  module procedure rf, ri
155  end interface re
156 
158  interface allocmem
159  module procedure alloc_ra1d, alloc_ra2d, alloc_ra3d
160  end interface allocmem
161 
163  interface freemem
164  module procedure free_ra1d, free_ra2d, free_ra3d
165  end interface freemem
166 
167 contains
168 
171  subroutine r_1d_clear(r)
172  type(r_1d), intent(inout) :: r
173 
174  call freemem(r%y)
175 
176  end subroutine r_1d_clear
177 
180  subroutine r_2d_clear(r)
181  type(r_2d), intent(inout) :: r
182 
183  call freemem(r%y)
184 
185  end subroutine r_2d_clear
186 
189  function r_1d_create(n) result(r)
190  type(r_1d) :: r
191  integer, intent(in) :: n
192 
193  call allocmem(r%y, n)
194 
195  end function r_1d_create
196 
199  function r_2d_create(n1, n2) result(r)
200  type(r_2d) :: r
201  integer, intent(in) :: n1, n2
202 
203  call allocmem(r%y, n1, n2)
204 
205  end function r_2d_create
206 
207 
210  subroutine r2d_print(x)
211  real(RP), dimension(:,:), intent(in) :: x
212 
213  integer :: ii
214  real(SP) :: min, max
215 
216  write(*,*) "real_type : R2D_print"
217  write(*,*) " shape = ",&
218  & int(size(x,1),4), int(size(x,2),4)
219  write(*,*) " Component Min Max"
220  do ii=1, size(x,1)
221  min = real( minval(x(ii,:)), SP)
222  max = real( maxval(x(ii,:)), SP)
223  write(*,*) int(ii,4), min, max
224  end do
225 
226  end subroutine r2d_print
227 
228 
230  subroutine alloc_ra1d(p,n)
231  real(RP), dimension(:), allocatable :: p
232  integer, intent(in) :: n
233 
234  integer :: stat
235  character(len=100) :: errmsg
236 
237  call freemem(p)
238  allocate(p(n), stat=stat, errmsg=errmsg)
239  if (stat > 0) write(*,*) &
240  & "ERROR = real_type: alloc_RA1D: ", trim(errmsg)
241 
242  end subroutine alloc_ra1d
243 
244 
246  subroutine alloc_ra2d(p,n1,n2)
247  real(RP), dimension(:,:), allocatable :: p
248  integer, intent(in) :: n1,n2
249 
250  integer :: stat
251  character(len=100) :: errmsg
252 
253  call freemem(p)
254  allocate(p(n1,n2), stat=stat, errmsg=errmsg)
255  if (stat > 0) write(*,*) &
256  & "ERROR = real_type: alloc_RA2D: ", trim(errmsg)
257 
258  end subroutine alloc_ra2d
259 
260 
262  subroutine alloc_ra3d(p,n1,n2,n3)
263  real(RP), dimension(:,:,:), allocatable :: p
264  integer, intent(in) :: n1,n2,n3
265 
266  integer :: stat
267  character(len=100) :: errmsg
268 
269  call freemem(p)
270  allocate(p(n1,n2,n3), stat=stat, errmsg=errmsg)
271  if (stat > 0) write(*,*) &
272  & "ERROR = real_type:alloc_ RA3D: ", trim(errmsg)
273 
274  end subroutine alloc_ra3d
275 
276 
278  subroutine free_ra1d(p)
279  real(RP), dimension(:), allocatable :: p
280 
281  integer :: stat
282  character(len=100) :: errmsg
283 
284  if (allocated(p)) then
285  deallocate(p, stat=stat, errmsg=errmsg)
286  if (stat > 0) write(*,*) &
287  & "ERROR = real_type: free_RA1D: ", trim(errmsg)
288  end if
289 
290  end subroutine free_ra1d
291 
293  subroutine free_ra2d(p)
294  real(RP), dimension(:,:), allocatable :: p
295 
296  integer :: stat
297  character(len=100) :: errmsg
298 
299  if (allocated(p)) then
300  deallocate(p, stat=stat, errmsg=errmsg)
301  if (stat > 0) write(*,*) &
302  & "ERROR = real_type: free_RA2D: ", trim(errmsg)
303  end if
304 
305  end subroutine free_ra2d
306 
307 
309  subroutine free_ra3d(p)
310  real(RP), dimension(:,:,:), allocatable :: p
311 
312  integer :: stat
313  character(len=100) :: errmsg
314 
315  if (allocated(p)) then
316  deallocate(p, stat=stat, errmsg=errmsg)
317  if (stat > 0) write(*,*) &
318  & "ERROR = real_type: free_RA3D: ", trim(errmsg)
319  end if
320 
321  end subroutine free_ra3d
322 
327  function real_equal(u, v) result(res)
328  logical :: res
329  real(RP), intent(in) :: u, v
330 
331  res = abs(u-v) < real_tol
332 
333  end function real_equal
334 
335 
337  function rf(n, d)
338  integer, intent(in) :: n, d
339  real(RP) :: rf
340 
341  rf = real(n, rp)/real(d, rp)
342 
343  end function rf
344 
346  function ri(n)
347  integer, intent(in) :: n
348  real(RP) :: ri
349 
350  ri = real(n, rp)
351 
352  end function ri
353 
354 
355 end module real_type
integer, parameter qp
quadruple precision for real numbers
Definition: real_type.F90:69
integer, parameter tp
triple precision for real numbers
Definition: real_type.F90:66
deallocate memory for real(RP) arrays
Definition: real_type.F90:163
type(r_1d) function r_1d_create(n)
constructor
Definition: real_type.F90:190
real(rp) function rf(n, d)
Conversion of rational fraction n/d –> real(RP)
Definition: real_type.F90:338
subroutine r_2d_clear(r)
Destructor.
Definition: real_type.F90:181
integer, parameter, public rp
real(kind=RP) = real precision in the code REAL_TOL = epsilon to test real equality ...
Definition: real_type.F90:90
integer, parameter, public sp
simple precision for real numbers
Definition: real_type.F90:60
Test real equality.
Definition: real_type.F90:146
destructor
Definition: real_type.F90:127
conversion integers or rational to real
Definition: real_type.F90:153
REAL NUMBERS PRECISION IN CHORAL: selects simple/double/quad
Definition: real_type.F90:33
logical function real_equal(u, v)
Check real equality
Definition: real_type.F90:328
real(rp) function ri(n)
Conversion integer –> real(RP)
Definition: real_type.F90:347
subroutine free_ra1d(p)
de-allocate a one-dimensional real allocatable array
Definition: real_type.F90:279
subroutine alloc_ra3d(p, n1, n2, n3)
allocate a 3-dimensional real allocatable array
Definition: real_type.F90:263
subroutine r2d_print(x)
print short informations
Definition: real_type.F90:211
real(rp) function e(x, v1, v2)
subroutine free_ra2d(p)
de-allocate a 2-dimensional real allocatable array
Definition: real_type.F90:294
type(r_2d) function r_2d_create(n1, n2)
constructor
Definition: real_type.F90:200
R_1D: this type will allow to define arrays of 1D real arrays.
Definition: real_type.F90:106
subroutine r_1d_clear(r)
Destructor.
Definition: real_type.F90:172
real(rp), parameter, public pi
REAL CONSTANT Pi.
Definition: real_type.F90:96
allocate memory for real(RP) arrays
Definition: real_type.F90:158
subroutine alloc_ra2d(p, n1, n2)
allocate a two-dimensional real allocatable array
Definition: real_type.F90:247
subroutine free_ra3d(p)
de-allocate a 3-dimensional real allocatable array
Definition: real_type.F90:310
subroutine alloc_ra1d(p, n)
allocate a one-dimensional real allocatable array
Definition: real_type.F90:231
integer, parameter, public dp
double precision for real numbers
Definition: real_type.F90:63
real(rp), parameter, public real_tol
Definition: real_type.F90:91
short description for real arrays
Definition: real_type.F90:141
R_2D: this type will allow to define arrays of 2D real arrays.
Definition: real_type.F90:114