-
Notifications
You must be signed in to change notification settings - Fork 0
/
convert_to_reg_coord.f90
89 lines (63 loc) · 2.64 KB
/
convert_to_reg_coord.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
module convert_to_reg_coord_m
implicit none
interface convert_to_reg_coord
module procedure convert_int_to_reg_coord, convert_real_to_reg_coord, &
convert_polyline_to_reg_coord
! The difference between the arguments is the type of argument
! ind. If step is absent then it is assumed to be [1., 1.].
end interface convert_to_reg_coord
contains
pure function convert_int_to_reg_coord(ind, corner, step)
integer, intent(in):: ind(:, :) ! (2, :)
real, intent(in):: corner(:) ! (2)
real, intent(in), optional:: step(:) ! (2)
real convert_int_to_reg_coord(2, size(ind, 2))
! Local:
integer j
!---------------------------------------------------
if (present(step)) then
forall (j = 1:size(ind, 2)) convert_int_to_reg_coord(:, j) = corner &
+ (ind(:, j) - 1) * step
else
forall (j = 1:size(ind, 2)) convert_int_to_reg_coord(:, j) = corner &
+ ind(:, j) - 1
end if
end function convert_int_to_reg_coord
!*********************************************************************
pure function convert_real_to_reg_coord(ind, corner, step)
real, intent(in):: ind(:, :) ! (2, :)
real, intent(in):: corner(:) ! (2)
real, intent(in), optional:: step(:) ! (2)
real convert_real_to_reg_coord(2, size(ind, 2))
! Local:
integer j
!---------------------------------------------------
if (present(step)) then
forall (j = 1:size(ind, 2)) convert_real_to_reg_coord(:, j) = corner &
+ (ind(:, j) - 1.) * step
else
forall (j = 1:size(ind, 2)) convert_real_to_reg_coord(:, j) = corner &
+ ind(:, j) - 1.
end if
end function convert_real_to_reg_coord
!*********************************************************************
pure type(polyline) function convert_polyline_to_reg_coord(ind, corner, step)
use polyline_m, only: polyline
type(polyline), intent(in):: ind
real, intent(in):: corner(:) ! (2)
real, intent(in), optional:: step(:) ! (2)
! Local:
integer j
!---------------------------------------------------
convert_polyline_to_reg_coord%n_points = ind%n_points
convert_polyline_to_reg_coord%closed = ind%closed
allocate(convert_polyline_to_reg_coord%points(2, ind%n_points))
if (present(step)) then
forall (j = 1:ind%n_points) convert_polyline_to_reg_coord%points(:, j) &
= corner + (ind%points(:, j) - 1.) * step
else
forall (j = 1:ind%n_points) convert_polyline_to_reg_coord%points(:, j) &
= corner + ind%points(:, j) - 1.
end if
end function convert_polyline_to_reg_coord
end module convert_to_reg_coord_m