OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i8msr3.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!|| i8msr3 ../engine/source/interfaces/inter3d/i8msr3.F
25!||--- called by ------------------------------------------------------
26!|| intvo8 ../engine/source/interfaces/inter3d/intvo8.F
27!||--- calls -----------------------------------------------------
28!|| i8_nearest_seg ../engine/source/interfaces/inter3d/i8_nearest_seg.F
29!|| is_sup_face_id ../engine/source/interfaces/inter3d/is_sup_face_id.F
30!||--- uses -----------------------------------------------------
31!|| int8_mod ../common_source/modules/interfaces/int8_mod.F90
32!||====================================================================
33 SUBROUTINE i8msr3(
34 1 X, IRECT, LMSR, MSR,
35 2 NSV, ILOC, IRTL, NSEG,
36 3 XFACE, NBSECNDS, ITAB, HAS_MOVED,
37 4 TAB_RMAX, TAB_RMAX_UID,LFT, LLT,
38 5 NFT)
39C-----------------------------------------------
40C I n f o r m a t i o n s
41C-----------------------------------------------
42C This routine computes the local value of IRTL
43C on each SPMD dommain
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE int8_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C G l o b a l P a r a m e t e r s
54C-----------------------------------------------
55#include "mvsiz_p.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER, INTENT(INOUT) :: LFT
60 INTEGER, INTENT(INOUT) :: LLT
61 INTEGER, INTENT(INOUT) :: NFT
62 INTEGER, INTENT(IN) :: IRECT(4,*), LMSR(*), MSR(*), NSV(*), ILOC(*), NSEG(*)
63 INTEGER, INTENT(INOUT) :: IRTL(*)
64 my_real, DIMENSION(MVSIZ), INTENT(IN) :: xface
65 my_real, INTENT(IN) :: x(3,*)
66
67 INTEGER TAB_RMAX_UID(4,*),HAS_MOVED(*)
68 INTEGER NBSECNDS,ITAB(*)
69 my_real tab_rmax(*)
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I, IL, JL, L, JJJ, JJ, J1, J2, LL1, LL2, LL, LG, IG, JG, M, N
74 INTEGER KM1(4), KN1(4), LSEG, LSEG_OLD, LSEG_NEW, IFLAG
75 INTEGER FACE_GLOB_ID(4)
76 my_real BMIN, BMAX
77 DATA KM1/2,3,4,1/
78 DATA kn1/4,1,2,3/
79C-----------------------------------------------
80C E x t e r n a l F u n c t i o n s
81C-----------------------------------------------
82 INTEGER IS_SUP_FACE_ID
83 EXTERNAL is_sup_face_id
84C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----A----+----B----+----C--
85
86 ! At the end of this routine !HAS_MOVED(i) == 1 : the main node of the ith second may have
87 !changed (i.e. it has changed locally, or was not on this processor)
88 !HAS_MOVED(i) == 0 : the ith second node keep the same main
89
90 has_moved(1:nbsecnds) = 1
91 tab_rmax(1:nbsecnds) = zero
92 tab_rmax_uid(1:4,1:nbsecnds) = 0
93
94 DO i=lft,llt
95 il=i+nft
96 ig=nsv(il)
97 jl=iloc(il)
98 IF(jl <= 0) cycle
99 jg=msr(jl)
100 l=irtl(il)
101
102 IF(xface(i)==zero)THEN
103 irtl(il)=max(l,1)
104 ELSE
105 bmax=-ep30
106 lseg_old=l
107 lseg_new=0
108C
109 IF(l<=0) GOTO 100
110 ! IF this second has a main face from the previous cycle,
111 ! this one is checked first
112
113 face_glob_id(1) = itab(msr(irect(1,l)))
114 face_glob_id(2) = itab(msr(irect(2,l)))
115 face_glob_id(3) = itab(msr(irect(3,l)))
116 face_glob_id(4) = itab(msr(irect(4,l)))
117
118 DO jjj=1,4
119 jj=jjj
120 IF(irect(jj,l)==jl) EXIT
121 ENDDO
122 j1=km1(jj)
123 j2=kn1(jj)
124 IF(jj==3.AND.irect(3,l)==irect(4,l)) j1=1
125 m=msr(irect(j1,l))
126 n=msr(irect(j2,l))
127 CALL i8_nearest_seg(x, ig, jg, m, n, bmin)
128 iflag=is_sup_face_id(tab_rmax_uid(1,il),face_glob_id)
129
130 IF(bmin > bmax .OR. (bmin == bmax .AND. iflag == 1)) THEN
131 lseg_new=lseg_old
132 bmax=bmin
133 tab_rmax(il) = bmax
134 tab_rmax_uid(1,il) = face_glob_id(1)
135 tab_rmax_uid(2,il) = face_glob_id(2)
136 tab_rmax_uid(3,il) = face_glob_id(3)
137 tab_rmax_uid(4,il) = face_glob_id(4)
138 ENDIF
139
140 IF(bmin >= zero) THEN
141 has_moved(il) = 0
142 GO TO 200
143 ENDIF
144C
145 100 CONTINUE
146 ll1=nseg(jl)
147 ll2=nseg(jl+1)-1
148 DO ll=ll1,ll2
149 lg=lmsr(ll)
150 lseg=lg
151 IF(l==lg) cycle
152 DO jjj=1,4
153 jj=jjj
154 IF(irect(jj,lg)==jl) EXIT
155 ENDDO
156 j1=km1(jj)
157 j2=kn1(jj)
158 IF(jj==3.AND.irect(3,lg)==irect(4,lg)) j1=1
159 face_glob_id(1) =itab(msr(irect(1,lg)))
160 face_glob_id(2) =itab(msr(irect(2,lg)))
161 face_glob_id(3) =itab(msr(irect(3,lg)))
162 face_glob_id(4) =itab(msr(irect(4,lg)))
163 m=msr(irect(j1,lg))
164 n=msr(irect(j2,lg))
165 CALL i8_nearest_seg(x, ig, jg, m, n, bmin)
166 iflag=is_sup_face_id(tab_rmax_uid(1,il),face_glob_id)
167 IF(bmin > bmax .OR. (bmin == bmax .AND. iflag == 1)) THEN
168 lseg_new=lseg
169 bmax=bmin
170 tab_rmax(il) = bmax
171 tab_rmax_uid(1,il) = face_glob_id(1)
172 tab_rmax_uid(2,il) = face_glob_id(2)
173 tab_rmax_uid(3,il) = face_glob_id(3)
174 tab_rmax_uid(4,il) = face_glob_id(4)
175 ENDIF
176
177 IF(bmin < zero) cycle
178 irtl(il)=lseg_new
179 has_moved(il) = 1
180 GO TO 200
181 ENDDO !LL=LL1,LL2
182C
183 irtl(il)=lseg_new
184 has_moved(il)=1
185 200 CONTINUE
186
187 tab_rmax(il) = bmax
188 tab_rmax_uid(1,il) = itab(msr(irect(1,lseg_new)))
189 tab_rmax_uid(2,il) = itab(msr(irect(2,lseg_new)))
190 tab_rmax_uid(3,il) = itab(msr(irect(3,lseg_new)))
191 tab_rmax_uid(4,il) = itab(msr(irect(4,lseg_new)))
192
193 ENDIF !XFACE
194 ENDDO !I=LFT,LLT
195
196 RETURN
197 END
my_real
#define my_real
Definition cppsort.cpp:32
i8_nearest_seg
subroutine i8_nearest_seg(x, is, m1, m2, m3, bmin)
Definition i8_nearest_seg.F:29
i8msr3
subroutine i8msr3(x, irect, lmsr, msr, nsv, iloc, irtl, nseg, xface, nbsecnds, itab, has_moved, tab_rmax, tab_rmax_uid, lft, llt, nft)
Definition i8msr3.F:39
max
#define max(a, b)
Definition macros.h:21