OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admgvid.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!|| admgvid ../engine/source/model/remesh/admgvid.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!|| resol_init ../engine/source/engine/resol_init.F
28!||--- uses -----------------------------------------------------
29!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
30!|| remesh_mod ../engine/share/modules/remesh_mod.F
31!||====================================================================
32 SUBROUTINE admgvid(IPARG ,ELBUF_TAB,FSKYV,FSKY ,FTHESKY,
33 . IADC ,IADTG ,IFLG ,IGROUC,NGROUC ,
34 . CONDNSKY ,NODADT_THERM)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE remesh_mod
39 USE elbufdef_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44#include "comlock.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "vect01_c.inc"
49#include "com01_c.inc"
50#include "param_c.inc"
51#include "parit_c.inc"
52#include "scr18_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER IPARG(NPARG,*), IADC(4,*), IADTG(3,*), IGROUC(*),
57 . NGROUC, IFLG
58 INTEGER ,INTENT(IN) :: NODADT_THERM
59 my_real
60 . fskyv(lsky,8), fsky(8,lsky), fthesky(*),condnsky(*)
61 TYPE(elbuf_struct_), DIMENSION(NGROUP) :: ELBUF_TAB
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,J,K,L,NG,MLW,NEL, IG
66C-----------------------------------------------
67C Boucle parallele dynamique SMP
68C
69!$OMP DO SCHEDULE(DYNAMIC,1)
70 DO ig = 1, ngrouc
71 ng = igrouc(ig)
72C--------
73C check group
74C--------
75 ity = iparg(5,ng)
76 mlw = iparg(1,ng)
77 IF(mlw==0) cycle
78 nel = iparg(2,ng)
79 nft = iparg(3,ng)
80 npt = iparg(6,ng)
81 jthe = iparg(13,ng)
82C--------
83 lft = 1
84 llt = min(nvsiz,nel)
85 iparg(8,ng)=1
86C----6---------------------------------------------------------------7---------8
87 DO i=lft,llt
88 IF (elbuf_tab(ng)%GBUF%OFF(i) > zero) iparg(8,ng)=0
89 END DO
90C----6---------------------------------------------------------------7---------8
91
92 IF(iflg/=0.AND.iparit/=0)THEN
93 IF(ivector==1)THEN
94 IF(ity==3)THEN
95#include "vectorize.inc"
96 DO i=lft,llt
97 k=iadc(1,nft+i)
98 fskyv(k,1)=zero
99 fskyv(k,2)=zero
100 fskyv(k,3)=zero
101 fskyv(k,4)=zero
102 fskyv(k,5)=zero
103 fskyv(k,6)=zero
104 fskyv(k,7)=zero
105 fskyv(k,8)=zero
106 k=iadc(2,nft+i)
107 fskyv(k,1)=zero
108 fskyv(k,2)=zero
109 fskyv(k,3)=zero
110 fskyv(k,4)=zero
111 fskyv(k,5)=zero
112 fskyv(k,6)=zero
113 fskyv(k,7)=zero
114 fskyv(k,8)=zero
115 k=iadc(3,nft+i)
116 fskyv(k,1)=zero
117 fskyv(k,2)=zero
118 fskyv(k,3)=zero
119 fskyv(k,4)=zero
120 fskyv(k,5)=zero
121 fskyv(k,6)=zero
122 fskyv(k,7)=zero
123 fskyv(k,8)=zero
124 k=iadc(4,nft+i)
125 fskyv(k,1)=zero
126 fskyv(k,2)=zero
127 fskyv(k,3)=zero
128 fskyv(k,4)=zero
129 fskyv(k,5)=zero
130 fskyv(k,6)=zero
131 fskyv(k,7)=zero
132 fskyv(k,8)=zero
133 END DO
134 IF(jthe > 0 ) THEN
135#include "vectorize.inc"
136 DO i=lft,llt
137 fthesky(iadc(1,nft+i)) = zero
138 fthesky(iadc(2,nft+i)) = zero
139 fthesky(iadc(3,nft+i)) = zero
140 fthesky(iadc(4,nft+i)) = zero
141 ENDDO
142 ENDIF
143 IF(nodadt_therm > 0 ) THEN
144#include "vectorize.inc"
145 DO i=lft,llt
146 condnsky(iadc(1,nft+i)) = zero
147 condnsky(iadc(2,nft+i)) = zero
148 condnsky(iadc(3,nft+i)) = zero
149 condnsky(iadc(4,nft+i)) = zero
150 ENDDO
151 ENDIF
152 ELSE
153#include "vectorize.inc"
154 DO i=lft,llt
155 k=iadtg(1,nft+i)
156 fskyv(k,1)=zero
157 fskyv(k,2)=zero
158 fskyv(k,3)=zero
159 fskyv(k,4)=zero
160 fskyv(k,5)=zero
161 fskyv(k,6)=zero
162 fskyv(k,7)=zero
163 fskyv(k,8)=zero
164 k=iadtg(2,nft+i)
165 fskyv(k,1)=zero
166 fskyv(k,2)=zero
167 fskyv(k,3)=zero
168 fskyv(k,4)=zero
169 fskyv(k,5)=zero
170 fskyv(k,6)=zero
171 fskyv(k,7)=zero
172 fskyv(k,8)=zero
173 k=iadtg(3,nft+i)
174 fskyv(k,1)=zero
175 fskyv(k,2)=zero
176 fskyv(k,3)=zero
177 fskyv(k,4)=zero
178 fskyv(k,5)=zero
179 fskyv(k,6)=zero
180 fskyv(k,7)=zero
181 fskyv(k,8)=zero
182 END DO
183 IF(jthe > 0 ) THEN
184#include "vectorize.inc"
185 DO i=lft,llt
186 fthesky(iadtg(1,nft+i)) = zero
187 fthesky(iadtg(2,nft+i)) = zero
188 fthesky(iadtg(3,nft+i)) = zero
189 ENDDO
190 ENDIF
191 IF(nodadt_therm > 0 ) THEN
192#include "vectorize.inc"
193 DO i=lft,llt
194 condnsky(iadtg(1,nft+i)) = zero
195 condnsky(iadtg(2,nft+i)) = zero
196 condnsky(iadtg(3,nft+i)) = zero
197 ENDDO
198 ENDIF
199 END IF
200 ELSE
201 IF(ity==3)THEN
202 DO i=lft,llt
203 DO j=1,4
204 k=iadc(j,nft+i)
205 DO l=1,8
206 fsky(l,k)=zero
207 END DO
208 END DO
209 END DO
210 IF(jthe > 0 ) THEN
211 DO i=lft,llt
212 fthesky(iadc(1,nft+i)) = zero
213 fthesky(iadc(2,nft+i)) = zero
214 fthesky(iadc(3,nft+i)) = zero
215 fthesky(iadc(4,nft+i)) = zero
216 ENDDO
217 ENDIF
218 IF(nodadt_therm > 0 ) THEN
219 DO i=lft,llt
220 condnsky(iadc(1,nft+i)) = zero
221 condnsky(iadc(2,nft+i)) = zero
222 condnsky(iadc(3,nft+i)) = zero
223 condnsky(iadc(4,nft+i)) = zero
224 ENDDO
225 ENDIF
226 ELSE
227 DO i=lft,llt
228 DO j=1,3
229 k=iadtg(j,nft+i)
230 DO l=1,8
231 fsky(l,k)=zero
232 END DO
233 END DO
234 END DO
235 IF(jthe > 0 ) THEN
236 DO i=lft,llt
237 fthesky(iadtg(1,nft+i)) = zero
238 fthesky(iadtg(2,nft+i)) = zero
239 fthesky(iadtg(3,nft+i)) = zero
240 ENDDO
241 ENDIF
242 IF(nodadt_therm > 0 ) THEN
243 DO i=lft,llt
244 condnsky(iadtg(1,nft+i)) = zero
245 condnsky(iadtg(2,nft+i)) = zero
246 condnsky(iadtg(3,nft+i)) = zero
247 ENDDO
248 ENDIF
249 END IF
250 END IF
251 END IF
252 END DO
253!$OMP END DO
254c GOTO 100
255c 101 CONTINUE
256
257 RETURN
258 END
admgvid
subroutine admgvid(iparg, elbuf_tab, fskyv, fsky, fthesky, iadc, iadtg, iflg, igrouc, ngrouc, condnsky, nodadt_therm)
Definition admgvid.F:35
min
#define min(a, b)
Definition macros.h:20
remesh_mod
Definition remesh_mod.F:50