OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i8msr3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i8msr3 (x, irect, lmsr, msr, nsv, iloc, irtl, nseg, xface, nbsecnds, itab, has_moved, tab_rmax, tab_rmax_uid, lft, llt, nft)

Function/Subroutine Documentation

◆ i8msr3()

subroutine i8msr3 ( dimension(3,*), intent(in) x,
integer, dimension(4,*), intent(in) irect,
integer, dimension(*), intent(in) lmsr,
integer, dimension(*), intent(in) msr,
integer, dimension(*), intent(in) nsv,
integer, dimension(*), intent(in) iloc,
integer, dimension(*), intent(inout) irtl,
integer, dimension(*), intent(in) nseg,
intent(in) xface,
integer nbsecnds,
integer, dimension(*) itab,
integer, dimension(*) has_moved,
tab_rmax,
integer, dimension(4,*) tab_rmax_uid,
integer, intent(inout) lft,
integer, intent(inout) llt,
integer, intent(inout) nft )

Definition at line 33 of file i8msr3.F.

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
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
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