OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lag_anith.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "comlock.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "lockon.inc"
#include "lockoff.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "lagmult.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lag_anith (output, iadll, lll, jll, sll, xll, fani, fsav, nc, h3d_data)
subroutine lag_anithp (output, iadll, lll, jll, sll, xll, fani, fsav, nc, indexlag, fanig, fr_lagf, nbnodl, llagf, nlagf, h3d_data)
subroutine lagth_rby (lpby, npby, fani, fs, af, am, x)

Function/Subroutine Documentation

◆ lag_anith()

subroutine lag_anith ( type(output_), intent(inout) output,
integer, dimension(*) iadll,
integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
fani,
fsav,
integer nc,
type(h3d_database) h3d_data )

Definition at line 31 of file lag_anith.F.

33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE h3d_mod
37 USE output_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "param_c.inc"
46#include "comlock.inc"
47#include "com06_c.inc"
48#include "com08_c.inc"
49#include "scr07_c.inc"
50#include "scr14_c.inc"
51#include "scr16_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 type(output_), intent(inout) :: output
56 INTEGER NC,IADLL(*),LLL(*),JLL(*),SLL(*)
57C REAL
59 . xll(*),fani(3,*),fsav(nthvki,*)
60 TYPE(H3D_DATABASE) :: H3D_DATA
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I,J,IC,IK,NIN
65C======================================================================|
66C---
67C SAUVEGARDE DES FORCES D'ANIM
68C---
69 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
70 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
71 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
72#include "lockon.inc"
73 DO ic=1,nc
74 DO ik=iadll(ic),iadll(ic+1)-1
75 i = lll(ik)
76 j = jll(ik)
77 IF(j<=3) fani(j,i) = fani(j,i) - xll(ik)
78 ENDDO
79 ENDDO
80#include "lockoff.inc"
81 ENDIF
82C----
83C SAUVEGARDE DE L'IMPULSION NORMALE - TH
84C---
85#include "lockon.inc"
86 DO ic=1,nc
87 DO ik=iadll(ic),iadll(ic+1)-1
88 nin = sll(ik)
89 IF(nin/=0)THEN
90 j = jll(ik)
91 fsav(j,nin)=fsav(j,nin) + xll(ik)*dt12
92 ENDIF
93 ENDDO
94 ENDDO
95#include "lockoff.inc"
96C
97C---
98 RETURN
#define my_real
Definition cppsort.cpp:32

◆ lag_anithp()

subroutine lag_anithp ( type(output_), intent(inout) output,
integer, dimension(*) iadll,
integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
fani,
fsav,
integer nc,
integer, dimension(*) indexlag,
fanig,
integer, dimension(*) fr_lagf,
integer nbnodl,
integer, dimension(*) llagf,
integer nlagf,
type(h3d_database) h3d_data )

Definition at line 112 of file lag_anith.F.

