OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21_icrit.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "intstamp_c.inc"
#include "task_c.inc"
#include "scr18_c.inc"
#include "units_c.inc"
#include "warn_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i21_icrit (intbuf_tab, ipari, dt2t, neltst, nsensor, ityptst, xslv, xmsr, vslv, vmsr, intstamp, x21msr, v21msr, sensor_tab, nbintc21, intlist21)

Function/Subroutine Documentation

◆ i21_icrit()

subroutine i21_icrit ( type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(npari,*) ipari,
dt2t,
integer neltst,
integer, intent(in) nsensor,
integer ityptst,
xslv,
xmsr,
vslv,
vmsr,
type(intstamp_data), dimension(*) intstamp,
x21msr,
v21msr,
type (sensor_str_), dimension(nsensor) sensor_tab,
integer nbintc21,
integer, dimension(*) intlist21 )

Definition at line 35 of file i21_icrit.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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