OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lag_anith.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| lag_anith ../engine/source/tools/lagmul/lag_anith.F
25!||--- called by ------------------------------------------------------
26!|| lag_mult ../engine/source/tools/lagmul/lag_mult.F
27!||--- uses -----------------------------------------------------
28!|| anim_mod ../common_source/modules/output/anim_mod.F
29!|| h3d_mod ../engine/share/modules/h3d_mod.F
30!||====================================================================
31 SUBROUTINE lag_anith(IADLL ,LLL ,JLL ,SLL ,XLL ,
32 2 FANI ,FSAV ,NC ,H3D_DATA)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE h3d_mod
37 USE anim_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 INTEGER NC,IADLL(*),LLL(*),JLL(*),SLL(*)
56C REAL
57 my_real
58 . xll(*),fani(3,*),fsav(nthvki,*)
59 TYPE(h3d_database) :: H3D_DATA
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I,J,IC,IK,NIN
64C======================================================================|
65C---
66C SAUVEGARDE DES FORCES D'ANIM
67C---
68 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
69 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
70 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
71#include "lockon.inc"
72 DO ic=1,nc
73 DO ik=iadll(ic),iadll(ic+1)-1
74 i = lll(ik)
75 j = jll(ik)
76 IF(j<=3) fani(j,i) = fani(j,i) - xll(ik)
77 ENDDO
78 ENDDO
79#include "lockoff.inc"
80 ENDIF
81C----
82C SAUVEGARDE DE L'IMPULSION NORMALE - TH
83C---
84#include "lockon.inc"
85 DO ic=1,nc
86 DO ik=iadll(ic),iadll(ic+1)-1
87 nin = sll(ik)
88 IF(nin/=0)THEN
89 j = jll(ik)
90 fsav(j,nin)=fsav(j,nin) + xll(ik)*dt12
91 ENDIF
92 ENDDO
93 ENDDO
94#include "lockoff.inc"
95C
96C---
97 RETURN
98 END
99
100C routine SPMD
101!||====================================================================
102!|| lag_anithp ../engine/source/tools/lagmul/lag_anith.f
103!||--- called by ------------------------------------------------------
104!|| lag_multp ../engine/source/tools/lagmul/lag_mult.F
105!||--- calls -----------------------------------------------------
106!|| spmd_sg_fani ../engine/source/mpi/lag_multipliers/spmd_lag.F
107!||--- uses -----------------------------------------------------
108!|| anim_mod ../common_source/modules/output/anim_mod.F
109!|| h3d_mod ../engine/share/modules/h3d_mod.F
110!||====================================================================
111 SUBROUTINE lag_anithp(IADLL ,LLL ,JLL ,SLL ,XLL ,
112 2 FANI ,FSAV ,NC ,INDEXLAG,FANIG ,
113 3 FR_LAGF,NBNODL,LLAGF,NLAGF ,H3D_DATA)
114C-----------------------------------------------
115C M o d u l e s
116C-----------------------------------------------
117 USE h3d_mod
118 USE anim_mod
119C-----------------------------------------------
120C I m p l i c i t T y p e s
121C-----------------------------------------------
122#include "implicit_f.inc"
123C-----------------------------------------------
124C C o m m o n B l o c k s
125C-----------------------------------------------
126#include "param_c.inc"
127#include "comlock.inc"
128#include "com01_c.inc"
129#include "com06_c.inc"
130#include "com08_c.inc"
131#include "scr07_c.inc"
132#include "scr14_c.inc"
133#include "scr16_c.inc"
134#include "task_c.inc"
135C-----------------------------------------------
136C D u m m y A r g u m e n t s
137C-----------------------------------------------
138 INTEGER NC,IADLL(*),LLL(*),JLL(*),SLL(*),
139 . FR_LAGF(*), LLAGF(*), INDEXLAG(*), NBNODL, NLAGF
140C REAL
141 my_real
142 . xll(*),fani(3,*),fsav(nthvki,*), fanig(3,*)
143 TYPE(H3D_DATABASE) :: H3D_DATA
144C-----------------------------------------------
145C L o c a l V a r i a b l e s
146C-----------------------------------------------
147 INTEGER I,J,IC,IK,NIN,N
148C======================================================================|
149C---
150C SAUVEGARDE DES FORCES D'ANIM
151C---
152 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0.AND.
153 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
154 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
155 IF(ispmd==0)THEN
156 DO i = 1, nbnodl
157 fanig(1,i) = zero
158 fanig(2,i) = zero
159 fanig(3,i) = zero
160 END DO
161 DO ic=1,nc
162 DO ik=iadll(ic),iadll(ic+1)-1
163C I = LLL(IK)
164 i = indexlag(lll(ik))
165 j = jll(ik)
166 IF(j<=3) fanig(j,i) = fanig(j,i) - xll(ik)
167 ENDDO
168 ENDDO
169 END IF
170 IF(nspmd > 1)THEN
171 CALL spmd_sg_fani(
172 1 fani,fanig,fr_lagf,nbnodl,llagf,nlagf)
173 ELSE
174 DO i = 1, nlagf
175 n = llagf(i)
176 fani(1,n) = fanig(1,i)
177 fani(2,n) = fanig(2,i)
178 fani(3,n) = fanig(3,i)
179 END DO
180 END IF
181 ENDIF
182C----
183C SAUVEGARDE DE L'IMPULSION NORMALE - TH
184C---
185 DO ic=1,nc
186 DO ik=iadll(ic),iadll(ic+1)-1
187 nin = sll(ik)
188 IF(nin/=0)THEN
189 j = jll(ik)
190 fsav(j,nin)=fsav(j,nin) + xll(ik)*dt12
191 ENDIF
192 ENDDO
193 ENDDO
194C
195C---
196 RETURN
197 END
198
199!||====================================================================
200!|| lagth_rby ../engine/source/tools/lagmul/lag_anith.F
201!||====================================================================
202 SUBROUTINE lagth_rby(LPBY ,NPBY ,FANI ,FS ,AF ,AM ,X )
203C-----------------------------------------------
204C I m p l i c i t T y p e s
205C-----------------------------------------------
206#include "implicit_f.inc"
207C-----------------------------------------------
208C C o m m o n B l o c k s
209C-----------------------------------------------
210#include "param_c.inc"
211#include "lagmult.inc"
212#include "com04_c.inc"
213#include "com08_c.inc"
214C-----------------------------------------------
215C D u m m y A r g u m e n t s
216C-----------------------------------------------
217 INTEGER LPBY(*), NPBY(NNPBY,*)
218C REAL
219 my_real
220 . af(3,*), am(3,*), x(3,*), fani(3,*), fs(*)
221C-----------------------------------------------
222C L o c a l V a r i a b l e s
223C-----------------------------------------------
224 INTEGER I, N, NN, N2, NSL, TNSL
225C-----------------------------------------------
226 TNSL = 0
227 n2 = ninter+nrwall+nrbykin
228 n = 1
229 DO n=1,nrbylag
230 n2=n2+1
231 nsl = npby(2,n)
232c DO I = 1,6
233c FANI(I) = ZERO
234c ENDDO
235 DO i=1,nsl
236 nn = lpby(tnsl+i)
237 fs(n2+1)=fs(n2+1)+af(1,nn)*dt1
238 fs(n2+2)=fs(n2+2)+af(2,nn)*dt1
239c FS(N2+3)=FS(N2+3)+AF(3,NN)*DT1
240c FS(N2+4)=FS(N2+4)+AM(1,NN)*DT1
241c FS(N2+5)=FS(N2+5)+AM(2,NN)*DT1
242c FS(N2+6)=FS(N2+6)+AM(3,NN)*DT1
243c FANI(1) =FANI(1) +AF(1,NN)
244c FANI(2) =FANI(2) +AF(2,NN)
245c FANI(3) =FANI(3) +AF(3,NN)
246c FANI(4) =FANI(4) +AM(1,NN)
247c FANI(5) =FANI(5) +AM(2,NN)
248c FANI(6) =FANI(6) +AM(3,NN)
249 ENDDO
250 tnsl = tnsl + 3*nsl
251 ENDDO
252C---
253 RETURN
254 END
my_real
#define my_real
Definition cppsort.cpp:32
lagth_rby
subroutine lagth_rby(lpby, npby, fani, fs, af, am, x)
Definition lag_anith.F:203
lag_anith
subroutine lag_anith(iadll, lll, jll, sll, xll, fani, fsav, nc, h3d_data)
Definition lag_anith.F:33
lag_anithp
subroutine lag_anithp(iadll, lll, jll, sll, xll, fani, fsav, nc, indexlag, fanig, fr_lagf, nbnodl, llagf, nlagf, h3d_data)
Definition lag_anith.F:114
anim_mod
Definition anim_mod.F:96
h3d_mod
Definition h3d_mod.F:308
spmd_sg_fani
subroutine spmd_sg_fani(rdum1, rdum2, idum1, idum2, idum3, idum4)
Definition spmd_lag.F:703
h3d_mod::h3d_database
Definition h3d_mod.F:435