115C-----------------------------------------------
116C M o d u l e s
117C-----------------------------------------------
118 USE h3d_mod
119 USE output_mod
120C-----------------------------------------------
121C I m p l i c i t T y p e s
122C-----------------------------------------------
123#include "implicit_f.inc"
124C-----------------------------------------------
125C C o m m o n B l o c k s
126C-----------------------------------------------
127#include "param_c.inc"
128#include "comlock.inc"
129#include "com01_c.inc"
130#include "com06_c.inc"
131#include "com08_c.inc"
132#include "scr07_c.inc"
133#include "scr14_c.inc"
134#include "scr16_c.inc"
135#include "task_c.inc"
136C-----------------------------------------------
137C D u m m y A r g u m e n t s
138C-----------------------------------------------
139 type(output_), intent(inout) :: output
140 INTEGER NC,IADLL(*),LLL(*),JLL(*),SLL(*),
141 . FR_LAGF(*), LLAGF(*), INDEXLAG(*), NBNODL, NLAGF
142C REAL
143 my_real
144 . xll(*),fani(3,*),fsav(nthvki,*), fanig(3,*)
145 TYPE(H3D_DATABASE) :: H3D_DATA
146C-----------------------------------------------
147C L o c a l V a r i a b l e s
148C-----------------------------------------------
149 INTEGER I,J,IC,IK,NIN,N
150C======================================================================|
151C---
152C SAUVEGARDE DES FORCES D'ANIM
153C---
154 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0.AND.
155 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
156 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
157 IF(ispmd==0)THEN
158 DO i = 1, nbnodl
159 fanig(1,i) = zero
160 fanig(2,i) = zero
161 fanig(3,i) = zero
162 END DO
163 DO ic=1,nc
164 DO ik=iadll(ic),iadll(ic+1)-1
165C I = LLL(IK)
166 i = indexlag(lll(ik))
167 j = jll(ik)
168 IF(j<=3) fanig(j,i) = fanig(j,i) - xll(ik)
169 ENDDO
170 ENDDO
171 END IF
172 IF(nspmd > 1)THEN
173 CALL spmd_sg_fani(
174 1 fani,fanig,fr_lagf,nbnodl,llagf,nlagf)
175 ELSE
176 DO i = 1, nlagf
177 n = llagf(i)
178 fani(1,n) = fanig(1,i)
179 fani(2,n) = fanig(2,i)
180 fani(3,n) = fanig(3,i)
181 END DO
182 END IF
183 ENDIF
184C----
185C SAUVEGARDE DE L'IMPULSION NORMALE - TH
186C---
187 DO ic=1,nc
188 DO ik=iadll(ic),iadll(ic+1)-1
189 nin = sll(ik)
190 IF(nin/=0)THEN
191 j = jll(ik)
192 fsav(j,nin)=fsav(j,nin) + xll(ik)*dt12
193 ENDIF
194 ENDDO
195 ENDDO
196C
197C---
198 RETURN
subroutine spmd_sg_fani(rdum1, rdum2, idum1, idum2, idum3, idum4)
Definition spmd_lag.F:703

◆ lagth_rby()

subroutine lagth_rby ( integer, dimension(*) lpby,
integer, dimension(nnpby,*) npby,
fani,
fs,
af,
am,
x )

Definition at line 204 of file lag_anith.F.

205C-----------------------------------------------
206C I m p l i c i t T y p e s
207C-----------------------------------------------
208#include "implicit_f.inc"
209C-----------------------------------------------
210C C o m m o n B l o c k s
211C-----------------------------------------------
212#include "param_c.inc"
213#include "lagmult.inc"
214#include "com04_c.inc"
215#include "com08_c.inc"
216C-----------------------------------------------
217C D u m m y A r g u m e n t s
218C-----------------------------------------------
219 INTEGER LPBY(*), NPBY(NNPBY,*)
220C REAL
221 my_real
222 . af(3,*), am(3,*), x(3,*), fani(3,*), fs(*)
223C-----------------------------------------------
224C L o c a l V a r i a b l e s
225C-----------------------------------------------
226 INTEGER I, N, NN, N2, NSL, TNSL
227C-----------------------------------------------
228 tnsl = 0
229 n2 = ninter+nrwall+nrbykin
230 n = 1
231 DO n=1,nrbylag
232 n2=n2+1
233 nsl = npby(2,n)
234c DO I = 1,6
235c FANI(I) = ZERO
236c ENDDO
237 DO i=1,nsl
238 nn = lpby(tnsl+i)
239 fs(n2+1)=fs(n2+1)+af(1,nn)*dt1
240 fs(n2+2)=fs(n2+2)+af(2,nn)*dt1
241c FS(N2+3)=FS(N2+3)+AF(3,NN)*DT1
242c FS(N2+4)=FS(N2+4)+AM(1,NN)*DT1
243c FS(N2+5)=FS(N2+5)+AM(2,NN)*DT1
244c FS(N2+6)=FS(N2+6)+AM(3,NN)*DT1
245c FANI(1) =FANI(1) +AF(1,NN)
246c FANI(2) =FANI(2) +AF(2,NN)
247c FANI(3) =FANI(3) +AF(3,NN)
248c FANI(4) =FANI(4) +AM(1,NN)
249c FANI(5) =FANI(5) +AM(2,NN)
250c FANI(6) =FANI(6) +AM(3,NN)
251 ENDDO
252 tnsl = tnsl + 3*nsl
253 ENDDO
254C---
255 RETURN