16 SUBROUTINE load_interface(mesh_master, mesh_slave, list_inter, mesh_INTERFACE, disjoint)
20 TYPE(mesh_type),
INTENT(IN) :: mesh_master, mesh_slave
21 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_inter
23 LOGICAL,
INTENT(IN) :: disjoint
25 INTEGER :: dim, ms, ms1, ms2, ns, k, nws_master, nws_slave, m1, m2
26 INTEGER,
DIMENSION(:),
ALLOCATABLE :: list, interface_mesh1, interface_mesh2
27 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: interface_jjs1, interface_jjs2
28 REAL(KIND=8) :: eps_ref=1.d-7, r_norm, epsilon
30 LOGICAL,
DIMENSION(:),
ALLOCATABLE :: virgin_elem
36 nws_master =
SIZE(mesh_master%jjs,1)
37 nws_slave =
SIZE(mesh_slave%jjs,1)
40 IF (nws_master > nws_slave)
THEN
41 WRITE(*,*)
' BUG in load_interface: nws_master > nws_slave '
45 dim =
SIZE(mesh_master%rr,1)
47 WRITE(*,*)
' Dimension 3 not yet programmed '
51 ALLOCATE(virgin_elem(mesh_slave%me), list(dim), interface_mesh1(mesh_master%mes), &
52 interface_mesh2(mesh_slave%mes), interface_jjs1(nws_master,mesh_master%mes), &
53 interface_jjs2(nws_slave,mesh_slave%mes) )
58 DO ms1 = 1, mesh_master%mes
59 IF(minval(abs(list_inter-mesh_master%sides(ms1))) /= 0) cycle
60 r_norm = sum(abs(mesh_master%rr(:,mesh_master%jjs(1,ms1))- &
61 & mesh_master%rr(:,mesh_master%jjs(2,ms1))))
62 epsilon = eps_ref*r_norm
65 lp2:
DO ms2 = 1, mesh_slave%mes
67 IF(minval(abs(list_inter-mesh_slave%sides(ms2))) /= 0) cycle
72 list(ns) = modulo(ns-1+k,dim) + 1
75 IF (maxval(abs(mesh_master%rr(:,mesh_master%jjs(list,ms1))&
76 -mesh_slave%rr(:,mesh_slave%jjs(1:dim,ms2)))).GT.epsilon) cycle
78 IF(.NOT.virgin_elem(ms2))
THEN
83 m1 = mesh_master%neighs(ms1)
84 m2 = mesh_slave%neighs(ms2)
85 r_norm = sum(abs(mesh_master%rr(:,mesh_master%jj(1:3,m1)) &
86 - mesh_slave%rr(:,mesh_slave%jj(1:3,m2))))
87 IF ( r_norm .LE. 1d-9)
THEN
92 interface_mesh1(ms) = ms1
93 interface_mesh2(ms) = ms2
94 interface_jjs1(1:2,ms) = mesh_master%jjs(list,ms1)
95 interface_jjs2(:,ms) = mesh_slave%jjs(:,ms2)
96 IF (nws_master==3)
THEN
97 interface_jjs1(3,ms) = mesh_master%jjs(3,ms1)
100 virgin_elem(ms2) =.false.
101 IF (.NOT.disjoint) virgin_elem(ms1) =.false.
108 WRITE(*,*) .NOT.
' BUG in load_interface: okay'
113 mesh_interface%mes = ms
115 ALLOCATE( mesh_interface%mesh1(ms), mesh_interface%mesh2(ms),&
116 mesh_interface%jjs1(nws_master,ms), mesh_interface%jjs2(nws_slave,ms))
119 mesh_interface%mesh1 = interface_mesh1(1:ms)
120 mesh_interface%mesh2 = interface_mesh2(1:ms)
121 mesh_interface%jjs1 = interface_jjs1(1:nws_master,1:ms)
122 mesh_interface%jjs2 = interface_jjs2(1:nws_slave,1:ms)
125 DEALLOCATE(virgin_elem, list, interface_mesh1, interface_mesh2, &
126 interface_jjs1,interface_jjs2)
136 TYPE(mesh_type),
INTENT(IN) :: mesh_master, mesh_slave
137 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_inter
140 INTEGER :: dim, ms1, ms2, ns, k, m, n, nn, &
141 nws_master, nws_slave, nw_slave, n_count
142 INTEGER,
DIMENSION(:),
ALLOCATABLE :: list, interface_slave_elem_temp, &
144 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: interface_master_node_temp
145 REAL(KIND=8) :: eps_ref=1.d-7, r_norm, epsilon
147 LOGICAL,
DIMENSION(:),
ALLOCATABLE :: virgin_elem, virgin_node, virgin_node_inter
149 nws_master = mesh_master%gauss%n_ws
150 nws_slave = mesh_slave%gauss%n_ws
151 nw_slave = mesh_slave%gauss%n_w
153 IF (nws_master > nws_slave)
THEN
154 WRITE(*,*)
' BUG in load_mesh_interface: nws_master > nws_slave'
158 dim =
SIZE(mesh_master%rr,1)
160 WRITE(*,*)
' Dimension 3 not yet programmed '
164 ALLOCATE(virgin_elem(mesh_slave%me), list(dim), virgin_node(mesh_slave%np), &
165 node_master(mesh_slave%np), interface_slave_elem_temp(mesh_slave%me),&
166 interface_master_node_temp(nw_slave,mesh_slave%me), virgin_node_inter(mesh_slave%nps))
169 virgin_node_inter = .true.
170 DO ms2 = 1, mesh_slave%mes
171 IF(minval(abs(list_inter-mesh_slave%sides(ms2))) /= 0) cycle
172 virgin_node_inter(mesh_slave%iis(:,ms2)) = .false.
175 DO n = 1, mesh_slave%nps
176 IF (virgin_node_inter(n)) cycle
177 n_count = n_count + 1
179 ALLOCATE( mesh_interface%list_slave_node(n_count))
181 DO n = 1, mesh_slave%nps
182 IF (virgin_node_inter(n)) cycle
183 n_count = n_count + 1
184 mesh_interface%list_slave_node(n_count) = mesh_slave%j_s(n)
191 DO ms1 = 1, mesh_master%mes
192 IF(minval(abs(list_inter-mesh_master%sides(ms1))) /= 0) cycle
193 r_norm = sum(abs(mesh_master%rr(:,mesh_master%jjs(1,ms1))- &
194 & mesh_master%rr(:,mesh_master%jjs(2,ms1))))
195 epsilon = eps_ref*r_norm
197 lp2:
DO ms2 = 1, mesh_slave%mes
198 IF(.NOT.virgin_elem(ms2)) cycle
199 IF(minval(abs(list_inter-mesh_slave%sides(ms2))) /= 0) cycle
203 list(ns) = modulo(ns-1+k,dim) + 1
206 IF (maxval(abs(mesh_master%rr(:,mesh_master%jjs(list,ms1))&
207 -mesh_slave%rr(:,mesh_slave%jjs(1:dim,ms2)))).GT.epsilon) cycle
209 node_master(mesh_slave%jjs(:,ms2)) = mesh_master%jjs(list,ms1)
210 IF (nws_master==3)
THEN
211 node_master(mesh_slave%jjs(3,ms2)) = mesh_master%jjs(3,ms1)
213 virgin_node(mesh_slave%jjs(1:nws_master,ms2)) = .false.
215 virgin_elem(ms2) =.false.
222 WRITE(*,*) .NOT.
' BUG in load_mesh_interface: okay'
227 interface_master_node_temp = -1
228 mesh_interface%me = 0
229 DO m = 1, mesh_slave%me
232 IF(virgin_node(mesh_slave%jj(n,m))) cycle
234 interface_master_node_temp(n,m) = node_master(mesh_slave%jj(n,m))
237 mesh_interface%me = mesh_interface%me + 1
238 interface_slave_elem_temp( mesh_interface%me) = m
243 ALLOCATE( mesh_interface%slave_elem( mesh_interface%me))
244 ALLOCATE( mesh_interface%master_node(nw_slave, mesh_interface%me), &
245 mesh_interface%slave_node (nw_slave, mesh_interface%me))
247 mesh_interface%slave_elem = interface_slave_elem_temp(1: mesh_interface%me)
249 mesh_interface%slave_node = mesh_slave%jj(:, mesh_interface%slave_elem)
251 mesh_interface%master_node = interface_master_node_temp(:, mesh_interface%slave_elem)
253 DEALLOCATE(virgin_elem, list, virgin_node, virgin_node_inter, &
254 node_master, interface_slave_elem_temp,&
255 interface_master_node_temp)
subroutine, public load_mesh_interface(mesh_master, mesh_slave, list_inter, mesh_INTERFACE)
subroutine, public load_interface(mesh_master, mesh_slave, list_inter, mesh_INTERFACE, disjoint)