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
87 !HAS_MOVED(i) == 1 : the main node of the ith secnd may have
88 !changed (i.e. it has changed locally, or was not on this processor)
89 !HAS_MOVED(i) == 0 : the ith secnd node keep the same main
90
91 has_moved(1:nbsecnds) = 1
92 tab_rmax(1:nbsecnds) = zero
93 tab_rmax_uid(1:4,1:nbsecnds) = 0
94
95 DO i=lft,llt
96 il=i+nft
97 ig=nsv(il)
98 jl=iloc(il)
99 IF(jl <= 0) cycle
100 jg=msr(jl)
101 l=irtl(il)
102
103 IF(xface(i)==zero)THEN
104 irtl(il)=max(l,1)
105 ELSE
106 bmax=-ep30
107 lseg_old=l
108 lseg_new=0
109C
110 IF(l<=0) GOTO 100
111 ! IF this secnd has a main face from the previous cycle,
112 ! this one is checked first
113
114 face_glob_id(1) = itab(msr(irect(1,l)))
115 face_glob_id(2) = itab(msr(irect(2,l)))
116 face_glob_id(3) = itab(msr(irect(3,l)))
117 face_glob_id(4) = itab(msr(irect(4,l)))
118
119 DO jjj=1,4
120 jj=jjj
121 IF(irect(jj,l)==jl) EXIT
122 ENDDO
123 j1=km1(jj)
124 j2=kn1(jj)
125 IF(jj==3.AND.irect(3,l)==irect(4,l)) j1=1
126 m=msr(irect(j1,l))
127 n=msr(irect(j2,l))
128 CALL i8_nearest_seg(x, ig, jg, m, n, bmin)
129 iflag=is_sup_face_id(tab_rmax_uid(1,il),face_glob_id)
130
131 IF(bmin > bmax .OR. (bmin == bmax .AND. iflag == 1)) THEN
132 lseg_new=lseg_old
133 bmax=bmin
134 tab_rmax(il) = bmax
135 tab_rmax_uid(1,il) = face_glob_id(1)
136 tab_rmax_uid(2,il) = face_glob_id(2)
137 tab_rmax_uid(3,il) = face_glob_id(3)
138 tab_rmax_uid(4,il) = face_glob_id(4)
139 ENDIF
140
141 IF(bmin >= zero) THEN
142 has_moved(il) = 0
143 GO TO 200
144 ENDIF
145C
146 100 CONTINUE
147 ll1=nseg(jl)
148 ll2=nseg(jl+1)-1
149 DO ll=ll1,ll2
150 lg=lmsr(ll)
151 lseg=lg
152 IF(l==lg) cycle
153 DO jjj=1,4
154 jj=jjj
155 IF(irect(jj,lg)==jl) EXIT
156 ENDDO
157 j1=km1(jj)
158 j2=kn1(jj)
159 IF(jj==3.AND.irect(3,lg)==irect(4,lg)) j1=1
160 face_glob_id(1) =itab(msr(irect(1,lg)))
161 face_glob_id(2) =itab(msr(irect(2,lg)))
162 face_glob_id(3) =itab(msr(irect(3,lg)))
163 face_glob_id(4) =itab(msr(irect(4,lg)))
164 m=msr(irect(j1,lg))
165 n=msr(irect(j2,lg))
166 CALL i8_nearest_seg(x, ig, jg, m, n, bmin)
167 iflag=is_sup_face_id(tab_rmax_uid(1,il),face_glob_id)
168 IF(bmin > bmax .OR. (bmin == bmax .AND. iflag == 1)) THEN
169 lseg_new=lseg
170 bmax=bmin
171 tab_rmax(il) = bmax
172 tab_rmax_uid(1,il) = face_glob_id(1)
173 tab_rmax_uid(2,il) = face_glob_id(2)
174 tab_rmax_uid(3,il) = face_glob_id(3)
175 tab_rmax_uid(4,il) = face_glob_id(4)
176 ENDIF
177
178 IF(bmin < zero) cycle
179 irtl(il)=lseg_new
180 has_moved(il) = 1
181 GO TO 200
182 ENDDO !LL=LL1,LL2
183C
184 irtl(il)=lseg_new
185 has_moved(il)=1
186 200 CONTINUE
187
188 tab_rmax(il) = bmax
189 tab_rmax_uid(1,il) = itab(msr(irect(1,lseg_new)))
190 tab_rmax_uid(2,il) = itab(msr(irect(2,lseg_new)))
191 tab_rmax_uid(3,il) = itab(msr(irect(3,lseg_new)))
192 tab_rmax_uid(4,il) = itab(msr(irect(4,lseg_new)))
193
194 ENDIF !XFACE
195 ENDDO !I=LFT,LLT
196
197 RETURN
198 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
intvo8
subroutine intvo8(ipari, x, a, icodt, fsav, v, ms, fskyi, isky, fcont, fncont, ftcont, icontact, rcontact, stifn, itab, intbuf_tab, t8, h3d_data, nin, pskids, tagncont, kloadpinter, loadpinter, loadp_hyd_inter)
Definition intvo8.F:52
is_sup_face_id
integer function is_sup_face_id(a, b)
Definition is_sup_face_id.F:31
max
#define max(a, b)
Definition macros.h:21