OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25main_norm.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "spmd_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i25main_norm (intlist25, ipari, intbuf_tab, jtask, x, itab, nsensor, sensor_tab, iad_frnor, fr_nor, iad_fredg, fr_edg, iad_elem, fr_elem, fskyn25, addcsrect, procnor)

Function/Subroutine Documentation

◆ i25main_norm()

subroutine i25main_norm ( integer, dimension(*) intlist25,
integer, dimension(npari,ninter) ipari,
type(intbuf_struct_), dimension(ninter) intbuf_tab,
integer, intent(in) jtask,
x,
integer, dimension(*) itab,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
integer, dimension(ninter25,*) iad_frnor,
integer, dimension(*) fr_nor,
integer, dimension(ninter25,*) iad_fredg,
integer, dimension(*) fr_edg,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
real*4, dimension(3,*) fskyn25,
integer, dimension(*) addcsrect,
integer, dimension(*) procnor )

Definition at line 37 of file i25main_norm.F.

42C=======================================================================
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE mpi_commod
47 USE intbufdef_mod
48 USE sensor_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com01_c.inc"
57#include "com04_c.inc"
58#include "com08_c.inc"
59#include "param_c.inc"
60#include "task_c.inc"
61#include "spmd_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER ,INTENT(IN) :: JTASK,NSENSOR
66 INTEGER IPARI(NPARI,NINTER), INTLIST25(*), ITAB(*),
67 . IAD_FRNOR(NINTER25,*), FR_NOR(*), IAD_FREDG(NINTER25,*), FR_EDG(*),
68 . IAD_ELEM(2,*), FR_ELEM(*),ADDCSRECT(*), PROCNOR(*)
69C REAL
70 my_real :: x(3,*)
71 TYPE(INTBUF_STRUCT_),DIMENSION(NINTER) :: INTBUF_TAB
72 TYPE(MPI_COMM_NOR_STRUCT) , DIMENSION(NINTER25) :: BUFFERS
73 real*4 fskyn25(3,*)
74 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER N, ISENS, NI25, NADMSR, IEDGE, NADMSRF6, NADMSRL6,
79 . NRTM, NSN, NSNR, NRTM_SH, NRTM0, FLAGREMN ,NCSHIFT ,ISHIFT,
80 . SIZE_NODNOR_E2S,I,J,NOD,CC,SOL_EDGE
81 INTEGER :: NEDGE
82C REAL
83 my_real
84 . ts, startt, stopt
85 real*4 rzero
86C-----------------------------------------------
87 rzero = 0.
88C
89C parallel calculation of normals
90C
91 IF(jtask==1) THEN
92 DO i=1,ninter25
93 n = intlist25(i)
94 nrtm = ipari(4,n)
95 ALLOCATE(intbuf_tab(n)%TAGNOD(numnod), intbuf_tab(n)%WNOD_NORMAL(3,4,nrtm))
96 ALLOCATE(intbuf_tab(n)%TAGE(nrtm))
97 ENDDO
98 END IF
99C
100 CALL my_barrier()
101C
102 ncshift = 1
103 ishift = 0
104 DO ni25=1,ninter25
105
106 n = intlist25(ni25)
107C
108 startt=intbuf_tab(n)%VARIABLES(3)
109 stopt =intbuf_tab(n)%VARIABLES(11)
110C
111 isens = ipari(64,n)
112 IF (isens > 0) THEN ! Interface activated by sensor
113 ts = sensor_tab(isens)%TSTART
114 ELSE
115 ts = tt
116 ENDIF
117 nadmsr = ipari(67,n)
118
119 IF(tt >= ts.AND.tt >= startt.AND.tt <= stopt) THEN
120C
121 IF(jtask == 1) THEN
122
123 size_nodnor_e2s = 0
124
125 iedge = ipari(58,n)
126 sol_edge =0
127 IF(iedge /= 0) sol_edge =iedge/10 ! solids
128
129 IF(sol_edge/=0)THEN
130 DO i = 1, nspmd
131 IF(iad_frnor(ni25,i+1)-iad_frnor(ni25,i)>0) THEN
132 DO j=iad_frnor(ni25,i),iad_frnor(ni25,i+1)-1
133 nod = ishift + fr_nor(j)
134 DO cc = addcsrect(nod),addcsrect(nod+1)-1
135 IF(procnor(cc)==i) THEN
136 size_nodnor_e2s = size_nodnor_e2s + 6
137 ENDIF
138 END DO
139 END DO
140 ENDIF
141 ENDDO
142 ENDIF
143
144
145 ALLOCATE(buffers(ni25)%SEND_BUF( 3*(iad_fredg(ni25,nspmd+1)-iad_fredg(ni25,1))
146 . +2*3*(iad_frnor(ni25,nspmd+1)-iad_frnor(ni25,1))
147 . + (iad_frnor(ni25,nspmd+1)-iad_frnor(ni25,1))
148 . + size_nodnor_e2s))
149 ALLOCATE(buffers(ni25)%RECV_BUF( 3*(iad_fredg(ni25,nspmd+1)-iad_fredg(ni25,1))
150 . +2*3*(iad_frnor(ni25,nspmd+1)-iad_frnor(ni25,1))
151 . + (iad_frnor(ni25,nspmd+1)-iad_frnor(ni25,1))
152 . + size_nodnor_e2s))
153
154 ALLOCATE(buffers(ni25)%ISINDEX(nspmd))
155 ALLOCATE(buffers(ni25)%IRINDEX(nspmd))
156 ALLOCATE(buffers(ni25)%SEND_RQ(nspmd))
157 ALLOCATE(buffers(ni25)%RECV_RQ(nspmd))
158 ALLOCATE(buffers(ni25)%IAD_RECV(nspmd+1))
159 ALLOCATE(buffers(ni25)%IAD_SEND(nspmd+1))
160 ENDIF
161C
162 nrtm = ipari(4,n)
163 nsn = ipari(5,n)
164 nsnr = ipari(24,n)
165
166
167
168 nrtm_sh=ipari(42,n)
169 nrtm0 =nrtm-nrtm_sh
170 flagremn = ipari(63,n)
171
172 iedge = ipari(58,n)
173 nedge = ipari(68,n) ! Updated in i25normp
174 sol_edge =0
175 IF(iedge /= 0) sol_edge =iedge/10 ! solids
176
177 CALL i25tagn(ni25 ,n ,nrtm ,nsn ,nsnr ,
178 2 jtask ,iad_frnor ,fr_nor ,intbuf_tab(n)%IRTLM,intbuf_tab(n)%MSEGTYP24 ,
179 3 intbuf_tab(n)%I_STOK(2), intbuf_tab(n)%I_STOK(3), intbuf_tab(n)%CAND_OPT_E,
180 . intbuf_tab(n)%STFNS, intbuf_tab(n)%ACTNOR,intbuf_tab(n)%IRECTM,
181 4 intbuf_tab(n)%TAGNOD,iad_elem,fr_elem ,intbuf_tab(n)%ADMSR,intbuf_tab(n)%KNOR2MSR,
182 5 intbuf_tab(n)%NOR2MSR,flagremn,intbuf_tab(n)%KREMNOR,intbuf_tab(n)%REMNOR,
183 6 iedge, nedge, intbuf_tab(n)%LEDGE,intbuf_tab(n)%NRTM_FREE,
184 . intbuf_tab(n)%FREE_IRECT_ID,intbuf_tab(n)%I_STOK_E(2),
185 7 intbuf_tab(n)%CANDM_E2S,intbuf_tab(n)%CANDS_E2S,intbuf_tab(n)%MVOISIN,
186 8 intbuf_tab(n)%E2S_ACTNOR,nadmsr,intbuf_tab(n)%STFM,
187 8 intbuf_tab(n)%NUMBER_EDGE_TYPE1,intbuf_tab(n)%NUMBER_EDGE_TYPE1_0,
188 . intbuf_tab(n)%EDGE_TYPE1,intbuf_tab(n)%EDGE_TYPE1_0 )
189
190
191C
192 nadmsrf6= 1+(jtask-1)*6*nadmsr/ nthread
193 nadmsrl6= jtask*6*nadmsr/nthread
194 intbuf_tab(n)%VTX_BISECTOR(nadmsrf6:nadmsrl6)=rzero
195C
196 IF(jtask==1) ALLOCATE(intbuf_tab(n)%TAGSEG(4,4*nrtm))
197
198 CALL my_barrier()
199C
200
201 CALL i25normp(
202 1 ni25,nrtm,nrtm0,intbuf_tab(n)%IRECTM,x ,
203 2 intbuf_tab(n)%EDGE_BISECTOR,ipari(6,n),intbuf_tab(n)%MSR ,
204 . jtask,intbuf_tab(n)%STFM,intbuf_tab(n)%STFE,
205 3 intbuf_tab(n)%ACTNOR,intbuf_tab(n)%MSEGTYP24,intbuf_tab(n)%TAGNOD,
206 . intbuf_tab(n)%MVOISIN,intbuf_tab(n)%EVOISIN,
207 4 iad_fredg,fr_edg,intbuf_tab(n)%WNOD_NORMAL,buffers(ni25),iedge,ipari(68,n),
208 5 intbuf_tab(n)%LEDGE,intbuf_tab(n)%LBOUND,nadmsr,intbuf_tab(n)%ADMSR,
209 6 iad_frnor,fr_nor,intbuf_tab(n)%VTX_BISECTOR,1,
210 7 intbuf_tab(n)%NB_TAGSEG, intbuf_tab(n)%TAGSEG,intbuf_tab(n)%TAGE,intbuf_tab(n)%FREE_IRECT_ID,intbuf_tab(n)%NRTM_FREE,
211 8 fskyn25(1,ncshift),intbuf_tab(n)%IADNOR,ishift,addcsrect,procnor,sol_edge ,
212 9 fskyn25 )
213
214C
215 CALL my_barrier()
216
217
218 IF(jtask==1) DEALLOCATE(intbuf_tab(n)%TAGSEG)
219 ENDIF
220
221 ncshift=ncshift+intbuf_tab(n)%ADSKYN(nadmsr+1)-1
222 ishift = ishift + ipari(67,n)
223C
224 END DO
225
226C ALLOCATE(INTBUF_TAB(I)%TAGSEG(1,1))
227
228 ncshift = 1
229 ishift = 0
230 DO ni25=1,ninter25
231
232 n = intlist25(ni25)
233C
234 startt=intbuf_tab(n)%VARIABLES(3)
235 stopt =intbuf_tab(n)%VARIABLES(11)
236C
237 isens = ipari(64,n)
238 IF (isens > 0) THEN ! Interface activated by sensor
239 ts = sensor_tab(isens)%TSTART
240 ELSE
241 ts = tt
242 ENDIF
243
244 nadmsr = ipari(67,n)
245
246 IF(tt >= ts.AND.tt >= startt.AND.tt <= stopt) THEN
247
248 nrtm = ipari(4,n)
249 nsn = ipari(5,n)
250 nsnr = ipari(24,n)
251
252 nrtm_sh=ipari(42,n)
253 nrtm0 =nrtm-nrtm_sh
254
255 iedge = ipari(58,n)
256C NEDGE = IPARI(68,N) ! Updated in i25normp
257 sol_edge =0
258 IF(iedge /= 0) sol_edge =iedge/10 ! solids
259
260 CALL my_barrier()
261
262 CALL i25normp(
263 1 ni25,nrtm,nrtm0,intbuf_tab(n)%IRECTM,x ,
264 2 intbuf_tab(n)%EDGE_BISECTOR,ipari(6,n),intbuf_tab(n)%MSR ,
265 . jtask,intbuf_tab(n)%STFM,intbuf_tab(n)%STFE,
266 3 intbuf_tab(n)%ACTNOR,intbuf_tab(n)%MSEGTYP24,intbuf_tab(n)%TAGNOD,
267 . intbuf_tab(n)%MVOISIN,intbuf_tab(n)%EVOISIN,
268 4 iad_fredg,fr_edg,intbuf_tab(n)%WNOD_NORMAL,buffers(ni25),iedge,ipari(68,n),
269 5 intbuf_tab(n)%LEDGE,intbuf_tab(n)%LBOUND,nadmsr,intbuf_tab(n)%ADMSR,
270 6 iad_frnor,fr_nor,intbuf_tab(n)%VTX_BISECTOR,2,
271 7 intbuf_tab(n)%NB_TAGSEG,intbuf_tab(n)%TAGSEG,intbuf_tab(n)%TAGE,intbuf_tab(n)%FREE_IRECT_ID,intbuf_tab(n)%NRTM_FREE,
272 8 fskyn25(1,ncshift),intbuf_tab(n)%IADNOR,ishift,addcsrect,procnor,sol_edge,
273 9 fskyn25 )
274
275
276 CALL my_barrier()
277
278
279 IF(jtask == 1) THEN
280 DEALLOCATE(buffers(ni25)%SEND_BUF)
281 DEALLOCATE(buffers(ni25)%RECV_BUF)
282 DEALLOCATE(buffers(ni25)%ISINDEX)
283 DEALLOCATE(buffers(ni25)%IRINDEX)
284 DEALLOCATE(buffers(ni25)%SEND_RQ)
285 DEALLOCATE(buffers(ni25)%RECV_RQ)
286 DEALLOCATE(buffers(ni25)%IAD_RECV)
287 DEALLOCATE(buffers(ni25)%IAD_SEND)
288 ENDIF
289 CALL my_barrier()
290 ENDIF
291
292 ncshift=ncshift+intbuf_tab(n)%ADSKYN(nadmsr+1)-1
293 ishift = ishift + ipari(67,n)
294 END DO
295C
296
297c CALL STOPTIME(TIMERS,MACRO_TIMER_T25NORM)
298 ncshift = 1
299 DO ni25=1,ninter25
300C
301 n = intlist25(ni25)
302
303 iedge = ipari(58,n)
304C NEDGE = IPARI(68,N) ! Updated in i25normp
305 sol_edge =0
306 IF(iedge /= 0) sol_edge =iedge/10 ! solids
307
308 IF(sol_edge/=0)THEN
309
310 isens = ipari(64,n)
311 IF (isens > 0) THEN ! Interface activated by sensor
312 ts = sensor_tab(isens)%TSTART
313 ELSE
314 ts = tt
315 ENDIF
316
317 startt=intbuf_tab(n)%VARIABLES(3)
318 stopt =intbuf_tab(n)%VARIABLES(11)
319
320 nadmsr = ipari(67,n)
321 IF(tt >= ts.AND.tt >= startt.AND.tt <= stopt) THEN
322 CALL i25assnp(
323 1 jtask ,nadmsr ,intbuf_tab(n)%E2S_NOD_NORMAL,intbuf_tab(n)%ADMSR,intbuf_tab(n)%ADSKYN,
324 2 intbuf_tab(n)%IADNOR,intbuf_tab(n)%E2S_ACTNOR,fskyn25(1,ncshift))
325 END IF
326
327 ncshift=ncshift+intbuf_tab(n)%ADSKYN(nadmsr+1)-1
328 ENDIF
329
330 END DO
331c CALL STARTIME(TIMERS,MACRO_TIMER_T25NORM)
332C
333 CALL my_barrier()
334
335 IF(jtask==1)THEN
336 DO i=1,ninter25
337 n = intlist25(i)
338 DEALLOCATE(intbuf_tab(n)%TAGNOD, intbuf_tab(n)%WNOD_NORMAL,intbuf_tab(n)%TAGE)
339 ENDDO
340 ENDIF
341C
342 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i25normp
subroutine i25normp(ni25, nrtm, nrtm0, irect, x, nod_normal, nmn, msr, jtask, stifm, stfe, actnor, msegtyp, tagnod, mvoisin, evoisin, iad_fredg, fr_edg, wnod_normal, buffers, iedge, nedge, ledge, lbound, nadmsr, admsr, iad_frnor, fr_nor, vtx_bisector, flag, nb_free_bound, free_bound, tage, free_irect_id, nrtm_free, fskyt, iadnor, ishift, addcsrect, procnor, sol_edge, fskyn25)
Definition i25norm.F:446
i25tagn
subroutine i25tagn(ni25, nin, nrtm, nsn, nsnr, jtask, iad_frnor, fr_nor, irtlm, msegtyp, i_stok_glo, i_stok_rtlm, cand_opt_e, stfns, actnor, irect, tagnod, iad_elem, fr_elem, admsr, knor2msr, nor2msr, flagremn, kremnor, remnor, iedge, nedge, ledge, nrtm_free, free_irect_id, i_stok_e2s, candm_e2s, cands_e2s, mvoisin, e2s_actnor, nadmsr, stfm, number_edge_type1, number_edge_type1_0, edge_type1, edge_type1_0)
Definition i25norm.F:42
i25assnp
subroutine i25assnp(jtask, nadmsr, nod_normal, admsr, adskyt, iadnor, actnor, fskyt)
Definition i25norm.F:1125
mpi_commod
Definition mpi_comm_mod.F:37
my_barrier
subroutine my_barrier
Definition machine.F:31