OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
switch_to_dtnoda.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "spmd.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr02_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"
#include "sms_c.inc"
#include "sphcom.inc"
#include "tabsiz_c.inc"
#include "task_c.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine switch_to_dtnoda (ixr, geo, pm, iparg, elbuf_tab, ms, in, itab, igeo, ipm, uparam, ipart, igrnod, igrpart)

Function/Subroutine Documentation

◆ switch_to_dtnoda()

subroutine switch_to_dtnoda ( integer, dimension(nixr,*) ixr,
geo,
pm,
integer, dimension(nparg,*) iparg,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
ms,
in,
integer, dimension(*) itab,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropmi,*) ipm,
uparam,
integer, dimension(sipart), target ipart,
type (group_), dimension(ngrnod) igrnod,
type (group_), dimension(ngrpart) igrpart )

Definition at line 38 of file switch_to_dtnoda.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE elbufdef_mod
46 USE groupdef_mod
47 USE message_mod
48 USE my_alloc_mod
49 use element_mod , only : nixr
50 USE spmd_comm_world_mod, ONLY : spmd_comm_world
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C G l o b a l P a r a m e t e r s
57C-----------------------------------------------
58#include "mvsiz_p.inc"
59C-----------------------------------------------
60C M e s s a g e P a s s i n g
61C-----------------------------------------------
62#include "spmd.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "param_c.inc"
67#include "com01_c.inc"
68#include "com04_c.inc"
69#include "scr02_c.inc"
70#include "scr17_c.inc"
71#include "scr18_c.inc"
72#include "sms_c.inc"
73#include "sphcom.inc"
74#include "tabsiz_c.inc"
75#include "task_c.inc"
76#include "vect01_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER IXR(NIXR,*), ITAB(*),
81 . IGEO(NPROPGI,*),IPM(NPROPMI,*),IPARG(NPARG,*)
82 INTEGER, DIMENSION(SIPART), TARGET :: IPART
83C REAL
84 my_real
85 . geo(npropg,*),pm(npropm,*),uparam(*),ms(*),in(*)
86C-----------------------------------------------
87 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
88 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
89 TYPE (GROUP_) ,DIMENSION(NGRPART) :: IGRPART
90C-----------------------------------------------
91C L o c a l V a r i a b l e s
92C-----------------------------------------------
93 INTEGER I,N,N1,N2,IPID,IMAT,IADBUF,IEQUI,IP,IERR,IERROR,
94 . K1,K11,K12,K13,K14,
95 . IOK,IDTGRX,NG
96 INTEGER I15ATH,I15A,I15B,I15C,I15D,I15E,I15F,I15G,I15H,I15I,I15J,I15K
97C REAL
98 my_real
99 . xkm, xcm, xkr, xcr, xin(mvsiz)
100 TYPE(G_BUFEL_) ,POINTER :: GBUF
101 INTEGER, DIMENSION(:), POINTER :: IPARTR
102 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGN
103 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGR
104 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGPRT_SMS
105C-----------------------------------------------------
106 CALL my_alloc(tagn,numnod)
107 CALL my_alloc(tagr,numelr)
108 CALL my_alloc(tagprt_sms,npart)
109C-----------------------------------------------------
110C Check for springs with stiffness but no mass
111C ... Switch for cohesive elements should also be done here ...
112C-----------------------------------------------------
113 i15ath=1+lipart1*(npart+nthpart)
114 i15a=i15ath+2*9*(npart+nthpart)
115 i15b=i15a+numels
116 i15c=i15b+numelq
117 i15d=i15c+numelc
118 i15e=i15d+numelt
119 i15f=i15e+numelp
120 i15g=i15f+numelr
121 i15h=i15g+0
122 i15i=i15h+numeltg
123 i15j=i15i+numelx
124 i15k=i15j+numsph
125C
126 ipartr => ipart(i15f:i15g-1)
127C-----------------------------------------------------
128 IF(nodadt/=0)THEN
129 IF(idtgr(11)==0)THEN
130 tagn(1:numnod)=1
131 ELSE
132 tagn(1:numnod)=0
133 iok = 0
134 DO n=1,ngrnod
135 IF (iabs(idtgr(11))==igrnod(n)%ID) THEN
136 idtgrx= n
137 iok = 1
138 ENDIF
139 ENDDO
140 IF (iok == 0) THEN
141 CALL ancmsg(msgid=237,anmode=aninfo,
142 . i1=iabs(idtgr(11)))
143 CALL arret(2)
144 ENDIF
145 DO n=1,igrnod(idtgrx)%NENTITY
146 tagn(igrnod(idtgrx)%ENTITY(n)) = 1
147 ENDDO
148 ENDIF
149 ELSE
150 tagn(1:numnod)=0
151 ENDIF
152C-----------------------------------------------------
153 tagr(1:numelr)=0
154 IF(idtmins==2)THEN
155C
156 IF(idtgrs==0)THEN
157 DO ip=1,npart
158 tagprt_sms(ip)=1
159 END DO
160 ELSE
161 DO ip=1,npart
162 tagprt_sms(ip)=0
163 END DO
164 IF(idtgrs < 0)THEN
165 DO n=1,ngrpart
166 IF (igrpart(n)%ID==-idtgrs) THEN
167 idtgrx=n
168 GO TO 120
169 END IF
170 END DO
171 CALL ancmsg(msgid=21,anmode=aninfo_blind,
172 . i1=-idtgrs)
173 CALL arret(2)
174 120 CONTINUE
175 END IF
176C
177 DO i=1,igrpart(idtgrx)%NENTITY
178 ip=igrpart(idtgrx)%ENTITY(i)
179 tagprt_sms(ip)=1
180 END DO
181 END IF
182C-----------------------------------------------------
183 IF (isms_selec==1) THEN
184C-- Full AMS
185 DO i=1,numelr
186 tagr(i)=1
187 END DO
188 ELSEIF (isms_selec==2) THEN
189C-- AMS by parts
190 DO i=1,numelr
191 IF(tagprt_sms(ipartr(i))==0)THEN
192 tagr(i)=0
193 ELSE
194 tagr(i)=1
195 END IF
196 END DO
197 ELSEIF (isms_selec==3) THEN
198C-- AMS auto - defined by elements
199 DO ng = 1, ngroup
200 ity =iparg(5,ng)
201 IF(ity==6)THEN
202 nft =iparg(3,ng)
203 lft =1
204 llt =iparg(2,ng)
205 gbuf => elbuf_tab(ng)%GBUF
206 DO i=lft,llt
207 IF(gbuf%ISMS(i)==0)THEN
208 tagr(nft+i)=0
209 ELSE
210 tagr(nft+i)=1
211 END IF
212 END DO
213 END IF
214 END DO
215 ELSEIF (isms_selec==4) THEN
216C-- AMS auto + parts
217 DO ng = 1, ngroup
218 ity =iparg(5,ng)
219 IF(ity==6)THEN
220 nft =iparg(3,ng)
221 lft =1
222 llt =iparg(2,ng)
223 gbuf => elbuf_tab(ng)%GBUF
224 DO i=lft,llt
225 IF(gbuf%ISMS(i)==0.AND.tagprt_sms(ipartr(nft+i))==0)THEN
226 tagr(nft+i)=0
227 ELSE
228 tagr(nft+i)=1
229 END IF
230 END DO
231 END IF
232 END DO
233 END IF
234 END IF
235C-----------------------------------------------------
236 ierr=0
237 DO ng = 1, ngroup
238 ity =iparg(5,ng)
239 IF(ity==6)THEN
240 nft =iparg(3,ng)
241 lft =1
242 llt =iparg(2,ng)
243 gbuf => elbuf_tab(ng)%GBUF
244C
245 ipid = ixr(1,nft+1)
246 igtyp= igeo(11,ipid)
247C
248 IF(igtyp==23)THEN
249C
250 imat = ixr(5,nft+1)
251 iadbuf = ipm(7,imat) - 1
252 mtn = ipm(2,imat)
253C
254 k1 = 4
255 k11 = 64
256 k12 = k11 + 6
257 k13 = k12 + 6
258 k14 = k13 + 6
259C
260 IF(mtn == 108) THEN
261 iequi = uparam(iadbuf+2)
262 xkm= max(uparam(iadbuf + k11 + 1)*uparam(iadbuf + k1 + 1),
263 . uparam(iadbuf + k11 + 2)*uparam(iadbuf + k1 + 2),
264 . uparam(iadbuf + k11 + 3)*uparam(iadbuf + k1 + 3)) ! /XL(I)
265 xcm= max(uparam(iadbuf + k12 + 1),uparam(iadbuf + k12 + 2),uparam(iadbuf + k12 + 3))
266 xkr= max(uparam(iadbuf + k11 + 4)*uparam(iadbuf + k1 + 4),
267 . uparam(iadbuf + k11 + 5)*uparam(iadbuf + k1 + 5),
268 . uparam(iadbuf + k11 + 6)*uparam(iadbuf + k1 + 6)) ! /XL(I)
269 xcr= max(uparam(iadbuf + k12 + 4),uparam(iadbuf + k12 + 5),uparam(iadbuf + k12 + 6))
270 DO i=lft,llt
271 n1 =ixr(2,nft+i)
272 n2 =ixr(3,nft+i)
273 IF(gbuf%MASS(i)==zero)THEN
274 IF(xkm/=zero.OR.xcm/=zero)THEN
275 IF(nodadt==0.AND.idtmins/=2)THEN
276 ierr=1
277 ELSEIF(.NOT.((nodadt/=0 .AND.tagn(n1)/=0 .AND. tagn(n2)/=0).OR.
278 . (idtmins==2.AND.tagr(i)/=0)))THEN
279 ierr=1
280 END IF
281 END IF
282 END IF
283 xin(i)= geo(2,ipid)
284 IF(xin(i)==zero)THEN
285 IF(xkr/=zero.OR.xcr/=zero.OR.(iequi/=0.AND.(xkm/=zero.OR.xcm/=zero)))THEN
286 IF(nodadt==0.AND.idtmins/=2)THEN
287 ierr=1
288 ELSEIF(.NOT.((nodadt/=0 .AND.tagn(n1)/=0 .AND. tagn(n2)/=0).OR.
289 . (idtmins==2.AND.tagr(i)/=0)))THEN
290 ierr=1
291 END IF
292 END IF
293 END IF
294 END DO
295 END IF
296 END IF
297 END IF
298 END DO
299C------------------------------------------
300 IF(nspmd > 0)THEN
301#ifdef mpi
302 CALL mpi_allreduce(mpi_in_place,ierr,1,mpi_integer,mpi_max,spmd_comm_world,ierror)
303#endif
304 END IF
305 IF(ierr/=0)THEN
306 nodadt =1
307 idtgr(11)=0
308 IF(ispmd==0)THEN
309 CALL ancmsg(msgid=286,anmode=aninfo_blind_1)
310 END IF
311 END IF
312C------------------------------------------
313 DEALLOCATE(tagn)
314 DEALLOCATE(tagr)
315 DEALLOCATE(tagprt_sms)
316C-----------------------------------------------------
317 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
mpi_allreduce
subroutine mpi_allreduce(sendbuf, recvbuf, cnt, datatype, operation, comm, ierr)
Definition mpi.f:103
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86