OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
split_skew.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine split_skew (curr_proc, iskwp_l, iskwp, tag_skn, multiple_skew)
subroutine split_skew_save (curr_proc, iskwp_l, iskwp, tag_skn, multiple_skew, nskwp)

Function/Subroutine Documentation

◆ split_skew()

subroutine split_skew ( integer, intent(in) curr_proc,
integer, dimension(numskw+1), intent(inout) iskwp_l,
integer, dimension(numskw+1), intent(in) iskwp,
integer, dimension(numskw+1), intent(in) tag_skn,
type(plist_skew_), dimension(numskw+1), intent(in) multiple_skew )

Definition at line 29 of file split_skew.F.

30C-----------------------------------------------
31C M o d u l e s
32C-----------------------------------------------
33 USE skew_mod
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "com04_c.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER, INTENT(IN) :: CURR_PROC
46 INTEGER, DIMENSION(NUMSKW+1), INTENT(IN) :: TAG_SKN
47 INTEGER, DIMENSION(NUMSKW+1), INTENT(IN) :: ISKWP
48 INTEGER, DIMENSION(NUMSKW+1), INTENT(INOUT) :: ISKWP_L
49 TYPE(PLIST_SKEW_), DIMENSION(NUMSKW+1), INTENT(IN) :: MULTIPLE_SKEW
50! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
51! CURR_PROC : integer
52! current ID processor
53! TAG_SKN : integer ; dimension=NUMSKW+1
54! tag array --> tag the i SKEW if a SPRING uses it
55! tag array=0 --> the SKEW is not used by a SPRING
56! tag array=1 --> the SKEW is used by one SPRING
57! tag array>1 --> the SKEW is used by several SPRING
58! ISKWP : integer ; dimension=NUMSKW+1
59! gives the ID processir of the current i SKEW
60! ISKWP < 0 --> the SKEW is local on a processor
61! and we don't need to communicate the data
62! ISKWP > 0 --> the SKEW is global and the data must be
63! ISKWP_L : integer ; dimension=NUMSKW+1
64! index of SKEW on the current processor, used in the engine
65! MULTIPLE_SKEW : SKEW_TYPE ; dimension=NUMSKW+1
66! MULTIPLE_SKEW(I)%PLIST(:) is a list of processor
67! where the SKEW is stuck
68! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
69
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER :: I,J,NN
74 INTEGER :: SIZE_SKEW,ISKEW
75C-----------------------------------------------
76C S o u r c e L i n e s
77C-----------------------------------------------
78!$COMMENT
79! SPLIT_SKEW description
80! SPLIT_SKEW initializes the SKEW index ISKWP_L used in the engine
81!
82! SPLIT_SKEW organization :
83! - loop over the NUMSKW and check if the SKEW is on the current
84! processor
85!$ENDCOMMENT
86
87 nn = 0
88 DO i=1,numskw
89 size_skew = tag_skn(i+1)
90 IF(size_skew>1) THEN
91 iskew = 0
92 DO j=1,size_skew
93 IF(multiple_skew(i+1)%PLIST(j)==curr_proc) iskew = iskew + 1
94 ENDDO
95 IF(iskew>0) THEN
96 nn = nn + 1
97 iskwp_l( nn ) = i
98 ENDIF
99 ELSE
100 IF(abs(iskwp(i+1))==curr_proc) THEN
101 nn = nn + 1
102 iskwp_l( nn ) = i
103 ENDIF
104 ENDIF
105 ENDDO
106
107 RETURN

◆ split_skew_save()

subroutine split_skew_save ( integer, intent(in) curr_proc,
integer, dimension(numskw+1), intent(inout) iskwp_l,
integer, dimension(numskw+1), intent(in) iskwp,
integer, dimension(numskw+1), intent(in) tag_skn,
type(plist_skew_), dimension(numskw+1), intent(in) multiple_skew,
integer, dimension(*) nskwp )

Definition at line 125 of file split_skew.F.

126C-----------------------------------------------
127 USE skew_mod
128C-----------------------------------------------
129C I m p l i c i t T y p e s
130C-----------------------------------------------
131#include "implicit_f.inc"
132C-----------------------------------------------
133C C o m m o n B l o c k s
134C-----------------------------------------------
135#include "com04_c.inc"
136C-----------------------------------------------
137C D u m m y A r g u m e n t s
138C-----------------------------------------------
139 INTEGER, INTENT(IN) :: CURR_PROC
140 INTEGER, DIMENSION(NUMSKW+1), INTENT(IN) :: TAG_SKN
141 INTEGER, DIMENSION(NUMSKW+1), INTENT(IN) :: ISKWP
142 INTEGER, DIMENSION(NUMSKW+1), INTENT(INOUT) :: ISKWP_L
143 TYPE(PLIST_SKEW_), DIMENSION(NUMSKW+1), INTENT(IN) :: MULTIPLE_SKEW
144
145
146 integer, dimension(*) :: NSKWP
147C-----------------------------------------------
148C L o c a l V a r i a b l e s
149C-----------------------------------------------
150 INTEGER :: I,J,NN
151 INTEGER :: SIZE_SKEW,ISKEW
152C-----------------------------------------------
153C S o u r c e L i n e s
154C-----------------------------------------------
155 nn = 0
156 DO i=1,numskw
157 size_skew = tag_skn(i+1)
158 IF(size_skew>1) THEN
159 iskew = 0
160 DO j=1,size_skew
161 IF(multiple_skew(i+1)%PLIST(j)==curr_proc) iskew = iskew + 1
162 ENDDO
163 IF(iskew>0) THEN
164 nn = nn + 1
165 iskwp_l( nn ) = i
166 ENDIF
167 ELSE
168 IF(abs(iskwp(i+1))==curr_proc) THEN
169 nn = nn + 1
170 iskwp_l( nn ) = i
171 ENDIF
172 ENDIF
173 ENDDO
174
175 j = 0
176 do i =1,numskw+1
177 if(abs(iskwp(i))==curr_proc) j = j + 1
178 enddo
179
180 if(j/=nn) then
181 print*,' '
182 print*,' *********************** '
183 print*,' CURR PROC=',curr_proc
184 DO i =1,nn
185 print*,iskwp_l( i)
186 enddo
187 print*,' '
188 do i =1,numskw
189 if(abs(iskwp(i+1))==curr_proc) print*,i+1
190 enddo
191 print*,' *********************** '
192 endif
193
194 IF(nn/=nskwp(curr_proc)) then
195 print*,curr_proc,'pb sur taille nskwp !',nn,nskwp(curr_proc)
196 endif
197
198
199 RETURN