OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21_icrit.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!|| i21_icrit ../engine/source/interfaces/intsort/i21_icrit.F
25!||--- called by ------------------------------------------------------
26!|| inttri ../engine/source/interfaces/intsort/inttri.F
27!||--- calls -----------------------------------------------------
28!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
29!|| spmd_i21crit ../engine/source/mpi/interfaces/spmd_i21crit.F
30!||--- uses -----------------------------------------------------
31!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
32!|| intstamp_mod ../engine/share/modules/intstamp_mod.F
33!|| sensor_mod ../common_source/modules/sensor_mod.F90
34!||====================================================================
35 SUBROUTINE i21_icrit(
36 1 INTBUF_TAB ,IPARI ,DT2T ,NELTST ,NSENSOR ,
37 2 ITYPTST,XSLV ,XMSR ,VSLV ,VMSR ,
38 3 INTSTAMP,X21MSR,V21MSR ,SENSOR_TAB,NBINTC21,
39 4 INTLIST21)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE intstamp_mod
44 USE intbufdef_mod
45 USE sensor_mod
46C----6---------------------------------------------------------------7---------8
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50#include "comlock.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "param_c.inc"
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "com08_c.inc"
58#include "intstamp_c.inc"
59#include "task_c.inc"
60#include "scr18_c.inc"
61#include "units_c.inc"
62#include "warn_c.inc"
63C-----------------------------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER ,INTENT(IN) :: NSENSOR
67 INTEGER IPARI(NPARI,*),
68 . NELTST, ITYPTST,NBINTC21,
69 . INTLIST21(*)
70C REAL
71 my_real
72 . dt2t,
73 . xslv(18,*), xmsr(12,*), vslv(6,*), vmsr(6,*),
74 . x21msr(3,*), v21msr(3,*)
75 TYPE(intstamp_data) INTSTAMP(*)
76 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
77 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I,J,KK,
82 . N,ITY,IMESS, ISENS,INTERACT
83 my_real
84 . XX,XY,XZ,DIST0(NINTSTAMP),
85 . vx(nintstamp),vy(nintstamp),vz(nintstamp),dti,
86 . startt, stopt,ts,
87 . vv(nintstamp),criterl(nintstamp)
88C variable SMP globale
89 SAVE imess
90C-----------------------------------------------
91C F u n c t i o n s
92C-----------------------------------------------
93 vx(1:nintstamp)=zero
94 vy(1:nintstamp)=zero
95 vz(1:nintstamp)=zero
96
97 imess=0
98 DO kk=1,nintstamp
99 i = intstamp(kk)%NOINTER
100 ity=ipari(7,i)
101 IF(ity==21)THEN
102C
103 dist0(kk) = ep30
104 criterl(kk)= ep30
105C
106C
107 interact = 0
108 isens = ipari(64,i)
109 IF (isens > 0) THEN
110 ts = sensor_tab(isens)%TSTART
111 IF (tt>=ts) interact = 1
112 ELSE
113 startt = intbuf_tab(i)%VARIABLES(3)
114 stopt = intbuf_tab(i)%VARIABLES(11)
115 IF (startt<=tt.AND.tt<=stopt) interact = 1
116 ENDIF
117C
118 IF(interact/=0) THEN
119C
120 xx = max(xslv(1,i)-xmsr(4,i),
121 . xmsr(1,i)-xslv(4,i),zero)
122 xy = max(xslv(2,i)-xmsr(5,i),
123 . xmsr(2,i)-xslv(5,i),zero)
124 xz = max(xslv(3,i)-xmsr(6,i),
125 . xmsr(3,i)-xslv(6,i),zero)
126C
127 dist0(kk) = intbuf_tab(i)%VARIABLES(5)
128 - - sqrt(xx**2 + xy**2 + xz**2 )
129 - - sqrt(x21msr(1,kk)**2+x21msr(2,kk)**2+x21msr(3,kk)**2)
130 IF(dist0(kk)<=zero) THEN
131 intbuf_tab(i)%VARIABLES(5) = -one
132 IF(debug(3)>=1.AND.ncycle/=0) THEN
133 WRITE(istdo,'(A,I10,A,I10,I10)')
134 . '** NEW SORT FOR INTERFACE NUMBER ',
135 . ipari(15,i), ' AT CYCLE ',ncycle,ispmd+1
136 WRITE(iout,'(A,I10,A,I10,I10)')
137 . '** NEW SORT FOR INTERFACE NUMBER ',
138 . ipari(15,i), ' AT CYCLE ',ncycle,ispmd+1
139 END IF
140 END IF
141C
142C Prepare test sur pas de temps sur l'interface
143C
144 vx(kk) = max(vslv(1,i)-vmsr(4,i),
145 . vmsr(1,i)-vslv(4,i),zero)
146 vy(kk) = max(vslv(2,i)-vmsr(5,i),
147 . vmsr(2,i)-vslv(5,i),zero)
148 vz(kk) = max(vslv(3,i)-vmsr(6,i),
149 . vmsr(3,i)-vslv(6,i),zero)
150 criterl(kk) =intbuf_tab(i)%VARIABLES(6)
151C
152 END IF
153 END IF
154 END DO
155C
156C test sur pas de temps sur l'interface (parith on spmd)
157 IF(nspmd>1) THEN
158 CALL spmd_i21crit(criterl,vx,vy,vz,dist0)
159 IF(nbintc21>0) THEN
160 DO i=1,nbintc21
161 j = intlist21(i)
162 kk = intstamp(j)%NOINTER
163 IF(dist0(j)<=zero) THEN
164 intbuf_tab(kk)%VARIABLES(5) = -one
165 IF(debug(3)>=1.AND.ncycle/=0) THEN
166 WRITE(istdo,'(A,I10,A,I10,I10)')
167 . '** NEW SORT FOR INTERFACE NUMBER ',
168 . ipari(15,i), ' AT CYCLE ',ncycle,ispmd+1
169 WRITE(iout,'(A,I10,A,I10,I10)')
170 . '** NEW SORT FOR INTERFACE NUMBER ',
171 . ipari(15,i), ' AT CYCLE ',ncycle,ispmd+1
172 END IF
173 ENDIF
174 ENDDO
175 ENDIF
176 ENDIF
177 DO kk=1,nintstamp
178 i = intstamp(kk)%NOINTER
179 ity=ipari(7,i)
180 IF(ity==21)THEN
181 vv(kk) = sqrt(vx(kk)**2+vy(kk)**2+vz(kk)**2)
182 . +sqrt(v21msr(1,kk)**2+v21msr(2,kk)**2+v21msr(3,kk)**2)
183
184 IF(vv(kk)/=zero) THEN
185 dti = zep9*criterl(kk)/vv(kk)
186 IF(dti<dt2t) THEN
187 dt2t = dti
188 neltst = ipari(15,i)
189 ityptst = 10
190 END IF
191 IF(dti <= dtmin1(10) .AND. idtmin(10)==1)THEN
192 WRITE(iout,'(A,E12.4,A,I10)')
193 . ' **WARNING MINIMUM TIME STEP ',dti,
194 . ' IN INTERFACE ID=',ipari(15,i)
195 IF (istamping == 1) imess=1
196 tstop=tt
197 END IF
198 END IF
199 END IF
200 END DO
201 IF(nspmd>1)
202 . CALL spmd_glob_isum9(imess,1)
203C
204 IF(imess/=0.AND.ispmd==0)THEN
205 WRITE(istdo,'(A)')
206 . 'The run encountered a problem in an interface Type 21:'
207 WRITE(istdo,'(A)')'You may need to check if there is enou'//
208 . 'gh clearance between the tools.'
209 WRITE(iout, '(A)')
210 . 'The run encountered a problem in an interface Type 21:'
211 WRITE(iout, '(A)')'You may need to check if there is enou'//
212 . 'gh clearance between the tools.'
213 END IF
214C
215 RETURN
216 END
217C
my_real
#define my_real
Definition cppsort.cpp:32
i21_icrit
subroutine i21_icrit(intbuf_tab, ipari, dt2t, neltst, nsensor, ityptst, xslv, xmsr, vslv, vmsr, intstamp, x21msr, v21msr, sensor_tab, nbintc21, intlist21)
Definition i21_icrit.F:40
max
#define max(a, b)
Definition macros.h:21
intstamp_mod
Definition intstamp_mod.F:38
spmd_i21crit
subroutine spmd_i21crit(gapinf, vx, vy, vz, dist)
Definition spmd_i21crit.F:34
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:523
intstamp_mod::intstamp_data
Definition intstamp_mod.F:46