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

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_check_tag (nin, i_stok, intbuf_tab, tag, nsnr, nsn, nty, inacti, ifq, itied, nrts)

Function/Subroutine Documentation

◆ spmd_check_tag()

subroutine spmd_check_tag ( integer, intent(in) nin,
integer, intent(inout) i_stok,
type(intbuf_struct_) intbuf_tab,
integer, dimension(nsnr), intent(in) tag,
integer, intent(in) nsnr,
integer, intent(in) nsn,
integer, intent(in) nty,
integer, intent(in) inacti,
integer, intent(in) ifq,
integer, intent(in) itied,
integer, intent(in) nrts )

Definition at line 36 of file spmd_check_tag.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE restmod
42 USE intbufdef_mod
43 USE tri7box
44 USE message_mod
45C-------------------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52! ********************************************************
53! * variable * type * size * intent * feature
54! *------------*--------*--------*----------*-------------
55! * NIN * integ. * 1 * in * which interface
56! * NSNR * integ. * 1 * in * size of TAG
57! * NTY * integ. * 1 * in * kind of interface
58! * INACTI * integ. * 1 * in * INACTI option
59! * IFQ * integ. * 1 * in * IFQ option
60! * ITIED * integ. * 1 * in * ITIED option
61! * I_STOK * integ. * 1 * inout * number of cand_a/e
62! * TAG * integ. * NSNR * in * tag array
63! * INTBUF_TAB * struct.* * inout * interface pointer
64! * NRTS * integ. * 1 * in * useful for interface typ11
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER, INTENT(IN) :: NIN,NSNR,NSN,NTY,INACTI,IFQ,ITIED,NRTS
69 INTEGER, INTENT(INOUT) :: I_STOK
70 INTEGER, DIMENSION(NSNR), INTENT(IN) :: TAG
71
72 TYPE(INTBUF_STRUCT_) INTBUF_TAB
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER L,K,SIZE_LOC,IERROR,NI,NSN_LOC
77 INTEGER, DIMENSION(:), ALLOCATABLE :: CAND_N_LOC,CAND_E_LOC,IFPEN_LOC
78 my_real,
79 . DIMENSION(:), ALLOCATABLE :: cand_p_loc,cand_fx_loc,cand_fy_loc,cand_fz_loc,
80 . cand_f_loc
81! ----------------------------------------------
82! we check the value of tag array on each nin interface
83! and for each process
84! if NSVSI(NIN)P < 0 --> cand_n and cand_e are deleted
85! else cand_n and cand_e are kept
86 ierror = 0
87 l = 1
88 ! -----------------
89 IF(i_stok>0) THEN
90 ! -----------------
91 ALLOCATE( cand_n_loc( i_stok ) , stat=ierror)
92 IF(ierror/=0) THEN
93 CALL ancmsg(msgid=20,anmode=aninfo)
94 CALL arret(2)
95 ENDIF
96 cand_n_loc(1:i_stok) = 0
97 ! ---------
98 ALLOCATE( cand_e_loc( i_stok ) , stat=ierror)
99 IF(ierror/=0) THEN
100 CALL ancmsg(msgid=20,anmode=aninfo)
101 CALL arret(2)
102 ENDIF
103 cand_e_loc(1:i_stok) = 0
104 ! ---------
105 IF((nty==7.OR.nty==20).AND.(inacti==5.OR.inacti==6.OR.inacti==7)) THEN
106 ALLOCATE( cand_p_loc( i_stok ) , stat=ierror)
107 IF(ierror/=0) THEN
108 CALL ancmsg(msgid=20,anmode=aninfo)
109 CALL arret(2)
110 ENDIF
111 cand_p_loc(1:i_stok) = 0
112 ENDIF
113 ! ---------
114 IF((nty==7.OR.nty==20).AND.ifq>0) THEN
115 ALLOCATE( cand_fx_loc( i_stok ) , stat=ierror)
116 IF(ierror/=0) THEN
117 CALL ancmsg(msgid=20,anmode=aninfo)
118 CALL arret(2)
119 ENDIF
120 cand_fx_loc(1:i_stok) = 0
121 ! ---------
122 ALLOCATE( cand_fy_loc( i_stok ) , stat=ierror)
123 IF(ierror/=0) THEN
124 CALL ancmsg(msgid=20,anmode=aninfo)
125 CALL arret(2)
126 ENDIF
127 cand_fy_loc(1:i_stok) = 0
128 ! ---------
129 ALLOCATE( cand_fz_loc( i_stok ) , stat=ierror)
130 IF(ierror/=0) THEN
131 CALL ancmsg(msgid=20,anmode=aninfo)
132 CALL arret(2)
133 ENDIF
134 cand_fz_loc(1:i_stok) = 0
135 ! ---------
136 ALLOCATE( ifpen_loc( i_stok ) , stat=ierror)
137 IF(ierror/=0) THEN
138 CALL ancmsg(msgid=20,anmode=aninfo)
139 CALL arret(2)
140 ENDIF
141 ifpen_loc(1:i_stok) = 0
142 ! ---------
143 ENDIF
144 ! ---------
145 IF(nty==7.AND.itied/=0) THEN
146 ALLOCATE( cand_f_loc( 8*i_stok ) , stat=ierror)
147 IF(ierror/=0) THEN
148 CALL ancmsg(msgid=20,anmode=aninfo)
149 CALL arret(2)
150 ENDIF
151 cand_f_loc(1:8*i_stok) = 0
152 ENDIF
153 l = 1
154 IF(nty/=11) THEN
155 nsn_loc = nsn
156 ELSE
157 nsn_loc = nrts
158 ENDIF
159 DO k=1,i_stok
160 ni = intbuf_tab%CAND_N(k)
161 IF(ni > nsn_loc) THEN
162 ! Remote
163 ni = ni - nsn_loc
164 IF(tag(ni)>-1) THEN
165 cand_n_loc(l) = intbuf_tab%CAND_N(k)
166 cand_e_loc(l) = intbuf_tab%CAND_E(k)
167 IF(nty==24.OR.nty==25)THEN ! rien a faire (a TT=0)
168 ELSE
169 IF((nty==7.OR.nty==20).AND.(inacti==5.OR.inacti==6.OR.inacti==7))
170 . cand_p_loc(l) = intbuf_tab%CAND_P(k)
171 IF(ifq>0) THEN
172 ifpen_loc(l) = intbuf_tab%IFPEN(k)
173 IF(nty==20) THEN
174 cand_fx_loc(l) = intbuf_tab%CAND_FX(k)
175 cand_fy_loc(l) = intbuf_tab%CAND_FY(k)
176 cand_fz_loc(l) = intbuf_tab%CAND_FZ(k)
177 ELSEIF(nty==7) THEN
178 cand_fx_loc(l) = intbuf_tab%FTSAVX(k)
179 cand_fy_loc(l) = intbuf_tab%FTSAVY(k)
180 cand_fz_loc(l) = intbuf_tab%FTSAVZ(k)
181 ENDIF
182 ENDIF
183 IF(nty==7.AND.itied/=0)
184 . cand_f_loc(8*(l-1)+1:8*(l-1)+8) = intbuf_tab%CAND_F(8*(k-1)+1:8*(k-1)+8)
185 ENDIF
186 l = l + 1
187 ENDIF
188 ELSE
189 ! Local
190 cand_n_loc(l) = intbuf_tab%CAND_N(k)
191 cand_e_loc(l) = intbuf_tab%CAND_E(k)
192 IF(nty==24.OR.nty==25)THEN ! rien a faire (a TT=0)
193 ELSE
194 IF((nty==7.OR.nty==20).AND.(inacti==5.OR.inacti==6.OR.inacti==7))
195 . cand_p_loc(l) = intbuf_tab%CAND_P(k)
196 IF(ifq>0) THEN
197 ifpen_loc(l) = intbuf_tab%IFPEN(k)
198 IF(nty==20) THEN
199 cand_fx_loc(l) = intbuf_tab%CAND_FX(k)
200 cand_fy_loc(l) = intbuf_tab%CAND_FY(k)
201 cand_fz_loc(l) = intbuf_tab%CAND_FZ(k)
202 ELSEIF(nty==7) THEN
203 cand_fx_loc(l) = intbuf_tab%FTSAVX(k)
204 cand_fy_loc(l) = intbuf_tab%FTSAVY(k)
205 cand_fz_loc(l) = intbuf_tab%FTSAVZ(k)
206 ENDIF
207 ENDIF
208 IF(nty==7.AND.itied/=0)
209 . cand_f_loc(8*(l-1)+1:8*(l-1)+8) = intbuf_tab%CAND_F(8*(k-1)+1:8*(k-1)+8)
210 ENDIF
211 l = l + 1
212 ENDIF
213 ENDDO
214 intbuf_tab%CAND_N(1:i_stok) = 0
215 intbuf_tab%CAND_E(1:i_stok) = 0
216 IF(nty==24.OR.nty==25)THEN ! rien a faire (a TT=0)
217 ELSE
218 IF((nty==7.OR.nty==20).AND.(inacti==5.OR.inacti==6.OR.inacti==7))
219 . intbuf_tab%CAND_P(1:i_stok) = 0
220 IF(ifq>0) THEN
221 intbuf_tab%IFPEN(1:i_stok) = 0
222 IF(nty==20) THEN
223 intbuf_tab%CAND_FX(1:i_stok) = 0
224 intbuf_tab%CAND_FY(1:i_stok) = 0
225 intbuf_tab%CAND_FZ(1:i_stok) = 0
226 ELSEIF(nty==7) THEN
227 intbuf_tab%FTSAVX(1:i_stok) = 0
228 intbuf_tab%FTSAVY(1:i_stok) = 0
229 intbuf_tab%FTSAVZ(1:i_stok) = 0
230 ENDIF
231 ENDIF
232 IF(nty==7.AND.itied/=0)
233 . intbuf_tab%CAND_F(1:8*i_stok) = zero
234 ENDIF
235 i_stok = l - 1
236 IF(i_stok>0) THEN
237 intbuf_tab%CAND_N(1:i_stok) = cand_n_loc(1:i_stok)
238 intbuf_tab%CAND_E(1:i_stok) = cand_e_loc(1:i_stok)
239 IF(nty==24.OR.nty==25)THEN ! rien a faire
240 ELSE
241 IF((nty==7.OR.nty==20).AND.(inacti==5.OR.inacti==6.OR.inacti==7))
242 . intbuf_tab%CAND_P(1:i_stok) = cand_p_loc(1:i_stok)
243 IF(ifq>0) THEN
244 intbuf_tab%IFPEN(1:i_stok) = ifpen_loc(1:i_stok)
245 IF(nty==20) THEN
246 intbuf_tab%CAND_FX(1:i_stok) = cand_fx_loc(1:i_stok)
247 intbuf_tab%CAND_FY(1:i_stok) = cand_fy_loc(1:i_stok)
248 intbuf_tab%CAND_FZ(1:i_stok) = cand_fz_loc(1:i_stok)
249 ELSEIF(nty==7) THEN
250 intbuf_tab%FTSAVX(1:i_stok) = cand_fx_loc(1:i_stok)
251 intbuf_tab%FTSAVY(1:i_stok) = cand_fy_loc(1:i_stok)
252 intbuf_tab%FTSAVZ(1:i_stok) = cand_fz_loc(1:i_stok)
253 ENDIF
254 ENDIF
255 IF(nty==7.AND.itied/=0)
256 . intbuf_tab%CAND_F(1:8*i_stok) = cand_f_loc(1:8*i_stok)
257 ENDIF
258 ENDIF
259 DEALLOCATE( cand_n_loc )
260 DEALLOCATE( cand_e_loc )
261 IF(nty==24.OR.nty==25)THEN ! rien a faire
262 ELSE
263 IF((nty==7.OR.nty==20).AND.(inacti==5.OR.inacti==6.OR.inacti==7))
264 . DEALLOCATE( cand_p_loc )
265 IF(ifq>0) THEN
266 DEALLOCATE( cand_fx_loc )
267 DEALLOCATE( cand_fy_loc )
268 DEALLOCATE( cand_fz_loc )
269 DEALLOCATE( ifpen_loc )
270 ENDIF
271 IF(nty==7.AND.itied/=0)
272 . DEALLOCATE( cand_f_loc )
273 ENDIF
274 ! -----------------
275 ENDIF ! i_sotk > 0
276 ! -----------------
277 IF(ierror/=0) THEN
278 CALL arret(2)
279 ENDIF
280 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1249
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87