Skip to content

Commit fc47b74

Browse files
hiromatsuihiromatsui
committed
Add routines for bitmap data output
1 parent 5465f17 commit fc47b74

File tree

10 files changed

+1532
-2
lines changed

10 files changed

+1532
-2
lines changed

‎src/Fortran_libraries/PARALLEL_src/COMM_src/Makefile.depends‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,8 @@ const_element_comm_tables.o: $(COMMDIR)/const_element_comm_tables.f90 m_precisio
5050
$(F90) -c $(F90OPTFLAGS) $<
5151
const_global_element_ids.o: $(COMMDIR)/const_global_element_ids.f90 m_precision.o m_constants.o m_machine_parameter.o calypso_mpi.o t_solver_SR.o t_comm_table.o calypso_mpi_int.o t_solver_SR_int8.o solver_SR_type.o t_para_double_numbering.o t_element_double_number.o
5252
$(F90) -c $(F90OPTFLAGS) $<
53+
const_surface_comm_table.o: $(COMMDIR)/const_surface_comm_table.f90 m_precision.o calypso_mpi.o t_next_node_ele_4_node.o t_mesh_data.o t_geometry_data.o t_surface_data.o t_comm_table.o t_failed_export_list.o t_mesh_SR.o m_machine_parameter.o m_geometry_constants.o t_para_double_numbering.o t_element_double_number.o t_const_comm_table.o t_sum_local_node_id_list.o const_global_element_ids.o t_work_for_comm_check.o diff_geometory_comm_test.o nod_phys_send_recv.o solver_SR_type.o mesh_send_recv_check.o
54+
$(F90) -c $(F90OPTFLAGS) $<
5355
field_to_send_buffer.o: $(COMMDIR)/field_to_send_buffer.f90 m_precision.o
5456
$(F90) -c $(F90OPTFLAGS) $<
5557
m_elapsed_labels_SEND_RECV.o: $(COMMDIR)/m_elapsed_labels_SEND_RECV.f90 m_precision.o m_work_time.o

‎src/Fortran_libraries/PARALLEL_src/COMM_src/const_surface_comm_table.f90‎

