OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
gravit_fvm_fem.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!|| gravit_fvm_fem ../engine/source/loads/general/grav/gravit_fvm_fem.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| finter ../engine/source/tools/curve/finter.F
29!|| finter_smooth ../engine/source/tools/curve/finter_smooth.F
30!|| my_barrier ../engine/source/system/machine.F
31!||--- uses -----------------------------------------------------
32!|| ale_mod ../common_source/modules/ale/ale_mod.F
33!|| python_funct_mod ../common_source/modules/python_mod.F90
34!|| sensor_mod ../common_source/modules/sensor_mod.F90
35!||====================================================================
36 SUBROUTINE gravit_fvm_fem(IGRV ,AGRV ,NPC ,TF ,A ,
37 2 V ,X ,SKEW ,MS ,SENSOR_TAB,
38 3 WEIGHT,IB ,ITASK ,NALE ,NSENSOR , PYTHON, WFEXT)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE python_funct_mod
43 USE sensor_mod
44 USE ale_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49#include "comlock.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "com06_c.inc"
56#include "com08_c.inc"
57#include "task_c.inc"
58#include "param_c.inc"
59#include "tabsiz_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER ,INTENT(IN) :: NSENSOR
64 INTEGER, INTENT(IN) :: NALE(ALE%GLOBAL%SNALE)
65 INTEGER NPC(*)
66 INTEGER IGRV(NIGRV,*),IB(*)
67 INTEGER WEIGHT(*), ITASK
68 my_real agrv(lfacgrv,*), tf(*), a(3,*), v(3,*), ms(*), x(3,*), skew(lskew,*)
69 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
70 TYPE (PYTHON_), INTENT(INOUT) :: PYTHON
71 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER NL, N1, ISK, N2, IFUNC, K1, K2, K3, ISENS,K,NN, IAD,J, IADF, IADL, ISMOOTH
76 my_real AXI, A0, AA, VV, DYDX, TS, GAMA, WFEXTT,FCX,FCY
77 my_real, EXTERNAL :: finter,finter_smooth
78C-----------------------------------------------
79C S o u r c e L i n e s
80C-----------------------------------------------
81 wfextt=zero
82C
83 DO nl=1,ngrav
84 fcy = agrv(1,nl)
85 fcx = agrv(2,nl)
86 nn=igrv(1,nl)
87 isk=igrv(2,nl)/10
88 n2 =igrv(2,nl)-10*isk
89 ifunc=igrv(3,nl)
90 iad=igrv(4,nl)
91 iadf = iad+itask*nn/nthread
92 iadl = iad-1+(itask+1)*nn/nthread
93 ismooth = 0
94 IF (ifunc > 0) ismooth = npc(2*nfunct+ifunc+1)
95C
96 isens=0
97 DO k=1,nsensor
98 IF(igrv(6,nl)== sensor_tab(k)%SENS_ID) isens=k
99 ENDDO
100 IF(isens==0)THEN
101 ts=tt
102 ELSE
103 ts = tt- sensor_tab(isens)%TSTART
104 IF(ts<0.0)cycle
105 ENDIF
106C
107 IF (ifunc > 0) THEN
108 IF (ismooth == 0) THEN
109 a0 = fcy*finter(ifunc,(ts-dt1)*fcx,npc,tf,dydx)
110 gama = fcy*finter(ifunc,ts*fcx,npc,tf,dydx)
111 ELSE IF(ismooth > 0) THEN
112 a0 = fcy*finter_smooth(ifunc,(ts-dt1)*fcx,npc,tf,dydx)
113 gama = fcy*finter_smooth(ifunc,ts*fcx,npc,tf,dydx)
114 ELSE
115 ismooth = -ismooth ! the id the python function is saved in the position of ISMOOTH in the NPC array
116 CALL python_call_funct1d(python, ismooth,(ts-dt1)*fcx, a0)
117 CALL python_call_funct1d(python, ismooth,ts*fcx, gama)
118 ENDIF
119 ELSE
120 a0 = fcy
121 gama = fcy
122 ENDIF
123C
124 aa = gama
125 IF(n2d==1.AND.isk<=1)THEN
126#include "vectorize.inc"
127 DO j=iadf,iadl
128 n1=iabs(ib(j))
129 axi=x(2,n1)
130 a(n2,n1)=a(n2,n1)+aa
131 IF(ib(j)>0 .AND. nale(n1)/=-1)wfextt=wfextt+half*(a0+aa)*ms(n1)*v(n2,n1)*dt1*axi*weight(n1)
132 ENDDO
133 ELSEIF(n2d==1.AND.isk>1)THEN
134 k1=3*n2-2
135 k2=3*n2-1
136 k3=3*n2
137#include "vectorize.inc"
138 DO j=iadf,iadl
139 n1=iabs(ib(j))
140 axi=x(2,n1)
141 vv = skew(k1,isk)*v(1,n1)+skew(k2,isk)*v(2,n1)+skew(k3,isk)*v(3,n1)
142 a(1,n1)=a(1,n1)+skew(k1,isk)*aa
143 a(2,n1)=a(2,n1)+skew(k2,isk)*aa
144 a(3,n1)=a(3,n1)+skew(k3,isk)*aa
145 IF(ib(j)>0 .AND. nale(n1)/=-1)wfextt=wfextt+half*(a0+aa)*ms(n1)*vv*dt1*axi*weight(n1)
146 ENDDO
147 ELSEIF(isk<=1)THEN
148#include "vectorize.inc"
149 DO j=iadf,iadl
150 n1=iabs(ib(j))
151 a(n2,n1)=a(n2,n1)+aa
152 IF(ib(j)>0 .AND. nale(n1)/=-1)wfextt=wfextt+half*(a0+aa)*ms(n1)*v(n2,n1)*dt1*weight(n1)
153 ENDDO
154 ELSE
155 k1=3*n2-2
156 k2=3*n2-1
157 k3=3*n2
158#include "vectorize.inc"
159 DO j=iadf,iadl
160 n1=iabs(ib(j))
161 vv = skew(k1,isk)*v(1,n1)+skew(k2,isk)*v(2,n1)+skew(k3,isk)*v(3,n1)
162 a(1,n1)=a(1,n1)+skew(k1,isk)*aa
163 a(2,n1)=a(2,n1)+skew(k2,isk)*aa
164 a(3,n1)=a(3,n1)+skew(k3,isk)*aa
165 IF(ib(j)>0 .AND. nale(n1)/=-1)wfextt=wfextt+half*(a0+aa)*ms(n1)*vv*dt1*weight(n1)
166 ENDDO
167 ENDIF
168C /---------------/
169 CALL my_barrier
170C /---------------/
171 END DO
172C
173!$OMP ATOMIC
174 wfext = wfext + wfextt
175C
176 RETURN
177 END
my_real
#define my_real
Definition cppsort.cpp:32
gravit_fvm_fem
subroutine gravit_fvm_fem(igrv, agrv, npc, tf, a, v, x, skew, ms, sensor_tab, weight, ib, itask, nale, nsensor, python, wfext)
Definition gravit_fvm_fem.F:39
ale_mod
Definition ale_mod.F:149
my_barrier
subroutine my_barrier
Definition machine.F:31