OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_encin_2.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "scr07_c.inc"
#include "sms_c.inc"
#include "stati_c.inc"
#include "task_c.inc"
#include "warn_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sms_encin_2 (timers, itask, nodft, nodlt, nodxi_sms, ms, jad_sms, jdi_sms, lt_sms, indx1_sms, diag_sms, iad_elem, fr_elem, weight, v, a, wv, wmv, wdg, xmom_sms, icodt, icodr, iskew, skew, ibfv, vel, npc, tf, x, d, sensors, iframe, xframe, jadi_sms, jdii_sms, lti_sms, iskyi_sms, mskyi_sms, fr_sms, fr_rms, npby, tagslv_rby_sms, intstamp, cptreac, nodreac, fthreac, ar, vr, dr, in, rby, irbe2, lrbe2, iad_rbe2, fr_rbe2m, nmrbe2, r2size, irbe3, lrbe3, frbe3, iad_rbe3m, fr_rbe3m, fr_rbe3mp, rrbe3, rrbe3_pon, iad_rby, fr_rby6, rby6, lpby, tagmsr_rby_sms, r3size, nodii_sms, indx2_sms, ibcscyc, lbcscyc, output, mskyi_fi_sms, list_sms, list_rms, vfi, sz_mw6, mw6)

Function/Subroutine Documentation

◆ sms_encin_2()

subroutine sms_encin_2 ( type(timer_), intent(inout) timers,
integer itask,
integer nodft,
integer nodlt,
integer, dimension(*) nodxi_sms,
ms,
integer, dimension(*) jad_sms,
integer, dimension(*) jdi_sms,
lt_sms,
integer, dimension(*) indx1_sms,
diag_sms,
integer, dimension(2,nspmd+1) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
v,
a,
wv,
wmv,
wdg,
xmom_sms,
integer, dimension(*) icodt,
integer, dimension(*) icodr,
integer, dimension(*) iskew,
skew,
integer, dimension(nifv,*) ibfv,
vel,
integer, dimension(*) npc,
tf,
x,
d,
type (sensors_), intent(in) sensors,
integer, dimension(liskn,*) iframe,
xframe,
integer, dimension(*) jadi_sms,
integer, dimension(*) jdii_sms,
lti_sms,
integer, dimension(*) iskyi_sms,
mskyi_sms,
integer, dimension(nspmd+1) fr_sms,
integer, dimension(nspmd+1) fr_rms,
integer, dimension(nnpby,*) npby,
integer, dimension(*) tagslv_rby_sms,
type(intstamp_data), dimension(*) intstamp,
integer cptreac,
integer, dimension(*) nodreac,
fthreac,
ar,
vr,
dr,
in,
rby,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer, dimension(*) iad_rbe2,
integer, dimension(*) fr_rbe2m,
integer nmrbe2,
integer r2size,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
integer, dimension(*) iad_rbe3m,
integer, dimension(*) fr_rbe3m,
integer, dimension(*) fr_rbe3mp,
rrbe3,
double precision, dimension(*) rrbe3_pon,
integer, dimension(*) iad_rby,
integer, dimension(*) fr_rby6,
double precision, dimension(8,6,nrbykin) rby6,
integer, dimension(*) lpby,
integer, dimension(*) tagmsr_rby_sms,
integer r3size,
integer, dimension(*) nodii_sms,
integer, dimension(*) indx2_sms,
integer, dimension(*) ibcscyc,
integer, dimension(*) lbcscyc,
type(output_), intent(inout) output,
intent(inout) mskyi_fi_sms,
integer, dimension(fr_sms(nspmd+1)), intent(inout) list_sms,
integer, dimension(fr_rms(nspmd+1)), intent(inout) list_rms,
intent(inout) vfi,
integer, intent(in) sz_mw6,
intent(inout) mw6 )
Parameters
[in,out]outputoutput structure

Definition at line 48 of file sms_encin_2.F.