Lines changed: 179 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
!>@file const_surface_comm_table.f90
2+
!!@brief module const_surface_comm_table
3+
!!
4+
!!@author H. Matsui
5+
!!@date Programmed in June, 2015
6+
!
7+
!> @brief Belonged element list for each node
8+
!!
9+
!!@verbatim
10+
!! subroutine const_surf_comm_table &
11+
!! & (node, nod_comm, surf_comm, surf, m_SR)
12+
!! subroutine dealloc_surf_comm_table(surf_comm, surf)
13+
!! type(node_data), intent(in) :: node
14+
!! type(communication_table), intent(in) :: nod_comm
15+
!! type(communication_table), intent(inout) :: surf_comm
16+
!! type(surface_data), intent(inout) :: surf
17+
!! type(mesh_SR), intent(inout) :: m_SR
18+
!!
19+
!! subroutine surf_send_recv_test &
20+
!! & (surf, surf_comm, surf_check, SR_sig, SR_r)
21+
!! type(node_data), intent(in) :: node
22+
!! type(surface_data), intent(in) :: surf
23+
!! type(communication_table), intent(in) :: surf_comm
24+
!! type(work_for_comm_check), intent(inout) :: surf_check
25+
!! type(send_recv_status), intent(inout) :: SR_sig
26+
!! type(send_recv_real_buffer), intent(inout) :: SR_r
27+
!!@endverbatim
28+
!
29+
module const_surface_comm_table
30+
!
31+
use m_precision
32+
use calypso_mpi
33+
use t_next_node_ele_4_node
34+
use t_mesh_data
35+
use t_geometry_data
36+
use t_surface_data
37+
use t_comm_table
38+
use t_failed_export_list
39+
use t_mesh_SR
40+
!
41+
use m_machine_parameter
42+
use m_geometry_constants
43+
!
44+
implicit none
45+
!
46+
character(len=kchara), parameter :: txt_surf = 'surface'
47+
!
48+
private :: txt_surf
49+
!
50+
!-----------------------------------------------------------------------
51+
!
52+
contains
53+
!
54+
!-----------------------------------------------------------------------
55+
!
56+
subroutine const_surf_comm_table &
57+
& (node, nod_comm, surf_comm, surf, m_SR)
58+
!
59+
use t_para_double_numbering
60+
use t_element_double_number
61+
use t_const_comm_table
62+
use t_sum_local_node_id_list
63+
use const_global_element_ids
64+
!
65+
type(node_data), intent(in) :: node
66+
type(communication_table), intent(in) :: nod_comm
67+
!
68+
type(surface_data), intent(inout) :: surf
69+
type(communication_table), intent(inout) :: surf_comm
70+
type(mesh_SR), intent(inout) :: m_SR
71+
!
72+
type(node_ele_double_number) :: inod_dbl
73+
type(element_double_number) :: isurf_dbl
74+
type(element_around_node) :: neib_surf
75+
type(failed_table) :: fail_tbl_s
76+
type(sum_of_local_id_list) :: sum_list_s
77+
!
78+
integer(kind = kint) :: internal_num = 0
79+
integer(kind = kint_gl), allocatable :: istack_inersurf(:)
80+
!
81+
!
82+
call dealloc_interior_surf(surf)
83+
call alloc_global_surf_id(surf)
84+
call alloc_interior_surf(surf)
85+
!
86+
call alloc_double_numbering(node%numnod, inod_dbl)
87+
call set_node_double_numbering(node, nod_comm, inod_dbl, &
88+
& m_SR%SR_sig, m_SR%SR_i)
89+
!
90+
call alloc_ele_double_number(surf%numsurf, isurf_dbl)
91+
call find_belonged_pe_4_surf(my_rank, inod_dbl, &
92+
& surf%numsurf, surf%nnod_4_surf, surf%ie_surf, &
93+
& internal_num, surf%interior_surf, isurf_dbl)
94+
!
95+
call set_surf_id_4_node_sum_order(node, surf, inod_dbl, &
96+
& neib_surf, sum_list_s)
97+
!
98+
call alloc_failed_export(0, fail_tbl_s)
99+
call const_comm_table_by_connenct &
100+
& (txt_surf, surf%numsurf, surf%nnod_4_surf, surf%ie_surf, &
101+
& surf%x_surf, node, nod_comm, inod_dbl, isurf_dbl, neib_surf, &
102+
& sum_list_s, surf_comm, fail_tbl_s, m_SR%SR_sig)
103+
call dealloc_iele_belonged(neib_surf)
104+
call dealloc_failed_export(fail_tbl_s)
105+
!
106+
allocate(istack_inersurf(0:nprocs))
107+
istack_inersurf(0:nprocs) = 0
108+
!
109+
call count_number_of_node_stack(internal_num, istack_inersurf)
110+
call set_global_ele_id(txt_surf, surf%numsurf, istack_inersurf, &
111+
& surf%interior_surf, surf_comm, surf%isurf_global, &
112+
& m_SR%SR_sig, m_SR%SR_il)
113+
deallocate(istack_inersurf)
114+
!
115+
call calypso_mpi_barrier
116+
call check_element_position &
117+
& (txt_surf, node%inod_global, surf%numsurf, &
118+
& surf%nnod_4_surf, surf%ie_surf, surf%isurf_global, &
119+
& surf%x_surf, inod_dbl, surf_comm, m_SR%SR_sig, m_SR%SR_r)
120+
call dealloc_sum_of_local_id_list(sum_list_s)
121+
call dealloc_ele_double_number(isurf_dbl)
122+
call dealloc_double_numbering(inod_dbl)
123+
!
124+
end subroutine const_surf_comm_table
125+
!
126+
!-----------------------------------------------------------------------
127+
!
128+
subroutine dealloc_surf_comm_table(surf_comm, surf)
129+
!
130+
type(communication_table), intent(inout) :: surf_comm
131+
type(surface_data), intent(inout) :: surf
132+
!
133+
call dealloc_comm_table(surf_comm)
134+
call dealloc_interior_surf(surf)
135+
call dealloc_global_surf_id(surf)
136+
!
137+
end subroutine dealloc_surf_comm_table
138+
!
139+
!-----------------------------------------------------------------------
140+
!-----------------------------------------------------------------------
141+
!
142+
subroutine surf_send_recv_test &
143+
& (surf, surf_comm, surf_check, SR_sig, SR_r)
144+
!
145+
use t_work_for_comm_check
146+
use diff_geometory_comm_test
147+
use nod_phys_send_recv
148+
use solver_SR_type
149+
use mesh_send_recv_check
150+
!
151+
type(surface_data), intent(in) :: surf
152+
type(communication_table), intent(in) :: surf_comm
153+
!
154+
type(work_for_comm_check), intent(inout) :: surf_check
155+
type(send_recv_status), intent(inout) :: SR_sig
156+
type(send_recv_real_buffer), intent(inout) :: SR_r
157+
!
158+
!
159+
call alloc_geom_4_comm_test(surf%numsurf, surf_check)
160+
call set_element_4_comm_test(surf%numsurf, surf%interior_surf, &
161+
& surf%x_surf, surf_check%xx_test)
162+
call SOLVER_SEND_RECV_3_type(surf%numsurf, surf_comm, &
163+
& SR_sig, SR_r, surf_check%xx_test)
164+
!
165+
call ele_send_recv_check &
166+
& (surf%numsurf, surf%isurf_global, surf%x_surf, surf_check)
167+
!
168+
if(i_debug .gt. 0) write(*,*) my_rank, &
169+
& 'Failed communication for surface', surf_check%num_diff
170+
call collect_failed_comm(surf_check)
171+
if(my_rank .eq. 0) write(*,*) my_rank, &
172+
& 'Total Failed communication for surface', &
173+
& surf_check%istack_diff_pe(nprocs)
174+
!
175+
end subroutine surf_send_recv_test
176+
!
177+
! ----------------------------------------------------------------------
178+
!
179+
end module const_surface_comm_table

