OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
newskw.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "lagmult.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine newskw (skew, iskwn, x, iskwp_l, nskwp, numskw_l, numskw_l_send, iskwp_l_send, recvcount, iskwp)
subroutine newskw_init (iskwp, numskw_l, nskwp, numskw_l_send, iskwp_l_send, recvcount)

Function/Subroutine Documentation

◆ newskw()

subroutine newskw ( skew,
integer, dimension(liskn,*) iskwn,
x,
integer, dimension(numskw), intent(in) iskwp_l,
integer, dimension(*) nskwp,
integer, intent(in) numskw_l,
integer, intent(in) numskw_l_send,
integer, dimension(numskw), intent(in) iskwp_l_send,
integer, dimension(nspmd), intent(in) recvcount,
integer, dimension(*) iskwp )

Definition at line 30 of file newskw.F.

32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C D u m m y A r g u m e n t s
38C-----------------------------------------------
39 INTEGER ISKWN(LISKN,*), NSKWP(*),ISKWP(*)
40 INTEGER, DIMENSION(NUMSKW), INTENT(IN) :: ISKWP_L,ISKWP_L_SEND
41 INTEGER, DIMENSION(NSPMD), INTENT(IN) :: RECVCOUNT
42 INTEGER, INTENT(IN) :: NUMSKW_L,NUMSKW_L_SEND
43C REAL
44 my_real
45 . skew(lskew,*), x(3,*)
46! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
47! ISKWN : integer ; dimension=LISKN*number of skew
48! SKEW property array
49! NSKWP : integer ; dimension = NSPMD
50! number of skew per processor
51! ISKWP : integer ; dimension=NUMSKW+1
52! gives the ID processir of the current i SKEW
53! ISKWP < 0 --> the SKEW is local on a processor
54! and we don't need to communicate the data
55! ISKWP > 0 --> the SKEW is global and the data must be
56! communicated
57! NUMSKW_L : integer
58! number of local SKEW
59! ISKWP_L : integer ; dimension=NUMSKW_L_SEND
60! index of local SKEW
61! NUMSKW_L_SEND : integer
62! number of sent SKEW
63! ISKWP_L_SEND : integer ; dimension=NUMSKW_L_SEND
64! index of sent SKEW
65! RECVCOUNT : integer ; dimension=NSPMD
66! number of received SKEW
67! SKEW : real ; dimension=LISKN*number of skew
68! SKEW property array
69! X : real ; dimension=3*NUMNOD
70! position
71! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "com01_c.inc"
76#include "com04_c.inc"
77#include "task_c.inc"
78#include "param_c.inc"
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER N, N1, N2, N3, K, I, J, LOC_PROC,IMOV,IDIR,NN
83C REAL
84 my_real
85 . p(12), pp1, pp3, pp2
86C-----------------------------------------------
87C S o u r c e L i n e s
88C-----------------------------------------------
89!$COMMENT
90! NEWSKW description
91! compute the SKEW and send it if required
92!
93! NEWSKW organization :
94! - compute SKEW
95! - send SKEW
96!$ENDCOMMENT
97 loc_proc = ispmd+1
98 DO nn=1,numskw_l
99 n = iskwp_l(nn)
100! do n=1,NUMSKW
101! IF(abs(ISKWP(N+1))==LOC_PROC)THEN
102
103C processeur concerne par le skew
104 n1=iskwn(1,n+1)
105 n2=iskwn(2,n+1)
106 n3=iskwn(3,n+1)
107 imov=iskwn(5,n+1)
108 idir=iskwn(6,n+1)
109C----------------
110C SKEW MOBILE
111C----------------
112 IF (n1+n2+n3/=0) THEN
113C
114 IF(imov == 1)THEN
115 IF(n2d==0)THEN
116C-----------------
117C CALCUL DE X'(IDIR=1) Y'(IDIR=2) Z'(IDIR=3)
118C-----------------
119 IF (idir == 1)THEN
120 p(1)=x(1,n2)-x(1,n1)
121 p(2)=x(2,n2)-x(2,n1)
122 p(3)=x(3,n2)-x(3,n1)
123 ELSEIF (idir == 2)THEN
124 p(4)=x(1,n2)-x(1,n1)
125 p(5)=x(2,n2)-x(2,n1)
126 p(6)=x(3,n2)-x(3,n1)
127 ELSEIF (idir == 3)THEN
128 p(7)=x(1,n2)-x(1,n1)
129 p(8)=x(2,n2)-x(2,n1)
130 p(9)=x(3,n2)-x(3,n1)
131 ENDIF
132C-----------------
133C CALCUL DE Y0'(IDIR=1) Z0'(IDIR=2) X0'(IDIR=3)
134C-----------------
135 IF (idir == 1)THEN
136 p(4)=x(1,n3)-x(1,n1)
137 p(5)=x(2,n3)-x(2,n1)
138 p(6)=x(3,n3)-x(3,n1)
139 ELSEIF (idir == 2)THEN
140 p(7)=x(1,n3)-x(1,n1)
141 p(8)=x(2,n3)-x(2,n1)
142 p(9)=x(3,n3)-x(3,n1)
143 ELSEIF (idir == 3)THEN
144 p(1)=x(1,n3)-x(1,n1)
145 p(2)=x(2,n3)-x(2,n1)
146 p(3)=x(3,n3)-x(3,n1)
147 ENDIF
148 ELSE
149 p(1)=one
150 p(2)=zero
151 p(3)=zero
152 p(4)=x(1,n2)-x(1,n1)
153 p(5)=x(2,n2)-x(2,n1)
154 p(6)=x(3,n2)-x(3,n1)
155 ENDIF
156C------------------
157C SI X'=0
158C => X'=X(IDIR=1)
159C SI Y'=0
160C => Y'=Y(IDIR=2)
161C SI Z'=0
162C => Z'=Z(IDIR=3)
163C------------------
164 IF (idir == 1) THEN
165 pp1=sqrt(p(1)*p(1)+p(2)*p(2)+p(3)*p(3))
166 IF(pp1==zero)THEN
167 p(1)=one
168 p(2)=zero
169 p(3)=zero
170 pp1 =one
171 ENDIF
172 ELSE IF (idir == 2)THEN
173 pp2=sqrt(p(4)*p(4)+p(5)*p(5)+p(6)*p(6))
174 IF(pp2==zero)THEN
175 p(4)=zero
176 p(5)=one
177 p(6)=zero
178 pp2 =one
179 ENDIF
180 ELSE IF (idir == 3)THEN
181 pp3=sqrt(p(7)*p(7)+p(8)*p(8)+p(9)*p(9))
182 IF(pp3==zero)THEN
183 p(7)=zero
184 p(8)=zero
185 p(9)=one
186 pp3 =one
187 ENDIF
188 ENDIF
189C-----------------
190C CALCUL DE Z'(IDIR=1) X'(IDIR=2) Y'(IDIR=3)
191C-----------------
192 IF (idir == 1)THEN
193 p(7)=p(2)*p(6)-p(3)*p(5)
194 p(8)=p(3)*p(4)-p(1)*p(6)
195 p(9)=p(1)*p(5)-p(2)*p(4)
196 pp3=sqrt(p(7)*p(7)+p(8)*p(8)+p(9)*p(9))
197 ELSEIF (idir == 2)THEN
198 p(1)=p(5)*p(9)-p(6)*p(8)
199 p(2)=p(6)*p(7)-p(4)*p(9)
200 p(3)=p(4)*p(8)-p(5)*p(7)
201 pp1=sqrt(p(1)*p(1)+p(2)*p(2)+p(3)*p(3))
202 ELSEIF (idir == 3)THEN
203 p(4)=p(8)*p(3)-p(9)*p(2)
204 p(5)=p(9)*p(1)-p(7)*p(3)
205 p(6)=p(7)*p(2)-p(8)*p(1)
206 pp2=sqrt(p(4)*p(4)+p(5)*p(5)+p(6)*p(6))
207 ENDIF
208C------------------
209C SI Z'=0 (Y0'=X')
210C => Y0' != X'(IDIR=1)
211C SI X'=0 (Z0'=Y')
212C => Z0' != Y'(IDIR=2)
213C SI X'=0 (Z0'=Y')
214C => Z0' != Z'(IDIR=3)
215C------------------
216 IF (idir == 1) THEN
217 IF(pp3==zero)THEN
218 IF(p(1)==zero)THEN
219 p(4)=pp1
220 p(5)=p(2)
221 ELSE
222 p(4)=p(1)
223 p(5)=abs(p(2))+pp1
224 ENDIF
225 p(6)=p(3)
226 p(7)=p(2)*p(6)-p(3)*p(5)
227 p(8)=p(3)*p(4)-p(1)*p(6)
228 p(9)=p(1)*p(5)-p(2)*p(4)
229 pp3=sqrt(p(7)*p(7)+p(8)*p(8)+p(9)*p(9))
230 ENDIF
231 ELSEIF (idir == 2) THEN
232 IF(pp1==zero)THEN
233 IF(p(4)==zero)THEN
234 p(7)=pp2
235 p(8)=p(5)
236 ELSE
237 p(7)=p(4)
238 p(8)=abs(p(5))+pp2
239 ENDIF
240 p(9)=p(6)
241 p(1)=p(5)*p(9)-p(6)*p(8)
242 p(2)=p(6)*p(7)-p(4)*p(9)
243 p(3)=p(4)*p(8)-p(5)*p(7)
244 pp1=sqrt(p(1)*p(1)+p(2)*p(2)+p(3)*p(3))
245 ENDIF
246 ELSEIF (idir == 3) THEN
247 IF(pp2==zero)THEN
248 IF(p(7)==zero)THEN
249 p(1)=pp3
250 p(2)=p(8)
251 ELSE
252 p(1)=p(7)
253 p(2)=abs(p(8))+pp3
254 ENDIF
255 p(3)=p(9)
256 p(4)=p(8)*p(3)-p(9)*p(2)
257 p(5)=p(9)*p(1)-p(7)*p(3)
258 p(6)=p(7)*p(2)-p(8)*p(1)
259 pp2=sqrt(p(4)*p(4)+p(5)*p(5)+p(6)*p(6))
260 ENDIF
261 ENDIF
262C-----------------
263C CALCUL DE Y'(IDIR=1) Z'(IDIR=2) X'(IDIR=3)
264C-----------------
265 IF (idir == 1) THEN
266 p(4)=p(8)*p(3)-p(9)*p(2)
267 p(5)=p(9)*p(1)-p(7)*p(3)
268 p(6)=p(7)*p(2)-p(8)*p(1)
269 pp2=sqrt(p(4)*p(4)+p(5)*p(5)+p(6)*p(6))
270 ELSEIF (idir == 2) THEN
271 p(7)=p(2)*p(6)-p(3)*p(5)
272 p(8)=p(3)*p(4)-p(1)*p(6)
273 p(9)=p(1)*p(5)-p(2)*p(4)
274 pp3=sqrt(p(7)*p(7)+p(8)*p(8)+p(9)*p(9))
275 ELSEIF (idir == 3) THEN
276 p(1)=p(5)*p(9)-p(6)*p(8)
277 p(2)=p(6)*p(7)-p(4)*p(9)
278 p(3)=p(4)*p(8)-p(5)*p(7)
279 pp1=sqrt(p(1)*p(1)+p(2)*p(2)+p(3)*p(3))
280 ENDIF
281C
282 ELSEIF(imov == 2)THEN
283C-----------------
284C CALCUL DE X0'
285C-----------------
286 p(1)=x(1,n3)-x(1,n1)
287 p(2)=x(2,n3)-x(2,n1)
288 p(3)=x(3,n3)-x(3,n1)
289C-----------------
290C CALCUL DE Z'
291C-----------------
292 p(7)=x(1,n2)-x(1,n1)
293 p(8)=x(2,n2)-x(2,n1)
294 p(9)=x(3,n2)-x(3,n1)
295C------------------
296C SI Z'=0
297C => Z'=Z
298C------------------
299 pp3=sqrt(p(7)*p(7)+p(8)*p(8)+p(9)*p(9))
300 IF(pp3==zero)THEN
301 p(7)=zero
302 p(8)=zero
303 p(9)=one
304 pp3 =one
305 ENDIF
306C-----------------
307C CALCUL DE Y' = Z' x X0'
308C-----------------
309 p(4)=p(8)*p(3)-p(9)*p(2)
310 p(5)=p(9)*p(1)-p(7)*p(3)
311 p(6)=p(7)*p(2)-p(8)*p(1)
312 pp2=sqrt(p(4)*p(4)+p(5)*p(5)+p(6)*p(6))
313C------------------
314C SI Y'=0 (X0'=Z')
315C => X0' != Y'
316C------------------
317 IF(pp2==zero)THEN
318 IF(p(7)==zero)THEN
319 p(1)=pp3
320 p(2)=p(8)
321 ELSE
322 p(1)=p(7)
323 p(2)=abs(p(8))+pp3
324 ENDIF
325 p(3)=p(9)
326 p(4)=p(8)*p(3)-p(9)*p(2)
327 p(5)=p(9)*p(1)-p(7)*p(3)
328 p(6)=p(7)*p(2)-p(8)*p(1)
329 pp2=sqrt(p(4)*p(4)+p(5)*p(5)+p(6)*p(6))
330 ENDIF
331C-----------------
332C CALCUL DE X' = Y' x Z'
333C-----------------
334 p(1)=p(5)*p(9)-p(6)*p(8)
335 p(2)=p(6)*p(7)-p(4)*p(9)
336 p(3)=p(4)*p(8)-p(5)*p(7)
337 pp1=sqrt(p(1)*p(1)+p(2)*p(2)+p(3)*p(3))
338C
339 END IF
340C-----------
341C NORME
342C-----------
343 p(1)=p(1)/pp1
344 p(2)=p(2)/pp1
345 p(3)=p(3)/pp1
346 p(4)=p(4)/pp2
347 p(5)=p(5)/pp2
348 p(6)=p(6)/pp2
349 p(7)=p(7)/pp3
350 p(8)=p(8)/pp3
351 p(9)=p(9)/pp3
352C-----------------
353C ORIGINE
354C-----------------
355 p(10) = x(1,n1)
356 p(11) = x(2,n1)
357 p(12) = x(3,n1)
358C
359 DO k=1,12
360 skew(k,n+1)=p(k)
361 END DO
362C
363! ENDIF
364 ENDIF
365 END DO
366C
367 IF(nspmd > 1) THEN
368 CALL spmd_sd_skw(skew,iskwp_l_send,numskw_l_send,recvcount)
369 END IF
370C
371 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
spmd_sd_skw
subroutine spmd_sd_skw(skew, iskwp_l_send, numskw_l_send, recvcount)
Definition spmd_sd_skw.F:32

