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 (output, 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 ( type(output_), intent(inout) output,
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 output_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 TYPE(OUTPUT_), intent(inout) :: OUTPUT
71 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT, INACTI,NIN,
72 . NSV(*), ICODT(*), NSTRF(*),ICONTACT(*),
73 . TAGNCONT(NLOADP_HYD_INTER,NUMNOD),
74 . KLOADPINTER(NINTER+1),LOADPINTER(NINTER*NLOADP_HYD),
75 . LOADP_HYD_INTER(NLOADP_HYD),
76 . IADM,INTTH
77 my_real
78 . bufr(len,*), a(3,*), stifn(*), viscn(*),
79 . secfcum(7,numnod,nsect),
80 . fcont(3,*),fthe(*),condn(*)
81 INTEGER, INTENT(IN) :: NODADT_THERM
82 INTEGER, INTENT(IN) :: NEDGE
83 INTEGER, INTENT(IN) :: LEDGE(NLEDGE,NEDGE)
84 TYPE(H3D_DATABASE) :: H3D_DATA
85 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL
90 INTEGER NOD1,NOD2
91C-----------------------------------------------
92C S o u r c e L i n e s
93C-----------------------------------------------
94C
95 IF (multi_fvm%IS_USED) THEN
96 DO i = 1, nb
97 n = nint(bufr(1, i))
98 nod = ledge(5,n)
99 multi_fvm%VEL(1, nod) = multi_fvm%VEL(1, nod) + bufr(2,i)
100 multi_fvm%VEL(2, nod) = multi_fvm%VEL(2, nod) + bufr(3,i)
101 multi_fvm%VEL(3, nod) = multi_fvm%VEL(3, nod) + bufr(4,i)
102 nod = ledge(6,n)
103 multi_fvm%VEL(1, nod) = multi_fvm%VEL(1, nod) + bufr(7,i)
104 multi_fvm%VEL(2, nod) = multi_fvm%VEL(2, nod) + bufr(8,i)
105 multi_fvm%VEL(3, nod) = multi_fvm%VEL(3, nod) + bufr(9,i)
106 ENDDO
107 ELSE
108 DO i = 1, nb
109 n = nint(bufr(1,i))
110 nod1 = ledge(5,n)
111 a(1,nod1) = a(1,nod1) + bufr(2,i)
112 a(2,nod1) = a(2,nod1) + bufr(3,i)
113 a(3,nod1) = a(3,nod1) + bufr(4,i)
114 stifn(nod1) = stifn(nod1) + bufr(5,i)
115
116 nod2 = ledge(6,n)
117 a(1,nod2) = a(1,nod2) + bufr(7,i)
118 a(2,nod2) = a(2,nod2) + bufr(8,i)
119 a(3,nod2) = a(3,nod2) + bufr(9,i)
120 stifn(nod2) = stifn(nod2) + bufr(10,i)
121
122 IF(kdtint /= 0) THEN
123 viscn(nod1) = viscn(nod1) + bufr(6,i)
124 viscn(nod2) = viscn(nod2) + bufr(11,i)
125 ENDIF
126
127 IF(intth /= 0) THEN
128 fthe(nod1) = fthe(nod1) + bufr(12,i)
129 fthe(nod2) = fthe(nod2) + bufr(13,i)
130 IF(nodadt_therm == 1) THEN
131 condn(nod1) = condn(nod1) + bufr(14,i)
132 condn(nod2) = condn(nod2) + bufr(15,i)
133 ENDIF
134 ENDIF
135 ENDDO
136C
137C continuation of i7for3 and i10for3 processing on secondary node
138C
139 IF (inconv == 1) THEN
140 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
141 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
142 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
143 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
144C Anim FCONT
145 DO i = 1, nb
146 n = nint(bufr(1,i))
147 nod = ledge(5,n)
148 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
149 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
150 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
151 nod = ledge(6,n)
152 fcont(1,nod)=fcont(1,nod)+bufr(7,i)
153 fcont(2,nod)=fcont(2,nod)+bufr(8,i)
154 fcont(3,nod)=fcont(3,nod)+bufr(9,i)
155 END DO
156 END IF
157 END IF
158C
159C------------For /LOAD/PRESSURE tag nodes in contact-------------
160 IF(nintloadp > 0) THEN
161 DO i = 1, nb
162 n = nint(bufr(1,i))
163 nod1 = ledge(5,n)
164 nod2 = ledge(6,n)
165 DO pp = kloadpinter(nin)+1, kloadpinter(nin+1)
166 ppl = loadp_hyd_inter(pp)
167 tagncont(ppl,nod1) = 1
168 tagncont(ppl,nod2) = 1
169 ENDDO
170 ENDDO
171 ENDIF
172C
173 IF(isecin>0)THEN
174C Sections
175 k0=nstrf(25)
176 IF(nstrf(1)+nstrf(2)/=0)THEN
177 DO i=1,nsect
178 nbinter=nstrf(k0+14)
179 k1s=k0+30
180 DO j=1,nbinter
181 IF(nstrf(k1s)==noint)THEN
182 IF(isecut/=0)THEN
183 DO ii = 1, nb
184 n = nint(bufr(1,ii))
185 nod = ledge(5,n)
186 IF(secfcum(4,nod,i)==1.)THEN
187 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
188 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
189 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
190 ENDIF
191 nod = ledge(6,n)
192 IF(secfcum(4,nod,i)==1.)THEN
193 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
194 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
195 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
196 ENDIF
197 ENDDO
198 ENDIF
199 ENDIF
200 k1s=k1s+1
201 ENDDO
202 k0=nstrf(k0+24)
203 ENDDO
204 ENDIF
205 ENDIF
206C
207 IF((ibag/=0.AND.inacti/=7).OR.
208 . (iadm/=0).OR.(idamp_rdof/=0)) THEN ! warning conflict inacti = 7 and ibag = 3
209C Airbags IBAG
210 DO i = 1, nb
211 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
212 + bufr(4,i)/=zero) THEN
213 n = nint(bufr(1,i))
214 nod = ledge(5,n)
215 icontact(nod)=1
216 nod = ledge(6,n)
217 icontact(nod)=1
218 END IF
219 END DO
220 END IF
221C
222 IF(ibc/=0) THEN
223 ibcm = ibc / 8
224 ibcs = ibc - 8 * ibcm
225C Boundary cond.
226 IF(ibcs>0) THEN
227 DO i = 1, nb
228 n = nint(bufr(1,i))
229 nod = ledge(5,n)
230 CALL ibcoff(ibcs,icodt(nod))
231 nod = ledge(6,n)
232 CALL ibcoff(ibcs,icodt(nod))
233 END DO
234 END IF
235 END IF
236 ENDIF
237C
238 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
ibcoff
subroutine ibcoff(ibc, icodt)
Definition ibcoff.F:44
debug_mod
Definition debug_mod.F:47
h3d_mod
Definition h3d_mod.F:311