OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_fiadd25e_poff.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr18_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "impl1_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_fiadd25e_poff (nb, len, bufr, nsv, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, fthe, condn, h3d_data, multi_fvm, ledge, nedge, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, nodadt_therm)

Function/Subroutine Documentation

◆ spmd_fiadd25e_poff()

subroutine spmd_fiadd25e_poff ( integer nb,
integer len,
bufr,
integer, dimension(*) nsv,
a,
stifn,
viscn,
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,
fthe,
condn,
type(h3d_database) h3d_data,
type(multi_fvm_struct), intent(inout) multi_fvm,
integer, dimension(nledge,nedge), intent(in) ledge,
integer, intent(in) 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,
integer, intent(in) nodadt_therm )

Definition at line 35 of file spmd_fiadd25e_poff.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE h3d_mod
47 USE multi_fvm_mod
48 USE debug_mod
49 USE anim_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "param_c.inc"
58#include "scr07_c.inc"
59#include "scr14_c.inc"
60#include "scr16_c.inc"
61#include "scr18_c.inc"
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "com06_c.inc"
65#include "com08_c.inc"
66#include "impl1_c.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,NIN,
71 . NSV(*), 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
76 my_real
77 . bufr(len,*), a(3,*), stifn(*), viscn(*),
78 . secfcum(7,numnod,nsect),
79 . fcont(3,*),fthe(*),condn(*)
80 INTEGER, INTENT(IN) :: NODADT_THERM
81 INTEGER, INTENT(IN) :: NEDGE
82 INTEGER, INTENT(IN) :: LEDGE(NLEDGE,NEDGE)
83 TYPE(H3D_DATABASE) :: H3D_DATA
84 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL
89 INTEGER NOD1,NOD2
90C-----------------------------------------------
91C S o u r c e L i n e s
92C-----------------------------------------------
93C
94 IF (multi_fvm%IS_USED) THEN
95 DO i = 1, nb
96 n = nint(bufr(1, i))
97 nod = ledge(5,n)
98 multi_fvm%VEL(1, nod) = multi_fvm%VEL(1, nod) + bufr(2,i)
99 multi_fvm%VEL(2, nod) = multi_fvm%VEL(2, nod) + bufr(3,i)
100 multi_fvm%VEL(3, nod) = multi_fvm%VEL(3, nod) + bufr(4,i)
101 nod = ledge(6,n)
102 multi_fvm%VEL(1, nod) = multi_fvm%VEL(1, nod) + bufr(7,i)
103 multi_fvm%VEL(2, nod) = multi_fvm%VEL(2, nod) + bufr(8,i)
104 multi_fvm%VEL(3, nod) = multi_fvm%VEL(3, nod) + bufr(9,i)
105 ENDDO
106 ELSE
107 DO i = 1, nb
108 n = nint(bufr(1,i))
109 nod1 = ledge(5,n)
110 a(1,nod1) = a(1,nod1) + bufr(2,i)
111 a(2,nod1) = a(2,nod1) + bufr(3,i)
112 a(3,nod1) = a(3,nod1) + bufr(4,i)
113 stifn(nod1) = stifn(nod1) + bufr(5,i)
114
115 nod2 = ledge(6,n)
116 a(1,nod2) = a(1,nod2) + bufr(7,i)
117 a(2,nod2) = a(2,nod2) + bufr(8,i)
118 a(3,nod2) = a(3,nod2) + bufr(9,i)
119 stifn(nod2) = stifn(nod2) + bufr(10,i)
120
121 IF(kdtint /= 0) THEN
122 viscn(nod1) = viscn(nod1) + bufr(6,i)
123 viscn(nod2) = viscn(nod2) + bufr(11,i)
124 ENDIF
125
126 IF(intth /= 0) THEN
127 fthe(nod1) = fthe(nod1) + bufr(12,i)
128 fthe(nod2) = fthe(nod2) + bufr(13,i)
129 IF(nodadt_therm == 1) THEN
130 condn(nod1) = condn(nod1) + bufr(14,i)
131 condn(nod2) = condn(nod2) + bufr(15,i)
132 ENDIF
133 ENDIF
134 ENDDO
135C
136C suite traitement i7for3 et i10for3 sur noeud secnd
137C
138 IF (inconv == 1) THEN
139 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
140 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
141 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
142 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
143C Anim FCONT
144 DO i = 1, nb
145 n = nint(bufr(1,i))
146 nod = ledge(5,n)
147 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
148 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
149 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
150 nod = ledge(6,n)
151 fcont(1,nod)=fcont(1,nod)+bufr(7,i)
152 fcont(2,nod)=fcont(2,nod)+bufr(8,i)
153 fcont(3,nod)=fcont(3,nod)+bufr(9,i)
154 END DO
155 END IF
156 END IF
157C
158C------------For /LOAD/PRESSURE tag nodes in contact-------------
159 IF(nintloadp > 0) THEN
160 DO i = 1, nb
161 n = nint(bufr(1,i))
162 nod1 = ledge(5,n)
163 nod2 = ledge(6,n)
164 DO pp = kloadpinter(nin)+1, kloadpinter(nin+1)
165 ppl = loadp_hyd_inter(pp)
166 tagncont(ppl,nod1) = 1
167 tagncont(ppl,nod2) = 1
168 ENDDO
169 ENDDO
170 ENDIF
171C
172 IF(isecin>0)THEN
173C Sections
174 k0=nstrf(25)
175 IF(nstrf(1)+nstrf(2)/=0)THEN
176 DO i=1,nsect
177 nbinter=nstrf(k0+14)
178 k1s=k0+30
179 DO j=1,nbinter
180 IF(nstrf(k1s)==noint)THEN
181 IF(isecut/=0)THEN
182 DO ii = 1, nb
183 n = nint(bufr(1,ii))
184 nod = ledge(5,n)
185 IF(secfcum(4,nod,i)==1.)THEN
186 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
187 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
188 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
189 ENDIF
190 nod = ledge(6,n)
191 IF(secfcum(4,nod,i)==1.)THEN
192 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
193 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
194 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
195 ENDIF
196 ENDDO
197 ENDIF
198 ENDIF
199 k1s=k1s+1
200 ENDDO
201 k0=nstrf(k0+24)
202 ENDDO
203 ENDIF
204 ENDIF
205C
206 IF((ibag/=0.AND.inacti/=7).OR.
207 . (iadm/=0).OR.(idamp_rdof/=0)) THEN ! attention conflit inacti=7 et ibag=3
208C Airbags IBAG
209 DO i = 1, nb
210 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
211 + bufr(4,i)/=zero) THEN
212 n = nint(bufr(1,i))
213 nod = ledge(5,n)
214 icontact(nod)=1
215 nod = ledge(6,n)
216 icontact(nod)=1
217 END IF
218 END DO
219 END IF
220C
221 IF(ibc/=0) THEN
222 ibcm = ibc / 8
223 ibcs = ibc - 8 * ibcm
224C Boundary cond.
225 IF(ibcs>0) THEN
226 DO i = 1, nb
227 n = nint(bufr(1,i))
228 nod = ledge(5,n)
229 CALL ibcoff(ibcs,icodt(nod))
230 nod = ledge(6,n)
231 CALL ibcoff(ibcs,icodt(nod))
232 END DO
233 END IF
234 END IF
235 ENDIF
236C
237 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