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