This repository has been archived by the owner on Apr 17, 2018. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 3
/
m_ppohBEM_bembb2hacapk.f90
executable file
·122 lines (117 loc) · 5.99 KB
/
m_ppohBEM_bembb2hacapk.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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
!=====================================================================*
! *
! Software Name : ppohBEM *
! Version : 0.1 *
! *
! License *
! This file is part of ppohBEM. *
! ppohBEM is a free software, you can use it under the terms *
! of The MIT License (MIT). See LICENSE file and User's guide *
! for more details. *
! *
! ppOpen-HPC project: *
! Open Source Infrastructure for Development and Execution of *
! Large-Scale Scientific Applications on Post-Peta-Scale *
! Supercomputers with Automatic Tuning (AT). *
! *
! Organizations: *
! The University of Tokyo *
! - Information Technology Center *
! - Atmosphere and Ocean Research Institute (AORI) *
! - Interfaculty Initiative in Information Studies *
! /Earthquake Research Institute (ERI) *
! - Graduate School of Frontier Science *
! Kyoto University *
! - Academic Center for Computing and Media Studies *
! Hokkaido University *
! - Information Initiative Center *
! Japan Agency for Marine-Earth Science and Technology (JAMSTEC) *
! *
! Sponsorship: *
! Japan Science and Technology Agency (JST), Basic Research *
! Programs: CREST, Development of System Software Technologies *
! for post-Peta Scale High Performance Computing. *
! *
! Copyright (c) 2014 <Takeshi Iwashita, Takeshi Mifune, Yuki Noseda,*
! Yasuhito Takahashi, Masatoshi Kawai, Akihiro Ida>*
! *
!=====================================================================*
module m_ppohBEM_bembb2hacapk
use m_HACApK_use
implicit real*8(a-h,o-z)
contains
!*** bembb2hacapk
! np ; coordinates of vertexes: x,y,z
! face2node ; nodes which compose face
! dble_para_fc ; real*8 parameters sat on each face
! rhs ; right hand side vector
! sol ; solution vector
! param ; parameter for hacapk
! lpmd ; data for mpi
! int_para_fc ; integer parameters sat on each face
! nond ; number of vertexes
! nofc ; number of faces
! nond_on_face ; number of vertexes which compose a face
! number_element_dof; degree of freedom on a face
! ndble_para_fc ; number of real*8 parameters
! nint_para_fc ; number of integer parameters
integer function bembb2hacapk(st_bemv, st_ctl, np, face2node,dble_para_fc,rhs,sol,ztol, &
int_para_fc,nond,nofc,nond_on_face,number_element_dof,ndble_para_fc,nint_para_fc)
include 'mpif.h'
type(coordinate) np(nond)
real*8 :: rhs(nofc*number_element_dof),sol(nofc*number_element_dof),dble_para_fc(ndble_para_fc,nofc),ztol
integer*4 :: face2node(nond_on_face,nofc),int_para_fc(nint_para_fc,nofc)
integer*4, dimension(:), allocatable :: lwww
integer*4,pointer :: lpmd(:)
type(st_HACApK_leafmtxp) :: st_leafmtxp
type(st_HACApK_lcontrol) :: st_ctl
type(st_HACApK_calc_entry) :: st_bemv
real*8,dimension(:,:),allocatable :: zgmin,zgmax,zgmid
1000 format(5(a,i10)/)
2000 format(5(a,f10.4)/)
lpmd => st_ctl%lpmd(:)
mpinr=lpmd(3); mpilog=lpmd(4); nrank=lpmd(2); icomm=lpmd(1)
if(st_ctl%param(1)>1 .and. mpinr==0) print*,'func bembb2hacapk start'
allocate(st_bemv%int_para_fc(nint_para_fc,nofc), st_bemv%face2node(nond_on_face,nofc))
allocate(st_bemv%dble_para_fc(ndble_para_fc,nofc))
allocate(st_bemv%np(nond))
st_bemv%nond=nond; st_bemv%nofc=nofc;
st_bemv%np=np;
if(nint_para_fc /= 0) then
st_bemv%int_para_fc=int_para_fc
endif
st_bemv%nint_para_fc=nint_para_fc
if(ndble_para_fc /= 0) then
st_bemv%dble_para_fc=dble_para_fc
endif
st_bemv%ndble_para_fc=ndble_para_fc; st_bemv%nond_on_face=nond_on_face;
st_bemv%number_element_dof=number_element_dof; st_bemv%face2node=face2node
ndim=3
allocate(st_bemv%zx(nond),st_bemv%zy(nond),st_bemv%zz(nond),stat=ierr)
if(ierr/=0)then
goto 9999
endif
do il=1,nond
st_bemv%zx(il)=np(il)%x; st_bemv%zy(il)=np(il)%y; st_bemv%zz(il)=np(il)%z;
enddo
allocate(zgmid(nofc,ndim))
do il=1,nofc
n1 = face2node(1,il)+1; n2 = face2node(2,il)+1; n3 = face2node(3,il)+1;
zgmid(il,1) = (np(n1)%x+np(n2)%x+np(n3)%x)/3.0d0; ! center of balance
zgmid(il,2) = (np(n1)%y+np(n2)%y+np(n3)%y)/3.0d0
zgmid(il,3) = (np(n1)%z+np(n2)%z+np(n3)%z)/3.0d0
!***************************************************
if (st_ctl%lpmd(30) == 0 .and. il == 1) then
write(*,*)
write(*,*) ' ** set up rhs **'
write(*,*)
end if
rhs(il)=zgmid(il,3)
!***************************************************
enddo
bembb2hacapk= hacapk_gensolv(st_leafmtxp,st_bemv,st_ctl,zgmid,rhs,sol,ztol)
lrtrn=HACApK_free_leafmtxp(st_leafmtxp)
if(st_ctl%param(1)>1 .and. mpinr==0) print*,'func bembb2hacapk end'
9999 continue
endfunction
endmodule m_ppohBEM_bembb2hacapk