Skip to content

Commit 6d24347

Browse files
committed
Moved arange's unit tests to test_stdlib_math;
And improved some stuff in stdlib_math.md.
1 parent 6957436 commit 6d24347

File tree

6 files changed

+148
-143
lines changed

6 files changed

+148
-143
lines changed

doc/specs/stdlib_math.md

Lines changed: 41 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -320,7 +320,7 @@ program demo_logspace_rstart_cbase
320320
321321
end program demo_logspace_rstart_cbase
322322
```
323-
### `arange`
323+
### `arange` - Creates fixed-spaced values of given spacing, within a given interval
324324

325325
#### Status
326326

@@ -332,7 +332,7 @@ Pure function.
332332

333333
#### Description
334334

335-
Creates a one-dimensional `array` of the `integer/real` type with fixed-spaced values of given spacing, within a given interval.
335+
Creates a rank-1 `array` of the `integer/real` type with fixed-spaced values of given spacing, within a given interval.
336336

337337
#### Syntax
338338

@@ -360,7 +360,7 @@ If `step < 0`, the `step` argument will be corrected to `abs(step)` by the inter
360360

361361
#### Return value
362362

363-
Returns a one-dimensional `array` of fixed-spaced values.
363+
Returns a rank-1 `array` of fixed-spaced values.
364364

365365
For `integer` type arguments, the length of the result vector is `(end - start)/step + 1`.
366366
For `real` type arguments, the length of the result vector is `floor((end - start)/step) + 1`.
@@ -371,20 +371,20 @@ For `real` type arguments, the length of the result vector is `floor((end - star
371371
program demo_math_arange
372372
use stdlib_math, only: arange
373373
374-
print *, arange(3) !! [1,2,3]
375-
print *, arange(-1) !! [1,0,-1]
376-
print *, arange(0,2) !! [0,1,2]
377-
print *, arange(1,-1) !! [1,0,-1]
378-
print *, arange(0, 2, 2) !! [0,2]
374+
print *, arange(3) ! [1,2,3]
375+
print *, arange(-1) ! [1,0,-1]
376+
print *, arange(0,2) ! [0,1,2]
377+
print *, arange(1,-1) ! [1,0,-1]
378+
print *, arange(0, 2, 2) ! [0,2]
379379
380-
print *, arange(3.0) !! [1.0,2.0,3.0]
381-
print *, arange(0.0,5.0) !! [0.0,1.0,2.0,3.0,4.0,5.0]
382-
print *, arange(0.0,6.0,2.5) !! [0.0,2.5,5.0]
380+
print *, arange(3.0) ! [1.0,2.0,3.0]
381+
print *, arange(0.0,5.0) ! [0.0,1.0,2.0,3.0,4.0,5.0]
382+
print *, arange(0.0,6.0,2.5) ! [0.0,2.5,5.0]
383383
384-
print *, (1.0,1.0)*arange(3) !! [(1.0,1.0),(2.0,2.0),[3.0,3.0]]
384+
print *, (1.0,1.0)*arange(3) ! [(1.0,1.0),(2.0,2.0),[3.0,3.0]]
385385
386-
print *, arange(0.0,2.0,-2.0) !! [0.0,2.0]. Not recommended: `step` argument is negative!
387-
print *, arange(0.0,2.0,0.0) !! [0.0,1.0,2.0]. Not recommended: `step` argument is zero!
386+
print *, arange(0.0,2.0,-2.0) ! [0.0,2.0]. Not recommended: `step` argument is negative!
387+
print *, arange(0.0,2.0,0.0) ! [0.0,1.0,2.0]. Not recommended: `step` argument is zero!
388388
389389
end program demo_math_arange
390390
```
@@ -424,9 +424,9 @@ Notes: Although the angle of the complex number `0` is undefined, `arg((0,0))` r
424424
```fortran
425425
program demo_math_arg
426426
use stdlib_math, only: arg
427-
print *, arg((0.0, 0.0)) !! 0.0
428-
print *, arg((3.0, 4.0)) !! 0.927
429-
print *, arg(2.0*exp((0.0, 0.5))) !! 0.5
427+
print *, arg((0.0, 0.0)) ! 0.0
428+
print *, arg((3.0, 4.0)) ! 0.927
429+
print *, arg(2.0*exp((0.0, 0.5))) ! 0.5
430430
end program demo_math_arg
431431
```
432432

@@ -465,9 +465,9 @@ Notes: Although the angle of the complex number `0` is undefined, `argd((0,0))`
465465
```fortran
466466
program demo_math_argd
467467
use stdlib_math, only: argd
468-
print *, argd((0.0, 0.0)) !! 0.0
469-
print *, argd((3.0, 4.0)) !! 53.1°
470-
print *, argd(2.0*exp((0.0, 0.5))) !! 28.64°
468+
print *, argd((0.0, 0.0)) ! 0.0
469+
print *, argd((3.0, 4.0)) ! 53.1°
470+
print *, argd(2.0*exp((0.0, 0.5))) ! 28.64°
471471
end program demo_math_argd
472472
```
473473

@@ -506,13 +506,13 @@ Notes: Although the angle of the complex number `0` is undefined, `argpi((0,0))`
506506
```fortran
507507
program demo_math_argpi
508508
use stdlib_math, only: argpi
509-
print *, argpi((0.0, 0.0)) !! 0.0
510-
print *, argpi((3.0, 4.0)) !! 0.295
511-
print *, argpi(2.0*exp((0.0, 0.5))) !! 0.159
509+
print *, argpi((0.0, 0.0)) ! 0.0
510+
print *, argpi((3.0, 4.0)) ! 0.295
511+
print *, argpi(2.0*exp((0.0, 0.5))) ! 0.159
512512
end program demo_math_argpi
513513
```
514514

515-
### `is_close`
515+
### `is_close` - Returns a boolean scalar/array where two scalars/arrays are element-wise equal within a tolerance
516516

517517
#### Description
518518

@@ -577,15 +577,15 @@ program demo_math_is_close
577577
y = -3
578578
NAN = sqrt(y)
579579
580-
print *, is_close(x,[real :: 1, 2.1]) !! [T, F]
581-
print *, is_close(2.0, 2.1, abs_tol=0.1) !! T
582-
print *, NAN, is_close(2.0, NAN), is_close(2.0, NAN, equal_nan=.true.) !! NAN, F, F
583-
print *, is_close(NAN, NAN), is_close(NAN, NAN, equal_nan=.true.) !! F, T
580+
print *, is_close(x,[real :: 1, 2.1]) ! [T, F]
581+
print *, is_close(2.0, 2.1, abs_tol=0.1) ! T
582+
print *, NAN, is_close(2.0, NAN), is_close(2.0, NAN, equal_nan=.true.) ! NAN, F, F
583+
print *, is_close(NAN, NAN), is_close(NAN, NAN, equal_nan=.true.) ! F, T
584584
585585
end program demo_math_is_close
586586
```
587587

588-
### `all_close`
588+
### `all_close` - Returns a boolean scalar where two arrays are element-wise equal within a tolerance
589589

590590
#### Description
591591

@@ -643,29 +643,26 @@ program demo_math_all_close
643643
NAN = sqrt(y)
644644
z = (1.0, 1.0)
645645
646-
print *, all_close(z+cmplx(1.0e-11, 1.0e-11), z) !! T
646+
print *, all_close(z+cmplx(1.0e-11, 1.0e-11), z) ! T
647647
print *, NAN, all_close([NAN], [NAN]), all_close([NAN], [NAN], equal_nan=.true.)
648-
!! NAN, F, T
648+
! NAN, F, T
649649
650650
end program demo_math_all_close
651651
```
652652

653-
### `diff`
653+
### `diff` - Computes differences between adjacent elements of an array
654654

655655
#### Description
656656

657657
Computes differences between adjacent elements of an array.
658658

659659
#### Syntax
660660

661-
For a rank-1 array
662-
```fortran
663-
y = [[stdlib_math(module):diff(interface)]](x [, n, prepend, append])
664-
```
665-
and for a rank-2 array
666-
```fortran
667-
y = [[stdlib_math(module):diff(interface)]](x [, n, dim, prepend, append])
668-
```
661+
For a rank-1 array:
662+
`y = [[stdlib_math(module):diff(interface)]](x [, n, prepend, append])`
663+
664+
and for a rank-2 array:
665+
`y = [[stdlib_math(module):diff(interface)]](x [, n, dim, prepend, append])`
669666

670667
#### Status
671668

@@ -696,16 +693,17 @@ Shall be a `real/integer` and `rank-1/rank-2` array.
696693
This argument is `intent(in)` and `optional`, which is no value by default.
697694

698695
Note:
699-
- The `x`, `prepend` and `append` arguments must have the same `type`, `kind` and `rank`.
700-
- If the value of `n` is less than or equal to `0` (which is not recommended), the return value of `diff` is `x`.
696+
697+
- The `x`, `prepend` and `append` arguments must have the same `type`, `kind` and `rank`.
698+
- If the value of `n` is less than or equal to `0` (which is not recommended), the return value of `diff` is `x`.
701699
- If the value of `dim` is not equal to `1` or `2` (which is not recommended),
702700
`1` will be used by the internal process of `diff`.
703701

704702

705703
#### Result value
706704

707705
Returns the finite difference of the input array.
708-
Shall be a `real/integer` and `rank-1/rank-2` array.
706+
Shall be a `real/integer` and `rank-1/rank-2` array.
709707
When both `prepend` and `append` are not present, the result `y` has one fewer element than `x` alongside the dimension `dim`.
710708

711709
#### Example

src/stdlib_math.fypp

Lines changed: 19 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -287,7 +287,8 @@ module stdlib_math
287287
!>
288288
!> `arange` creates a one-dimensional `array` of the `integer/real` type
289289
!> with fixed-spaced values of given spacing, within a given interval.
290-
!> ([Specification](../page/specs/stdlib_math.html#arange))
290+
!> ([Specification](../page/specs/stdlib_math.html#
291+
!>arange-creates-fixed-spaced-values-of-given-spacing-within-a-given-interval))
291292
interface arange
292293
#:set RI_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES
293294
#:for k1, t1 in RI_KINDS_TYPES
@@ -302,7 +303,8 @@ module stdlib_math
302303
!> Version: experimental
303304
!>
304305
!> `arg` computes the phase angle in the interval (-π,π].
305-
!> ([Specification](../page/specs/stdlib_math.html#arg))
306+
!> ([Specification](../page/specs/stdlib_math.html#
307+
!>arg-computes-the-phase-angle-in-radian-of-a-complex-scalar))
306308
interface arg
307309
#:for k1 in CMPLX_KINDS
308310
procedure :: arg_${k1}$
@@ -312,7 +314,8 @@ module stdlib_math
312314
!> Version: experimental
313315
!>
314316
!> `argd` computes the phase angle of degree version in the interval (-180.0,180.0].
315-
!> ([Specification](../page/specs/stdlib_math.html#argd))
317+
!> ([Specification](../page/specs/stdlib_math.html#
318+
!>argd-computes-the-phase-angle-in-degree-of-a-complex-scalar))
316319
interface argd
317320
#:for k1 in CMPLX_KINDS
318321
procedure :: argd_${k1}$
@@ -322,15 +325,17 @@ module stdlib_math
322325
!> Version: experimental
323326
!>
324327
!> `argpi` computes the phase angle of circular version in the interval (-1.0,1.0].
325-
!> ([Specification](../page/specs/stdlib_math.html#argpi))
328+
!> ([Specification](../page/specs/stdlib_math.html#
329+
!>argpi-computes-the-phase-angle-in-circular-of-a-complex-scalar))
326330
interface argpi
327331
#:for k1 in CMPLX_KINDS
328332
procedure :: argpi_${k1}$
329333
#:endfor
330334
end interface argpi
331335

332336
!> Returns a boolean scalar/array where two scalar/arrays are element-wise equal within a tolerance.
333-
!> ([Specification](../page/specs/stdlib_math.html#is_close))
337+
!> ([Specification](../page/specs/stdlib_math.html#
338+
!>is_close-returns-a-boolean-scalararray-where-two-scalarsarrays-are-element-wise-equal-within-a-tolerance))
334339
interface is_close
335340
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
336341
#:for k1, t1 in RC_KINDS_TYPES
@@ -345,7 +350,8 @@ module stdlib_math
345350
!> Version: experimental
346351
!>
347352
!> Returns a boolean scalar where two arrays are element-wise equal within a tolerance.
348-
!> ([Specification](../page/specs/stdlib_math.html#all_close))
353+
!> ([Specification](../page/specs/stdlib_math.html#
354+
!>all_close-returns-a-boolean-scalar-where-two-arrays-are-element-wise-equal-within-a-tolerance))
349355
interface all_close
350356
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
351357
#:set RANKS = range(1, MAXRANK + 1)
@@ -363,7 +369,8 @@ module stdlib_math
363369
!> Version: experimental
364370
!>
365371
!> Computes differences between adjacent elements of an array.
366-
!> ([Specification](../page/specs/stdlib_math.html#diff))
372+
!> ([Specification](../page/specs/stdlib_math.html#
373+
!>diff-computes-differences-between-adjacent-elements-of-an-array))
367374
interface diff
368375
#:set RI_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES
369376
#:for k1, t1 in RI_KINDS_TYPES
@@ -409,17 +416,18 @@ contains
409416
${t1}$, intent(in) :: z
410417
real(${k1}$) :: result
411418

412-
result = merge(0.0_${k1}$, atan2(z%im, z%re), z == (0.0_${k1}$, 0.0_${k1}$)) &
413-
*180.0_${k1}$/PI_${k1}$
419+
result = merge(0.0_${k1}$, atan2(z%im, z%re)*180.0_${k1}$/PI_${k1}$, &
420+
z == (0.0_${k1}$, 0.0_${k1}$))
414421

415422
end function argd_${k1}$
416423

417424
elemental function argpi_${k1}$(z) result(result)
418425
${t1}$, intent(in) :: z
419426
real(${k1}$) :: result
420427

421-
result = merge(0.0_${k1}$, atan2(z%im, z%re), z == (0.0_${k1}$, 0.0_${k1}$)) &
422-
/PI_${k1}$
428+
result = merge(0.0_${k1}$, atan2(z%im, z%re)/PI_${k1}$, &
429+
z == (0.0_${k1}$, 0.0_${k1}$))
430+
423431

424432
end function argpi_${k1}$
425433
#:endfor

src/tests/math/CMakeLists.txt

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,4 +7,3 @@ fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
77
ADDTEST(stdlib_math)
88
ADDTEST(linspace)
99
ADDTEST(logspace)
10-
ADDTEST(math_arange)

src/tests/math/Makefile.manual

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@ SRCFYPP = \
33
SRCGEN = $(SRCFYPP:.fypp=.f90)
44

55
PROGS_SRC = test_linspace.f90 test_logspace.f90 \
6-
test_math_arange.f90 \
76
$(SRCGEN)
87

98
$(SRCGEN): %.f90: %.fypp ../../common.fypp

src/tests/math/test_math_arange.f90

Lines changed: 0 additions & 86 deletions
This file was deleted.

0 commit comments

Comments
 (0)