OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25edge_switch.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i25edge_switch ../engine/source/interfaces/int25/i25edge_switch.F
25!||--- called by ------------------------------------------------------
26!|| i25main_free ../engine/source/interfaces/intsort/i25main_free.F
27!||--- calls -----------------------------------------------------
28!|| my_barrier ../engine/source/system/machine.F
29!||====================================================================
30 SUBROUTINE i25edge_switch(
31 . JTASK,
32 . STIFM,
33 . STFE,
34 . MVOISIN,
35 . IEDGE,
36 . NEDGE,
37 . LEDGE
38 . )
39C-----------------------------------------------
40C In case of element deletion
41C LEDGE must be modified to keep the remaining
42C segment at the first position
43C If both element are deleted, STFE is set to negative
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "assert.inc"
52#include "i25edge_c.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "param_c.inc"
57#include "task_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER, INTENT(IN) :: JTASK
62 INTEGER, INTENT(IN) :: IEDGE, NEDGE
63 INTEGER, INTENT(IN) :: MVOISIN(4,*)
64 INTEGER, INTENT(INOUT) :: LEDGE(NLEDGE,*)
65C REAL
66 my_real, INTENT(IN) :: STIFM(*)
67 my_real, INTENT(INOUT) :: STFE(NEDGE)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER :: NEDG,NEDGFT,NEDGLT
72 INTEGER :: IRM,IEDG,JRM,JEDG
73 my_real :: S1,S2
74 s1 = -huge(s1)
75 s2 = -huge(s2)
76 IF(iedge/=0)THEN
77C
78 nedgft= 1+(jtask-1)*nedge/ nthread
79 nedglt= jtask*nedge/nthread
80 DO nedg=nedgft,nedglt
81 irm =ledge(ledge_left_seg,nedg)
82 iedg=ledge(ledge_left_id,nedg)
83 jrm =ledge(ledge_right_seg,nedg)
84 jedg=ledge(ledge_right_id,nedg)
85 IF(jrm/=0)THEN
86
87 IF(irm > 0 .AND. jrm > 0) THEN
88C not free, both segments are local to the SPMD domain
89 s1 = stifm(irm)
90 s2 = stifm(jrm)
91 ELSEIF(irm < 0 .AND. jrm > 0) THEN
92C if IRM is negative, then JRM must be zero
93C because split_interface
94 assert(.false.)
95C edge at the boundary of spmd domains
96C secnd side treated by the other domain
97 s1 = one ! exact stiffness not known, but it is nnz
98C MVOISIN = 0 <=> STFM( VOISIN )) = 0
99 IF(mvoisin(jedg,jrm) == 0 ) s1 = zero
100 s2 = stifm(jrm)
101 ELSEIF(irm > 0 .AND. jrm < 0) THEN
102C edge at the boundary of SPMD domains
103C secnd side treated by ISPMD
104 s1 = stifm(irm)
105!exact stiffness on the other side of the boundary is not known yet
106! But we can determine if it is zero or not according to MVOISIN
107 s2 = one
108 IF(mvoisin(iedg,irm) == 0) s2 = zero
109 ELSE
110C not supposed to be there
111 assert(.false.)
112 ENDIF
113
114 IF(s1 == zero)THEN
115C first (left) segment is broken
116C new left <= old right
117C old right <= 0
118C in order to always have the unbroken segment in the first place
119C DEBUG_E2E(LEDGE(LEDGE_GLOBAL_ID,NEDG) == D_EM,S1)
120C DEBUG_E2E(LEDGE(LEDGE_GLOBAL_ID,NEDG) == D_ES,S1)
121
122CC ???????????????????????????????????????????????
123 IF(jrm > 0) THEN
124 ledge(ledge_left_seg,nedg) = jrm
125 ledge(ledge_left_id,nedg) = jedg
126 ELSEIF (jrm < 0) THEN
127 ledge(ledge_left_seg,nedg) = -abs(irm) !1
128C LEDGE(LEDGE_LEFT_SEG,NEDG) = JEDG !2
129 ! LEDGE(LEDGE_LEFT_ID,NEDG) unchanged
130 ENDIF
131C tag for comm in spmd_getstif25_edg
132 IF(ledge(ledge_weight,nedg) == 1) THEN
133 ledge(ledge_global_id,nedg) = -abs(ledge(ledge_global_id,nedg))
134 ENDIF
135CC ???????????????????????????????????????????????
136
137 ledge(ledge_seg1_im,nedg) = ledge(ledge_seg2_im,nedg)
138 ledge(ledge_seg1_i1,nedg) = ledge(ledge_seg2_i1,nedg)
139 ledge(ledge_seg1_i2,nedg) = ledge(ledge_seg2_i2,nedg)
140 ledge(ledge_right_seg,nedg) = 0
141
142 IF(jrm >= 0) THEN
143 ledge(ledge_right_id,nedg) = 0
144 ELSE
145
146 ENDIF
147
148 ELSEIF(s2 == zero)THEN
149C left segment has broken
150C DEBUG_E2E(LEDGE(LEDGE_GLOBAL_ID,NEDG) == D_EM,S2)
151C DEBUG_E2E(LEDGE(LEDGE_GLOBAL_ID,NEDG) == D_ES,S2)
152 ledge(ledge_right_seg,nedg) = 0
153 ledge(ledge_right_id,nedg) = 0
154
155C tag for comm in spmd_getstif25_edg
156 IF(ledge(ledge_weight,nedg) == 1) THEN
157 ledge(ledge_global_id,nedg) = -abs(ledge(ledge_global_id,nedg))
158 ENDIF
159
160
161 END IF
162 END IF
163 END DO
164
165C=======================================================================
166 DO nedg = nedgft,nedglt
167 irm = ledge(ledge_left_seg,nedg)
168 jrm = ledge(ledge_right_seg,nedg)
169C DEBUG_E2E(LEDGE(LEDGE_GLOBAL_ID,NEDG) == D_ES,STFE(NEDG))
170
171 IF(irm > 0) THEN
172C on peut passer ici: cas d edge de bord
173C dont le irect casse (o ne passe pas dans le switch (1,2) <- (3,4) au dessus
174C DEBUG_E2E(LEDGE(LEDGE_GLOBAL_ID,NEDG) == D_ES,STIFM(IRM))
175 IF(stifm(irm)==zero)THEN
176 IF(stfe(nedg) > zero) THEN
177 stfe(nedg) = -stfe(nedg)
178 ENDIF
179 ENDIF
180 ELSE IF(irm < 0) THEN
181! Edge frontiere
182! The only way that IRM < 0 is when
183C - the a boundary edge owned by ISPMD
184! - the local segment is broken
185
186C 1 -1 IRM
187C 1 1 IEDG
188C -1 0 JRM
189C 1 0 JEDG
190 s1 = one
191 iedg=ledge(ledge_left_id ,nedg)
192 IF(jrm == 0) THEN
193 IF(mvoisin(iedg,abs(irm))==0) s1 = zero
194C When IRM < 0 and JRM == 0
195C STFE is 0 if the other side is broken too
196C Because we always put the remaining segment first (IRM,IEDG)
197C we need to check
198C ELSE IF( ) THEN
199C S1 = 0
200 ELSE
201 assert(.false.)
202 ENDIF
203
204 IF(s1==zero)THEN
205 IF(stfe(nedg) > zero) THEN
206 stfe(nedg) = -stfe(nedg)
207 ENDIF
208 ENDIF
209
210 ELSEIF (irm == 0) THEN
211 assert(.false.) !
212 IF(stfe(nedg) > zero) THEN
213 stfe(nedg) = -stfe(nedg)
214 END IF
215 END IF
216 END DO
217
218 CALL my_barrier
219 END IF ! IEDGE
220 RETURN
221 END
i25edge_switch
subroutine i25edge_switch(jtask, stifm, stfe, mvoisin, iedge, nedge, ledge)
Definition i25edge_switch.F:39
my_barrier
subroutine my_barrier
Definition machine.F:31