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