‎src/Fortran_libraries/SERIAL_src/BASE/Makefile.depends‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
aitoff.o: $(BASEDIR)/aitoff.f90 m_precision.o m_constants.o
2+
$(F90) -c $(F90OPTFLAGS) $<
13
append_phys_data.o: $(BASEDIR)/append_phys_data.f90 m_precision.o m_machine_parameter.o t_phys_data.o compare_indices.o
24
$(F90) -c $(F90OPTFLAGS) $<
35
cal_add_smp.o: $(BASEDIR)/cal_add_smp.f90 m_precision.o
@@ -80,6 +82,8 @@ primefac.o: $(BASEDIR)/primefac.f90 m_precision.o
8082
$(F90) -c $(F90OPTFLAGS) $<
8183
quicksort.o: $(BASEDIR)/quicksort.f90 m_precision.o m_constants.o isort_with_int.o i8sort_with_int.o dsort_with_int.o
8284
$(F90) -c $(F90OPTFLAGS) $<
85+
small_mat_mat_product.o: $(BASEDIR)/small_mat_mat_product.f90 m_precision.o
86+
$(F90) -c $(F90OPTFLAGS) $<
8387
solver_33_array.o: $(BASEDIR)/solver_33_array.f90 m_precision.o
8488
$(F90) -c $(F90OPTFLAGS) $<
8589
t_group_data.o: $(BASEDIR)/t_group_data.f90 m_precision.o
@@ -90,4 +94,6 @@ t_time_data.o: $(BASEDIR)/t_time_data.f90 m_precision.o m_constants.o m_machine_
9094
$(F90) -c $(F90OPTFLAGS) $<
9195
transfer_to_long_integers.o: $(BASEDIR)/transfer_to_long_integers.f90 m_precision.o
9296
$(F90) -c $(F90OPTFLAGS) $<
97+
transform_mat_operations.o: $(BASEDIR)/transform_mat_operations.f90 m_precision.o m_constants.o
98+
$(F90) -c $(F90OPTFLAGS) $<
9399