66C-----------------------------------------------
67C M o d u l e s
68C-----------------------------------------------
69 USE timer_mod
70 USE intstamp_mod
71 USE message_mod
72 USE sensor_mod
73 USE output_mod
74C-----------------------------------------------
75C I m p l i c i t T y p e s
76C-----------------------------------------------
77#include "implicit_f.inc"
78#include "comlock.inc"
79C-----------------------------------------------
80C C o m m o n B l o c k s
81C-----------------------------------------------
82#include "com01_c.inc"
83#include "com04_c.inc"
84#include "com06_c.inc"
85#include "com08_c.inc"
86#include "param_c.inc"
87#include "parit_c.inc"
88#include "scr07_c.inc"
89#include "sms_c.inc"
90#include "stati_c.inc"
91#include "task_c.inc"
92#include "warn_c.inc"
93C-----------------------------------------------
94C D u m m y A r g u m e n t s
95C-----------------------------------------------
96 TYPE(TIMER_) ,INTENT(INOUT) :: TIMERS
97 INTEGER ITASK, NODFT, NODLT, NODXI_SMS(*),
98 . JAD_SMS(*), JDI_SMS(*), INDX1_SMS(*),
99 . IAD_ELEM(2,NSPMD+1) ,FR_ELEM(*), WEIGHT(*),
100 . ICODT(*), ICODR(*), ISKEW(*),
101 . NPC(*), IBFV(NIFV,*),IFRAME(LISKN,*),
102 . JADI_SMS(*), JDII_SMS(*),CPTREAC,NODREAC(*),
103 . FR_SMS(NSPMD+1), FR_RMS(NSPMD+1), ISKYI_SMS(*),
104 . NPBY(NNPBY,*), TAGSLV_RBY_SMS(*),
105 . IRBE2(NRBE2L,*), LRBE2(*), IAD_RBE2(*),
106 . FR_RBE2M(*), NMRBE2, R2SIZE, IRBE3(NRBE3L,*), LRBE3(*),
107 . IAD_RBE3M(*) ,FR_RBE3M(*) ,FR_RBE3MP(*),
108 . FR_RBY6(*) ,IAD_RBY(*) ,LPBY(*) ,TAGMSR_RBY_SMS(*),R3SIZE,
109 . NODII_SMS(*),INDX2_SMS(*),IBCSCYC(*),LBCSCYC(*)
110 my_real
111 . ms(*), diag_sms(*), lt_sms(*),
112 . v(3,*), a(3,*), wv(3,*), wmv(3,*), wdg(*), xmom_sms(3,*),
113 . skew(*), x(3,*), d(3,*), tf(*), vel(lfxvelr,*),
114 . xframe(nxframe,*),lti_sms(*), mskyi_sms(*),fthreac(6,*),
115 . ar(3,*), vr(3,*), dr(3,*), in(*), rby(nrby,*),
116 . frbe3(*), rrbe3(*)
117 my_real,dimension(fr_rms(nspmd+1)),intent(inout) :: mskyi_fi_sms
118 integer,dimension(fr_sms(nspmd+1)),intent(inout) :: LIST_SMS
119 integer,dimension(fr_rms(nspmd+1)),intent(inout) :: LIST_RMS
120 my_real, DIMENSION(3,FR_RMS(NSPMD+1)+FR_SMS(NSPMD+1) ), intent(inout):: vfi
121 integer,intent(in) :: SZ_mw6
122 my_real,dimension(6,SZ_mw6),intent(inout) :: mw6
123 DOUBLE PRECISION RRBE3_PON(*)
124 DOUBLE PRECISION RBY6(8,6,NRBYKIN)
125 TYPE(INTSTAMP_DATA) INTSTAMP(*)
126 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
127 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT !< output structure
128C-----------------------------------------------
129C L o c a l V a r i a b l e s
130C-----------------------------------------------
131 INTEGER NODFT1_SMS, NODLT1_SMS
132 INTEGER NODFT2_SMS, NODLT2_SMS
133 INTEGER N, IBID, IPRI, INFO, ITHIS, IT, M, MSR, NN, IERROR,
134 . I, IAD, NSN, K, KI, NRBDIM
135 my_real
136 . rbid, dt05, mas, p1, p2, p3
137C-----
138 INTEGER, DIMENSION(:), ALLOCATABLE :: IMV
139 my_real
140 . , DIMENSION(:), ALLOCATABLE :: mv
141 double precision
142 . , DIMENSION(:,:), ALLOCATABLE :: mv6
143C-----
144 DATA it/0/
145C-----------------------------------------------
146 ipri=1
147 IF(t1s==tt)ipri=mod(ncycle,iabs(ncpri))
148 info=mdess-manim
149 ithis=0
150 IF(tt<output%TH%THIS)ithis=1
151 IF(ipri/=0.AND.ithis/=0.AND.
152 . info<=0.AND.istat==0
153 . .AND.nth==0.AND.nanim==0) RETURN
154C
155 IF(iparit/=0)THEN
156 IF(debug(9)==0)THEN
157 ALLOCATE(imv(2*nisky_sms+fr_rms(nspmd+1)),
158 . mv(3*(2*nisky_sms+fr_rms(nspmd+1))),
159 . mv6(6,3*(2*nisky_sms+fr_rms(nspmd+1))),
160 . stat=ierror)
161 ELSE
162 ALLOCATE(imv(numnod+nnz_sms+2*nisky_sms+fr_rms(nspmd+1)),
163 . mv(3*(numnod+nnz_sms+2*nisky_sms+fr_rms(nspmd+1))),
164 . mv6(6,3*(numnod+nnz_sms+2*nisky_sms+fr_rms(nspmd+1))),
165 . stat=ierror)
166 END IF
167 IF(ierror/=0) THEN
168 CALL ancmsg(msgid=19,anmode=aninfo,
169 . c1='(/DT/.../AMS)')
170 CALL arret(2)
171 ENDIF
172 END IF
173C
174 IF(nspmd > 1)THEN
175 IF(itask==0)THEN
176 CALL spmd_list_sms(iskyi_sms,fr_sms,fr_rms,list_sms,list_rms,
177 . npby ,tagslv_rby_sms)
178 END IF
179C
180 CALL my_barrier
181C
182 END IF
183C
184 nodft1_sms=1+itask*nindx1_sms/nthread
185 nodlt1_sms=(itask+1)*nindx1_sms/nthread
186C
187 nodft2_sms=1+itask*nindx2_sms/nthread
188 nodlt2_sms=(itask+1)*nindx2_sms/nthread
189C
190 dt05=half*dt1
191 DO n=nodft,nodlt
192C
193 wv(1,n) = v(1,n)+dt05*a(1,n)
194 wv(2,n) = v(2,n)+dt05*a(2,n)
195 wv(3,n) = v(3,n)+dt05*a(3,n)
196C
197 mas=ms(n)
198 xmom_sms(1,n)=mas*wv(1,n)
199 xmom_sms(2,n)=mas*wv(2,n)
200 xmom_sms(3,n)=mas*wv(3,n)
201C
202 IF(nodxi_sms(n)/=0.AND.tagslv_rby_sms(n)==0) THEN
203 wdg(n)=max(zero,diag_sms(n)-ms(n))
204 ELSEIF(tagslv_rby_sms(n)/=0)THEN
205 wdg(n)=diag_sms(n)
206 END IF
207C
208 ENDDO
209C
210C-----------------------------------
211 IF(nrbody/=0)THEN
212C
213 CALL my_barrier()
214C
215 DO n=nodft1_sms,nodlt1_sms
216 i=indx1_sms(n)
217 m=tagslv_rby_sms(i)
218 IF(m /= 0)THEN
219 msr=npby(1,m)
220 wv(1,i)=wv(1,msr)
221 wv(2,i)=wv(2,msr)
222 wv(3,i)=wv(3,msr)
223 END IF
224 END DO
225C
226 END IF
227C
228 CALL my_barrier
229C
230C----
231C
232 IF(nspmd > 1)THEN
233C
234 CALL my_barrier()
235C
236 IF(itask==0) THEN ! comm sur 1er thread
237 CALL spmd_mij_sms(
238 1 iskyi_sms,fr_sms,fr_rms,list_rms,mskyi_sms,
239 2 mskyi_fi_sms)
240 END IF
241 END IF
242C----
243 CALL sms_mav_lt(timers,
244 1 nodft ,nodlt ,numnod ,jad_sms ,jdi_sms ,
245 2 itask ,wdg ,lt_sms ,wv ,wmv ,
246 3 nodft1_sms,nodlt1_sms,indx1_sms,nodxi_sms,iad_elem ,
247 4 fr_elem ,weight ,jadi_sms ,jdii_sms ,lti_sms ,
248 5 iskyi_sms ,mskyi_sms ,fr_sms ,fr_rms ,list_sms ,
249 6 list_rms ,mskyi_fi_sms ,vfi ,imv ,mv ,
250 7 mv6 ,mw6 ,nodft2_sms,nodlt2_sms,indx2_sms,
251 8 nodii_sms )
252C
253 CALL my_barrier
254C
255C-----------------------------------
256 IF(nrbody/=0)THEN
257C
258 CALL my_barrier()
259C
260!$OMP DO SCHEDULE(DYNAMIC,1)
261 DO m =1,nrbody
262 DO k = 1, 6
263 rby6(1,k,m) = zero
264 rby6(2,k,m) = zero
265 rby6(3,k,m) = zero
266 END DO
267C
268 msr=npby(1,m)
269 IF(msr < 0) cycle
270C
271 IF(tagmsr_rby_sms(msr) /= 0) THEN
272 rby6(1,1,m)=wmv(1,msr)*weight(msr)
273 rby6(2,1,m)=wmv(2,msr)*weight(msr)
274 rby6(3,1,m)=wmv(3,msr)*weight(msr)
275 END IF
276C
277 END DO
278!$OMP END DO
279
280!$OMP SINGLE
281 DO n=1,nindx1_sms
282 i=indx1_sms(n)
283 m=tagslv_rby_sms(i)
284 IF(m /= 0)THEN
285 IF(weight(i) /= 0)THEN
286 rby6(1,1,m)=rby6(1,1,m)+wmv(1,i)
287 rby6(2,1,m)=rby6(2,1,m)+wmv(2,i)
288 rby6(3,1,m)=rby6(3,1,m)+wmv(3,i)
289 END IF
290 END IF
291 END DO
292!$OMP END SINGLE
293
294 IF (nspmd > 1) THEN
295!$OMP SINGLE
296 nrbdim=3
297 CALL spmd_exch_a_rb6(
298 1 nrbdim,iad_rby,fr_rby6,iad_rby(nspmd+1),rby6)
299!$OMP END SINGLE
300 END IF
301
302!$OMP DO SCHEDULE(DYNAMIC,1)
303 DO m =1,nrbody
304 msr=npby(1,m)
305 IF(msr < 0) cycle
306C
307C IF(TAGMSR_RBY_SMS(MSR) /= 0) THEN
308 wmv(1,msr)=rby6(1,1,m)
309 wmv(2,msr)=rby6(2,1,m)
310 wmv(3,msr)=rby6(3,1,m)
311C END IF
312 END DO
313!$OMP END DO
314 END IF
315C-----------------------------------
316C reimp wmv=0
317 CALL sms_bcs(nodft1_sms,nodlt1_sms,indx1_sms,icodt ,iskew ,
318 2 skew ,wmv ,nodlt1_sms )
319C
320 IF (nbcscyc>0) CALL sms_bcscyc(ibcscyc,lbcscyc,skew,x,wmv)
321C
322 IF(nfxvel > 0)THEN
323C
324C reimp wmv=0
325 CALL my_barrier
326C
327 IF(itask==0)
328 . CALL sms_fixvel(ibfv ,wmv ,v ,npc ,tf ,
329 2 vel ,diag_sms,x ,skew ,sensors%SENSOR_TAB,
330 3 weight ,d ,iframe ,xframe ,sensors%NSENSOR,
331 4 -(it+1),diag_sms,nodxi_sms,cptreac,
332 5 nodreac,fthreac ,ar ,vr ,dr ,
333 6 in ,rby ,output%TH%WFEXT)
334 END IF
335C
336 CALL my_barrier
337C
338C----
339 DO n=nodft1_sms,nodlt1_sms
340 i=indx1_sms(n)
341 IF(tagslv_rby_sms(i)==0)THEN
342 xmom_sms(1,i)=xmom_sms(1,i)+wmv(1,i)
343 xmom_sms(2,i)=xmom_sms(2,i)+wmv(2,i)
344 xmom_sms(3,i)=xmom_sms(3,i)+wmv(3,i)
345 END IF
346 ENDDO
347C-----------------------------------
348C RBE2
349C-----------------------------------
350 IF (nrbe2>0.OR.r2size>0) THEN
351C
352 CALL my_barrier
353C
354 IF(itask==0)THEN
355C
356 CALL sms_rbe_corr(
357 1 irbe2 ,lrbe2 ,wv ,xmom_sms ,ms ,
358 1 skew ,weight ,iad_rbe2,fr_rbe2m,nmrbe2)
359C
360 CALL sms_rbe_cnds(
361 1 irbe2 ,lrbe2 ,x ,xmom_sms,ar ,
362 1 ms ,in ,skew ,weight ,iad_rbe2,
363 2 fr_rbe2m,nmrbe2)
364C
365 END IF
366C
367 CALL my_barrier
368C
369 END IF
370C-----------------------------------
371C RBE3
372C-----------------------------------
373 IF (nrbe3>0)THEN
374 IF(itask==0)THEN
375 CALL sms_rbe3t1(
376 1 irbe3 ,lrbe3 ,x ,xmom_sms,frbe3 ,
377 2 skew ,weight ,iad_rbe3m,fr_rbe3m,fr_rbe3mp,
378 3 rrbe3 ,rrbe3_pon,r3size )
379 END IF
380C
381 CALL my_barrier
382C
383 END IF
384C
385 IF(iparit/=0)THEN
386 DEALLOCATE(imv, mv, mv6)
387 END IF
388C
389C fin section //
390 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
intstamp_mod
Definition intstamp_mod.F:38
message_mod
Definition message_mod.F:1249
sms_bcs
subroutine sms_bcs(nodft, nodlt, indx1, icodt, iskew, skew, a, nodlast)
Definition sms_bcs.F:34
sms_bcscyc
subroutine sms_bcscyc(ibcscyc, lbcscyc, skew, x, a)
Definition sms_bcscyc.F:33
sms_fixvel
subroutine sms_fixvel(ibfv, a, v, npc, tf, vel, ms, x, skew, sensor_tab, weight, d, iframe, xframe, nsensor, it, diag_sms, nodnx_sms, cptreac, nodreac, fthreac, ar, vr, dr, in, rby, wfext)
Definition sms_fixvel.F:40
sms_mav_lt
subroutine sms_mav_lt(timers, nodft, nodlt, numnod, iadl, jdil, itask, diag_k, lt_k, v, w, nodft1_sms, nodlt1_sms, indx1_sms, nodnx_sms, iad_elem, fr_elem, weight, jadi_sms, jdii_sms, lti_sms, iskyi_sms, mskyi_sms, fr_sms, fr_rms, list_sms, list_rms, mskyi_fi_sms, vfi, imv, mv, mv6, mw6, nodft2_sms, nodlt2_sms, indx2_sms, nodii_sms)
Definition sms_pcg.F:1706
sms_rbe_cnds
subroutine sms_rbe_cnds(irbe2, lrbe2, x, a, ar, ms, in, skew, weight, iad_rbe2, fr_rbe2m, nmrbe2)
Definition sms_rbe2.F:274
sms_rbe_corr
subroutine sms_rbe_corr(irbe2, lrbe2, v, w, ms, skew, weight, iad_rbe2, fr_rbe2m, nmrbe2)
Definition sms_rbe2.F:418
sms_rbe3t1
subroutine sms_rbe3t1(irbe3, lrbe3, x, a, frbe3, skew, weight, iad_m, fr_m, fr_mpon, rsum, rsum_pon, r3size)
Definition sms_rbe3.F:143
spmd_exch_a_rb6
subroutine spmd_exch_a_rb6(nrbdim, iad_rby, fr_rby6, icsize, rbf6)
Definition spmd_exch_a_rb6.F:37
spmd_list_sms
subroutine spmd_list_sms(iskyi_sms, fr_sms, fr_rms, list_sms, list_rms, npby, tagslv_rby_sms)
Definition spmd_sms.F:263
spmd_mij_sms
subroutine spmd_mij_sms(iskyi_sms, fr_sms, fr_rms, list_rms, mskyi_sms, mij_sms)
Definition spmd_sms.F:452
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31