OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_fiadd25e_pon.F File Reference
#include "implicit_f.inc"
#include "parit_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "assert.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_fiadd25e_pon (nb, len, bufr, nsv, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, ftheskyi, condnskyi, h3d_data, ledge, sedge, nedge, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter)

Function/Subroutine Documentation

◆ spmd_fiadd25e_pon()

subroutine spmd_fiadd25e_pon ( integer nb,
integer len,
bufr,
integer, dimension(*) nsv,
fskyi,
integer, dimension(*) isky,
integer ibc,
integer isecin,
integer noint,
integer ibag,
integer, dimension(*) icodt,
secfcum,
integer, dimension(*) nstrf,
integer, dimension(*) icontact,
fcont,
integer inacti,
integer iadm,
integer intth,
ftheskyi,
condnskyi,
type(h3d_database) h3d_data,
integer, dimension(sedge,nedge) ledge,
integer sedge,
integer nedge,
integer nin,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(ninter+1) kloadpinter,
integer, dimension(ninter*nloadp_hyd) loadpinter,
integer, dimension(nloadp_hyd) loadp_hyd_inter )

Definition at line 37 of file spmd_fiadd25e_pon.F.

44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE message_mod
48 USE h3d_mod
49 USE debug_mod
50 USE anim_mod
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "parit_c.inc"
59#include "scr07_c.inc"
60#include "scr14_c.inc"
61#include "scr16_c.inc"
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "com06_c.inc"
65#include "com08_c.inc"
66#include "assert.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT, INACTI,
71 . NSV(*), ISKY(*), ICODT(*), NSTRF(*),ICONTACT(*),
72 . TAGNCONT(NLOADP_HYD_INTER,NUMNOD),
73 . KLOADPINTER(NINTER+1),LOADPINTER(NINTER*NLOADP_HYD),
74 . LOADP_HYD_INTER(NLOADP_HYD),
75 . IADM,INTTH,NIN
76 INTEGER :: SEDGE,NEDGE
77 INTEGER :: LEDGE(SEDGE,NEDGE)
78 my_real
79 . bufr(len,*),
80 . fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
81 . fcont(3,*),ftheskyi(lskyi),condnskyi(lskyi)
82 TYPE(H3D_DATABASE) :: H3D_DATA
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,
87 . NISKY_SAV,TEMP_SIZ,IERROR,NOD1,NOD2,PP,PPL
88 INTEGER NB_EDGE
89C-----------------------------------------------
90C S o u r c e L i n e s
91C-----------------------------------------------
92 IF ((nisky+nb)> lskyi)THEN
93 CALL ancmsg(msgid=26,anmode=aninfo)
94 CALL arret(2)
95 ENDIF
96C
97 nb_edge = nb
98 nisky_sav = nisky
99 DO i = 1, nb_edge
100 n = nint(bufr(1,i))
101 assert(n > 0)
102 assert(n <= nedge)
103 IF(intth == 0 ) THEN
104C pb: pas sur de recevoir les FKSKY dans cet ordre
105C#ifdef D_ES
106C IF(LEDGE(8,N) == D_ES) THEN
107C WRITE(6,*) "EDGE:",N,LEDGE(5,N),LEDGE(6,N),BUFR(10,I)
108C ENDIF
109C#endif
110 nod = ledge(5,n)
111 nisky = nisky + 1
112 fskyi(nisky,1)=bufr(2,i)
113 fskyi(nisky,2)=bufr(3,i)
114 fskyi(nisky,3)=bufr(4,i)
115 fskyi(nisky,4)=bufr(5,i)
116C IF(KDTINT /= 0) FSKYI(NISKY,5) = BUFR(6,I)
117 isky(nisky) = nod
118
119C#ifdef D_EM
120C IF(ITAB_DEBUG(NOD) == 29442) THEN
121C WRITE(6,"(A,I10,3Z20)") __FILE__,ITAB_DEBUG(NOD),BUFR(2,I),BUFR(3,I),BUFR(4,I)
122C ENDIF
123C#endif
124
125 assert(bufr(6,i) == bufr(1,i))
126
127 nod = ledge(6,n)
128 nisky = nisky + 1
129 fskyi(nisky,1)=bufr(7,i)
130 fskyi(nisky,2)=bufr(8,i)
131 fskyi(nisky,3)=bufr(9,i)
132 fskyi(nisky,4)=bufr(10,i)
133C IF(KDTINT /= 0) FSKYI(NISKY,5) = BUFR(11,I)
134 isky(nisky) = nod
135
136
137C#ifdef D_EM
138C IF(ITAB_DEBUG(NOD) == 29442) THEN
139C WRITE(6,"(A,I10,3Z20)") __FILE__,ITAB_DEBUG(NOD),BUFR(7,I),BUFR(8,I),BUFR(9,I)
140C ENDIF
141C#endif
142
143 ENDIF
144 ENDDO
145
146 IF(intth /= 0 ) THEN
147 ! THERMAL ANALYSIS + TYPE25 not available yet
148 assert(.false.)
149C NISKY = NISKY_SAV
150C DO I = 1, NB
151C NISKY = NISKY + 1
152C FTHESKYI(NISKY)=BUFR(TEMP_SIZ,I)
153C ENDDO
154C TEMP_SIZ=TEMP_SIZ+1
155C
156C IF(NODADT_THERM ==1) THEN
157C NISKY = NISKY_SAV
158C DO I = 1, NB
159C NISKY = NISKY + 1
160C CONDNSKYI(NISKY)=BUFR(TEMP_SIZ,I)
161C ENDDO
162C TEMP_SIZ=TEMP_SIZ+1
163C ENDIF
164 ENDIF
165
166
167C
168C suite traitement i7for3 et i10for3 sur noeud secnd
169C
170 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
171 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
172 . (manim>=4.AND.manim<=15)))
173 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
174C Anim FCONT
175 DO i = 1, nb_edge
176 n = nint(bufr(1,i))
177 nod = ledge(5,n)
178 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
179 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
180 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
181 nod = ledge(6,n)
182 fcont(1,nod)=fcont(1,nod)+bufr(7,i)
183 fcont(2,nod)=fcont(2,nod)+bufr(8,i)
184 fcont(3,nod)=fcont(3,nod)+bufr(9,i)
185 END DO
186 END IF
187C
188C------------For /LOAD/PRESSURE tag nodes in contact-------------
189 IF(nintloadp > 0) THEN
190 DO i = 1, nb
191 n = nint(bufr(1,i))
192 nod1 = ledge(5,n)
193 nod2 = ledge(6,n)
194 DO pp = kloadpinter(nin)+1, kloadpinter(nin+1)
195 ppl = loadp_hyd_inter(pp)
196 tagncont(ppl,nod1) = 1
197 tagncont(ppl,nod2) = 1
198 ENDDO
199 ENDDO
200 ENDIF
201C
202 IF(isecin>0)THEN
203C Sections
204 k0=nstrf(25)
205 IF(nstrf(1)+nstrf(2)/=0)THEN
206 DO i=1,nsect
207 nbinter=nstrf(k0+14)
208 k1s=k0+30
209 DO j=1,nbinter
210 IF(nstrf(k1s)==noint)THEN
211 IF(isecut/=0)THEN
212 DO ii = 1, nb
213 n = nint(bufr(1,ii))
214 nod = ledge(5,n)
215 IF(secfcum(4,nod,i)==1.)THEN
216 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
217 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
218 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
219 ENDIF
220 nod = ledge(6,n)
221 IF(secfcum(4,nod,i)==1.)THEN
222 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
223 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
224 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
225 ENDIF
226 ENDDO
227 ENDIF
228 ENDIF
229 k1s=k1s+1
230 ENDDO
231 k0=nstrf(k0+24)
232 ENDDO
233 ENDIF
234 ENDIF
235C
236 IF((ibag/=0.AND.inacti/=7).OR.
237 . (iadm/=0).OR.(idamp_rdof/=0)) THEN ! attention conflit inacti=7 et ibag=3
238C Airbags IBAG
239 DO i = 1, nb
240 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
241 + bufr(4,i)/=zero) THEN
242 n = nint(bufr(1,i))
243 nod = ledge(5,n)
244 icontact(nod)=1
245 nod = ledge(6,n)
246 icontact(nod)=1
247 END IF
248 END DO
249 END IF
250C
251 IF(ibc/=0) THEN
252 ibcm = ibc / 8
253 ibcs = ibc - 8 * ibcm
254C Boundary cond.
255 IF(ibcs>0) THEN
256 DO i = 1, nb
257 n = nint(bufr(1,i))
258 nod = ledge(5,n)
259 CALL ibcoff(ibcs,icodt(nod))
260 nod = ledge(6,n)
261 CALL ibcoff(ibcs,icodt(nod))
262 END DO
263 END IF
264 END IF
265
266 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
ibcoff
subroutine ibcoff(ibc, icodt)
Definition ibcoff.F:44
anim_mod
Definition anim_mod.F:96
debug_mod
Definition debug_mod.F:45
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
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