◆ newskw_init()

subroutine newskw_init ( integer, dimension(*) iskwp,
integer, intent(out) numskw_l,
integer, dimension(nspmd), intent(in) nskwp,
integer, intent(out) numskw_l_send,
integer, dimension(numskw), intent(inout) iskwp_l_send,
integer, dimension(nspmd), intent(inout) recvcount )

Definition at line 378 of file newskw.F.

379C-----------------------------------------------
380C I m p l i c i t T y p e s
381C-----------------------------------------------
382#include "implicit_f.inc"
383C-----------------------------------------------
384C D u m m y A r g u m e n t s
385C-----------------------------------------------
386 INTEGER ISKWP(*)
387 INTEGER, DIMENSION(NSPMD), INTENT(IN) :: NSKWP
388 INTEGER, DIMENSION(NSPMD), INTENT(INOUT) :: RECVCOUNT
389 INTEGER, DIMENSION(NUMSKW), INTENT(INOUT) :: ISKWP_L_SEND
390 INTEGER, INTENT(OUT) :: NUMSKW_L,NUMSKW_L_SEND
391! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
392! NSKWP : integer ; dimension = NSPMD
393! number of skew per processor
394! ISKWP : integer ; dimension=NUMSKW+1
395! gives the ID processir of the current i SKEW
396! ISKWP < 0 --> the SKEW is local on a processor
397! and we don't need to communicate the data
398! ISKWP > 0 --> the SKEW is global and the data must be
399! communicated
400! NUMSKW_L : integer
401! number of local SKEW
402! NUMSKW_L_SEND : integer
403! number of sent SKEW
404! ISKWP_L_SEND : integer ; dimension=NUMSKW_L_SEND
405! index of sent SKEW
406! RECVCOUNT : integer ; dimension=NSPMD
407! number of received SKEW
408! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
409C REAL
410C-----------------------------------------------
411C C o m m o n B l o c k s
412C-----------------------------------------------
413#include "com01_c.inc"
414#include "com04_c.inc"
415#include "task_c.inc"
416#include "lagmult.inc"
417C-----------------------------------------------
418C L o c a l V a r i a b l e s
419C-----------------------------------------------
420 INTEGER N, N1, N2, N3, K, I, J, LOC_PROC,IMOV,IDIR,NN,NN2
421C REAL
422 my_real
423 . p(12), pp1, pp3, pp2
424C-----------------------------------------------
425C S o u r c e L i n e s
426C-----------------------------------------------
427!$COMMENT
428! NEWSKW_INIT description
429! initialization of the sent index array ISKWP_L_SEND
430! and the number of received SKEW value (for the comm)
431!
432! NEWSKW_INIT organization :
433! - initialize the ISKWP_L_SEND index array :
434! if ISKWP(N+A) = local proc, N+1 must be sent
435! if ISKWP(N+A) = -local proc, N+1 is local to
436! the processor and the comm is not mandatory
437! if LAG MULT method is used, need to always
438! communicate the SKEW arrays
439!$ENDCOMMENT
440
441! initialization
442 loc_proc = ispmd+1
443 numskw_l = 0
444 numskw_l_send = 0
445 nn = 0
446 nn2 = 0
447 recvcount(1:nspmd) = 0
448
449! loop over numskw : if ISKWP = local proc --> need to communicate
450 DO n=1,numskw
451 ! LAG MULT method
452 IF(lag_ncf+lag_ncl>0) THEN
453 IF(abs(iskwp(n+1))==loc_proc)THEN
454 nn2 = nn2 + 1
455 iskwp_l_send(nn2) = n
456 ENDIF
457 IF(iskwp(n+1)/=0) recvcount(abs(iskwp(n+1))) = recvcount(abs(iskwp(n+1))) + 10
458 ELSE
459 ! other
460 IF(iskwp(n+1)==loc_proc)THEN
461 nn2 = nn2 + 1
462 iskwp_l_send(nn2) = n
463 ENDIF
464 IF(iskwp(n+1)>0) recvcount(iskwp(n+1)) = recvcount(iskwp(n+1)) + 10
465 ENDIF
466 ENDDO
467 IF(numskw>0) THEN
468 numskw_l = nskwp(ispmd+1)
469 numskw_l_send = nn2
470 ELSE
471 numskw_l = 0
472 numskw_l_send = 0
473 ENDIF
474C
475 RETURN