forked from johannesgerer/jburkardt-f
-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathellipsoid_grid_prb.f90
108 lines (89 loc) · 2.33 KB
/
ellipsoid_grid_prb.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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
program main
!*****************************************************************************80
!
!! ELLIPSOID_GRID_TEST tests ELLIPSOID_GRID.
!
! Licensing:
!
! This code is distributed under the GNU LGPL license.
!
! Modified:
!
! 10 November 2011
!
! Author:
!
! John Burkardt
!
implicit none
call timestamp ( )
write ( *, '(a)' ) ' '
write ( *, '(a)' ) 'ELLIPSOID_GRID_TEST:'
write ( *, '(a)' ) ' FORTRAN90 version'
write ( *, '(a)' ) ' Test the ELLIPSOID_GRID library.'
call ellipsoid_grid_test01 ( )
!
! Terminate.
!
write ( *, '(a)' ) ' '
write ( *, '(a)' ) 'ELLIPSOID_GRID_TEST:'
write ( *, '(a)' ) ' Normal end of execution.'
write ( *, '(a)' ) ' '
call timestamp ( )
return
end
subroutine ellipsoid_grid_test01 ( )
!*****************************************************************************80
!
!! ELLIPSOID_GRID_TEST01 tests ELLIPSOID_GRID.
!
! Licensing:
!
! This code is distributed under the GNU LGPL license.
!
! Modified:
!
! 10 November 2011
!
! Author:
!
! John Burkardt
!
implicit none
real ( kind = 8 ) c(3)
character ( len = 80 ) filename
integer ( kind = 4 ) n
integer ( kind = 4 ) ng
real ( kind = 8 ) r(3)
real ( kind = 8 ), allocatable :: xyz(:,:)
write ( *, '(a)' ) ' '
write ( *, '(a)' ) 'TEST01:'
write ( *, '(a)' ) ' ELLIPSOID_GRID can define a grid of points'
write ( *, '(a)' ) ' with N+1 points on the minor half axis,'
write ( *, '(a)' ) ' based on any ellipsoid.'
n = 4
r(1) = 2.0D+00
r(2) = 1.0D+00
r(3) = 1.5D+00
c(1) = 1.0D+00
c(2) = 2.0D+00
c(3) = 1.5D+00
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' We use N = ', n
write ( *, '(a,g14.6,a,g14.6,a,g14.6,a)' ) &
' Radius R = (', r(1), ',', r(2), ',', r(3), ')'
write ( *, '(a,g14.6,a,g14.6,a,g14.6,a)' ) &
' Center C = (', c(1), ',', c(2), ',', c(3), ')'
call ellipsoid_grid_count ( n, r, c, ng )
write ( *, '(a)' ) ' '
write ( *, '(a,i8)' ) ' Number of grid points will be ', ng
allocate ( xyz(1:3,1:ng) )
call ellipsoid_grid ( n, r, c, ng, xyz )
call r83vec_print_part ( ng, xyz, 20, ' Part of the grid point array:' )
filename = 'ellipsoid_grid_test01.xyz'
call r8mat_write ( filename, 3, ng, xyz )
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' Data written to the file "' // trim ( filename ) // '".'
deallocate ( xyz )
return
end