‎src/Fortran_libraries/SERIAL_src/BASE/aitoff.f90‎

Lines changed: 102 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,102 @@
1+
!>@file aitoff.f90
2+
!!@brief module aitoff
3+
!!
4+
!!@date Programmed by H.Matsui in March, 2009
5+
!
6+
!>@brief Program for Aitoff projection
7+
!!
8+
!!@verbatim
9+
!! subroutine s_aitoff(sin_t, cos_t, phi, xg, yg)
10+
!! real(kind = kreal), intent(in) :: sin_t, cos_t, phi
11+
!! real(kind = kreal), intent(inout) :: xg, yg
12+
!! subroutine reverse_aitoff(xg, yg, theta, phi)
13+
!! real(kind = kreal), intent(in) :: xg, yg
14+
!! real(kind = kreal), intent(inout) :: theta, phi
15+
!!*************************************************
16+
!! map projection using the Hammer-Aitoff equal-area projection
17+
!!*
18+
!!* make grid data for surface mapping
19+
!!*
20+
!!*************************************************
21+
!!*
22+
!!* sin_t, cos_t : theta of spherical coordinate (rad)
23+
!!* phi : phi of spherical coordinate (rad)
24+
!!*
25+
!!*************************************************
26+
!
27+
module aitoff
28+
!
29+
use m_precision
30+
use m_constants
31+
!
32+
implicit none
33+
!
34+
! -----------------------------------------------------------------------
35+
!
36+
contains
37+
!
38+
! -----------------------------------------------------------------------
39+
!
40+
subroutine s_aitoff(sin_t, cos_t, phi, xg, yg)
41+
!*
42+
real(kind = kreal), intent(in) :: sin_t, cos_t, phi
43+
real(kind = kreal), intent(inout) :: xg, yg
44+
!
45+
real(kind = kreal) :: xl2, den
46+
!*
47+
!
48+
xl2 = half * phi
49+
den = sqrt( one + sin_t*sin(xl2) )
50+
xg = -real( two * sin_t * cos(xl2) / den)
51+
yg = real( cos_t / den)
52+
!*
53+
end subroutine s_aitoff
54+
!
55+
! ----------------------------------------------------------------------
56+
!
57+
subroutine reverse_aitoff(xg, yg, theta, phi)
58+
!*
59+
real(kind = kreal), intent(in) :: xg, yg
60+
real(kind = kreal), intent(inout) :: theta, phi
61+
!
62+
real(kind = kreal) :: A, cosp, cost, sint, pi
63+
!*
64+
!
65+
pi = two*two*atan(one)
66+
theta = -one
67+
phi = zero
68+
!
69+
A = one - half*half * xg*xg - yg*yg
70+
if(A .le. zero) return
71+
!
72+
cost = yg * sqrt(A + one)
73+
sint = sqrt(one - yg*yg * (A + one))
74+
!
75+
if(sint .eq. zero) then
76+
if(yg .gt. zero) then
77+
theta = zero
78+
phi = zero
79+
else
80+
theta = pi
81+
phi = zero
82+
end if
83+
end if
84+
if(cost .lt. -one .or. cost .gt. one) return
85+
if(sint .lt. -one .or. sint .gt. one) return
86+
!
87+
cosp = A / sint
88+
if(cosp .lt. -one) cosp = -one
89+
if(cosp .gt. one) cosp = one
90+
!
91+
theta = acos(cost)
92+
if(xg .le. zero) then
93+
phi = two * acos(-cosp) - pi
94+
else
95+
phi = pi - two * acos(-cosp)
96+
end if
97+
!
98+
end subroutine reverse_aitoff
99+
!
100+
! ----------------------------------------------------------------------
101+
!
102+
end module aitoff

0 commit comments

Comments
 (0)