OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25asse.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i25asse0 ../engine/source/interfaces/int25/i25asse.F
25!||--- called by ------------------------------------------------------
26!|| i25for3e ../engine/source/interfaces/int25/i25for3e.F
27!||--- uses -----------------------------------------------------
28!|| tri7box ../engine/share/modules/tri7box.F
29!||====================================================================
30 SUBROUTINE i25asse0(JLT ,CS_LOC,N1 ,N2 ,M1 ,
31 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
32 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
33 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
34 5 FY4 ,FZ4 ,A ,STIFN,STIF ,
35 6 NEDGE ,NIN ,JTASK,PENE ,IBM )
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE tri7box
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "assert.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER JLT, NEDGE, NIN,
52 + CS_LOC(*),
53 + N1(*),N2(*),M1(*),M2(*),JTASK, IBM(*)
54 my_real
55 . HS1(*),HS2(*),HM1(*),HM2(*),
56 . fx1(*),fy1(*),fz1(*),
57 . fx2(*),fy2(*),fz2(*),
58 . fx3(*),fy3(*),fz3(*),
59 . fx4(*),fy4(*),fz4(*),
60 . a(3,*), stifn(*), stif(*), pene(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I, J1,NODFI,ISHIFT
65C-----------------------------------------------
66C
67 NODFI = nlskyfie(nin)
68 ishift = nodfi*(jtask-1)
69C
70 DO i=1,jlt
71 IF(pene(i)==zero) cycle
72C
73 IF(ibm(i)>=0)THEN
74C Assembling twice the force if the other segment supporting the main edge
75C lies onto the same domain
76
77 fx1(i)=two*fx1(i)
78 fy1(i)=two*fy1(i)
79 fz1(i)=two*fz1(i)
80 fx2(i)=two*fx2(i)
81 fy2(i)=two*fy2(i)
82 fz2(i)=two*fz2(i)
83 fx3(i)=two*fx3(i)
84 fy3(i)=two*fy3(i)
85 fz3(i)=two*fz3(i)
86 fx4(i)=two*fx4(i)
87 fy4(i)=two*fy4(i)
88 fz4(i)=two*fz4(i)
89 stif(i)=two*stif(i)
90 END IF
91 END DO
92C
93 DO i=1,jlt
94 IF(pene(i)==zero) cycle
95C
96 IF(cs_loc(i)<=nedge) THEN
97 j1=n1(i)
98 a(1,j1)=a(1,j1)+fx1(i)
99 a(2,j1)=a(2,j1)+fy1(i)
100 a(3,j1)=a(3,j1)+fz1(i)
101 stifn(j1) = stifn(j1) + stif(i)*abs(hs1(i))
102C
103 j1=n2(i)
104 a(1,j1)=a(1,j1)+fx2(i)
105 a(2,j1)=a(2,j1)+fy2(i)
106 a(3,j1)=a(3,j1)+fz2(i)
107 stifn(j1) = stifn(j1) + stif(i)*abs(hs2(i))
108 ELSE
109 j1=n1(i)
110 afie(nin)%P(1,j1+ishift)=afie(nin)%P(1,j1+ishift)+fx1(i)
111 afie(nin)%P(2,j1+ishift)=afie(nin)%P(2,j1+ishift)+fy1(i)
112 afie(nin)%P(3,j1+ishift)=afie(nin)%P(3,j1+ishift)+fz1(i)
113 stnfie(nin)%P(j1+ishift) = two*stnfie(nin)%P(j1+ishift) + stif(i)*abs(hs1(i))
114C
115 j1=n2(i)
116 afie(nin)%P(1,j1+ishift)=afie(nin)%P(1,j1+ishift)+fx2(i)
117 afie(nin)%P(2,j1+ishift)=afie(nin)%P(2,j1+ishift)+fy2(i)
118 afie(nin)%P(3,j1+ishift)=afie(nin)%P(3,j1+ishift)+fz2(i)
119 stnfie(nin)%P(j1+ishift) = two*stnfie(nin)%P(j1+ishift) + stif(i)*abs(hs2(i))
120 END IF
121 END DO
122C
123 DO i=1,jlt
124 IF(pene(i)==zero) cycle
125C
126 j1=m1(i)
127 a(1,j1)=a(1,j1)+fx3(i)
128 a(2,j1)=a(2,j1)+fy3(i)
129 a(3,j1)=a(3,j1)+fz3(i)
130 stifn(j1) = stifn(j1) + stif(i)*abs(hm1(i))
131C
132 j1=m2(i)
133 a(1,j1)=a(1,j1)+fx4(i)
134 a(2,j1)=a(2,j1)+fy4(i)
135 a(3,j1)=a(3,j1)+fz4(i)
136 stifn(j1) = stifn(j1) + stif(i)*abs(hm2(i))
137 ENDDO
138C
139 RETURN
140 END
141C
142!||====================================================================
143!|| i25asse05 ../engine/source/interfaces/int25/i25asse.F
144!||--- called by ------------------------------------------------------
145!|| i25for3e ../engine/source/interfaces/int25/i25for3e.F
146!||--- uses -----------------------------------------------------
147!|| tri7box ../engine/share/modules/tri7box.F
148!||====================================================================
149 SUBROUTINE i25asse05(JLT ,CS_LOC ,N1 ,N2 ,M1 ,
150 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
151 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
152 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
153 5 FY4 ,FZ4 ,A ,STIFN,NEDGE ,
154 6 K1 ,K2 ,K3 ,K4 ,C1 ,
155 7 C2 ,C3 ,C4 ,VISCN,NIN ,
156 8 JTASK,PENE ,IBM )
157C-----------------------------------------------
158C M o d u l e s
159C-----------------------------------------------
160 USE tri7box
161C-----------------------------------------------
162C I m p l i c i t T y p e s
163C-----------------------------------------------
164#include "implicit_f.inc"
165C-----------------------------------------------
166C D u m m y A r g u m e n t s
167C-----------------------------------------------
168 INTEGER JLT, NEDGE, NIN,
169 + CS_LOC(*),
170 + N1(*),N2(*),M1(*),M2(*),JTASK, IBM(*)
171 my_real
172 . hs1(*),hs2(*),hm1(*),hm2(*),
173 . fx1(*),fy1(*),fz1(*),
174 . fx2(*),fy2(*),fz2(*),
175 . fx3(*),fy3(*),fz3(*),
176 . fx4(*),fy4(*),fz4(*),
177 . k1(*),k2(*),k3(*),k4(*),
178 . c1(*),c2(*),c3(*),c4(*),
179 . a(3,*), stifn(*), viscn(*), pene(*)
180C-----------------------------------------------
181C L o c a l V a r i a b l e s
182C-----------------------------------------------
183 INTEGER I, J1,NODFI,ISHIFT
184C-----------------------------------------------
185C
186 NODFI = nlskyfie(nin)
187 ishift = nodfi*(jtask-1)
188C
189 DO i=1,jlt
190 IF(pene(i)==zero) cycle
191C
192 IF(ibm(i)>=0)THEN
193C Assembling twice the force if the other segment supporting the main edge
194C lies onto the same domain
195 fx1(i)=two*fx1(i)
196 fy1(i)=two*fy1(i)
197 fz1(i)=two*fz1(i)
198 fx2(i)=two*fx2(i)
199 fy2(i)=two*fy2(i)
200 fz2(i)=two*fz2(i)
201 fx3(i)=two*fx3(i)
202 fy3(i)=two*fy3(i)
203 fz3(i)=two*fz3(i)
204 fx4(i)=two*fx4(i)
205 fy4(i)=two*fy4(i)
206 fz4(i)=two*fz4(i)
207 k1(i) =two*k1(i)
208 k2(i) =two*k2(i)
209 k3(i) =two*k3(i)
210 k4(i) =two*k4(i)
211 c1(i) =two*c1(i)
212 c2(i) =two*c2(i)
213 c3(i) =two*c3(i)
214 c4(i) =two*c4(i)
215 END IF
216 END DO
217C
218 DO i=1,jlt
219 IF(pene(i)==zero) cycle
220C
221 IF(cs_loc(i)<=nedge) THEN
222 j1=n1(i)
223 a(1,j1)=a(1,j1)+fx1(i)
224 a(2,j1)=a(2,j1)+fy1(i)
225 a(3,j1)=a(3,j1)+fz1(i)
226 stifn(j1)=stifn(j1)+k1(i)
227 viscn(j1)=viscn(j1)+c1(i)
228C
229 j1=n2(i)
230 a(1,j1)=a(1,j1)+fx2(i)
231 a(2,j1)=a(2,j1)+fy2(i)
232 a(3,j1)=a(3,j1)+fz2(i)
233 stifn(j1)=stifn(j1)+k2(i)
234 viscn(j1)=viscn(j1)+c2(i)
235 ELSE
236 j1=n1(i)
237 afie(nin)%P(1,j1+ishift)=afie(nin)%P(1,j1+ishift)+fx1(i)
238 afie(nin)%P(2,j1+ishift)=afie(nin)%P(2,j1+ishift)+fy1(i)
239 afie(nin)%P(3,j1+ishift)=afie(nin)%P(3,j1+ishift)+fz1(i)
240 stnfie(nin)%P(j1+ishift)=stnfie(nin)%P(j1+ishift)+k1(i)
241 vscfie(nin)%P(j1+ishift)=vscfie(nin)%P(j1+ishift)+c1(i)
242C
243 j1=n2(i)
244 afie(nin)%P(1,j1+ishift)=afie(nin)%P(1,j1+ishift)+fx2(i)
245 afie(nin)%P(2,j1+ishift)=afie(nin)%P(2,j1+ishift)+fy2(i)
246 afie(nin)%P(3,j1+ishift)=afie(nin)%P(3,j1+ishift)+fz2(i)
247 stnfie(nin)%P(j1+ishift)=stnfie(nin)%P(j1+ishift)+k2(i)
248 vscfie(nin)%P(j1+ishift)=vscfie(nin)%P(j1+ishift)+c2(i)
249 END IF
250 END DO
251C
252 DO i=1,jlt
253 IF(pene(i)==zero) cycle
254C
255 j1=m1(i)
256 a(1,j1)=a(1,j1)+fx3(i)
257 a(2,j1)=a(2,j1)+fy3(i)
258 a(3,j1)=a(3,j1)+fz3(i)
259 stifn(j1)=stifn(j1)+k3(i)
260 viscn(j1)=viscn(j1)+c3(i)
261C
262 j1=m2(i)
263 a(1,j1)=a(1,j1)+fx4(i)
264 a(2,j1)=a(2,j1)+fy4(i)
265 a(3,j1)=a(3,j1)+fz4(i)
266 stifn(j1)=stifn(j1)+k4(i)
267 viscn(j1)=viscn(j1)+c4(i)
268 ENDDO
269C
270 RETURN
271 END
272C
273!||====================================================================
274!|| i25asse2 ../engine/source/interfaces/int25/i25asse.F
275!||--- called by ------------------------------------------------------
276!|| i25for3e ../engine/source/interfaces/int25/i25for3e.F
277!||--- calls -----------------------------------------------------
278!|| ancmsg ../engine/source/output/message/message.F
279!|| arret ../engine/source/system/arret.F
280!||--- uses -----------------------------------------------------
281!|| message_mod ../engine/share/message_module/message_mod.F
282!|| tri25ebox ../engine/share/modules/tri25ebox.F
283!|| tri7box ../engine/share/modules/tri7box.F
284!||====================================================================
285 SUBROUTINE i25asse2(JLT ,CS_LOC ,N1 ,N2 ,M1 ,
286 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
287 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
288 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
289 5 FY4 ,FZ4 ,FSKYI ,ISKY ,NISKYFIE,
290 6 STIF ,NEDGE ,NIN ,NOINT ,PENE ,
291 7 IBM ,EDGE_ID,TAGIP)
292C-----------------------------------------------
293C M o d u l e s
294C-----------------------------------------------
295 USE tri7box
296 USE tri25ebox
297 USE message_mod
298C-----------------------------------------------
299C I m p l i c i t T y p e s
300C-----------------------------------------------
301#include "implicit_f.inc"
302#include "comlock.inc"
303C-----------------------------------------------
304C G l o b a l P a r a m e t e r s
305C-----------------------------------------------
306#include "mvsiz_p.inc"
307C-----------------------------------------------
308C C o m m o n B l o c k s
309C-----------------------------------------------
310#include "parit_c.inc"
311C-----------------------------------------------
312C D u m m y A r g u m e n t s
313C-----------------------------------------------
314 INTEGER JLT, NEDGE,NISKYFIE,NIN,NOINT,
315 + cs_loc(*),isky(*),
316 + n1(*),n2(*),m1(*),m2(*),ibm(*)
317 my_real
318 . hs1(*),hs2(*),hm1(*),hm2(*),
319 . fx1(*),fy1(*),fz1(*),
320 . fx2(*),fy2(*),fz2(*),
321 . fx3(*),fy3(*),fz3(*),
322 . fx4(*),fy4(*),fz4(*),
323 . fskyi(lskyi,nfskyi), stif(*), pene(*)
324 INTEGER :: EDGE_ID(2,MVSIZ)
325 INTEGER , INTENT(IN) :: TAGIP(MVSIZ)
326C-----------------------------------------------
327C L o c a l V a r i a b l e s
328C-----------------------------------------------
329 INTEGER I, J1, NISKYL1, NISKYL,IGP,IGM, NISKYFIEL
330C WRITE(6,*) __FILE__,"[IN] I25ASS2"
331C
332 niskyl1 = 0
333 DO i = 1, jlt
334 IF (pene(i)==zero.AND.tagip(i)==0) cycle
335 IF (hm1(i)/=zero.OR.tagip(i)==1) niskyl1 = niskyl1 + 1
336 IF (hm2(i)/=zero.OR.tagip(i)==1) niskyl1 = niskyl1 + 1
337 IF ((hm1(i)/=zero.OR.tagip(i)==1).AND.ibm(i)>=0) niskyl1 = niskyl1 + 1
338 IF ((hm2(i)/=zero.OR.tagip(i)==1).AND.ibm(i)>=0) niskyl1 = niskyl1 + 1
339 ENDDO
340
341 igp = 0
342 igm = 0
343
344 DO i=1,jlt
345 IF(pene(i)==zero.AND.tagip(i)==0) cycle
346 IF(cs_loc(i)<=nedge) THEN
347 igp = igp+2
348 IF(ibm(i)>=0) igp=igp+2
349 ELSE
350 igm = igm+1
351 IF(ibm(i)>=0) igm=igm+1
352
353 ENDIF
354 ENDDO
355
356#include "lockon.inc"
357 niskyl = nisky
358 nisky = nisky + niskyl1 + igp
359 niskyfiel = niskyfie
360 niskyfie = niskyfie + igm
361#include "lockoff.inc"
362C WRITE(6,*) "Force remote=",IGM,"/",NISKYFIEL
363
364
365 IF (niskyl+niskyl1+igp > lskyi) THEN
366 CALL ancmsg(msgid=26,anmode=aninfo)
367 CALL arret(2)
368 ENDIF
369 IF (niskyfiel+igm > nlskyfie(nin)) THEN
370 CALL ancmsg(msgid=26,anmode=aninfo)
371 CALL arret(2)
372 ENDIF
373C
374 DO i=1,jlt
375
376
377 IF(pene(i)==zero.AND.tagip(i)==0) cycle
378C
379
380 IF(cs_loc(i)<=nedge) THEN
381 niskyl = niskyl + 1
382 fskyi(niskyl,1)=fx1(i)
383 fskyi(niskyl,2)=fy1(i)
384 fskyi(niskyl,3)=fz1(i)
385 fskyi(niskyl,4)=stif(i)*abs(hs1(i))
386
387 isky(niskyl) = n1(i)
388C
389 niskyl = niskyl + 1
390 fskyi(niskyl,1)=fx2(i)
391 fskyi(niskyl,2)=fy2(i)
392 fskyi(niskyl,3)=fz2(i)
393 fskyi(niskyl,4)=stif(i)*abs(hs2(i))
394 isky(niskyl) = n2(i)
395
396#ifdef WITH_ASSERT
397 WRITE(6,"(2I20,X,A,6Z20)") edge_id(1,i),edge_id(2,i),"A",fx1(i),fy1(i),fz1(i),fx2(i),fy2(i),fz2(i)
398#endif
399
400 IF(ibm(i)>=0)THEN
401 niskyl = niskyl + 1
402 fskyi(niskyl,1)=fx1(i)
403 fskyi(niskyl,2)=fy1(i)
404 fskyi(niskyl,3)=fz1(i)
405 fskyi(niskyl,4)=stif(i)*abs(hs1(i))
406 isky(niskyl) = n1(i)
407C
408 niskyl = niskyl + 1
409 fskyi(niskyl,1)=fx2(i)
410 fskyi(niskyl,2)=fy2(i)
411 fskyi(niskyl,3)=fz2(i)
412 fskyi(niskyl,4)=stif(i)*abs(hs2(i))
413 isky(niskyl) = n2(i)
414
415 END IF
416 ELSE ! REMOTE
417 niskyfiel = niskyfiel + 1
418 fskyfie(nin)%P(1,niskyfiel)=fx1(i)
419 fskyfie(nin)%P(2,niskyfiel)=fy1(i)
420 fskyfie(nin)%P(3,niskyfiel)=fz1(i)
421 fskyfie(nin)%P(4,niskyfiel)=stif(i)*abs(hs1(i))
422 fskyfie(nin)%P(5,niskyfiel)=fx2(i)
423 fskyfie(nin)%P(6,niskyfiel)=fy2(i)
424 fskyfie(nin)%P(7,niskyfiel)=fz2(i)
425 fskyfie(nin)%P(8,niskyfiel)=stif(i)*abs(hs2(i))
426
427#ifdef WITH_ASSERT
428 WRITE(6,"(2I20,X,A,6Z20)") edge_id(1,i),edge_id(2,i),"A",fx1(i),fy1(i),fz1(i),fx2(i),fy2(i),fz2(i)
429#endif
430
431 assert(cs_loc(i)-nedge > 0)
432 iskyfie(nin)%P(niskyfiel) = cs_loc(i)-nedge
433
434
435 IF(ibm(i)>=0)THEN
436 niskyfiel = niskyfiel + 1
437 fskyfie(nin)%P(1,niskyfiel)=fx1(i)
438 fskyfie(nin)%P(2,niskyfiel)=fy1(i)
439 fskyfie(nin)%P(3,niskyfiel)=fz1(i)
440 fskyfie(nin)%P(4,niskyfiel)=stif(i)*abs(hs1(i))
441 fskyfie(nin)%P(5,niskyfiel)=fx2(i)
442 fskyfie(nin)%P(6,niskyfiel)=fy2(i)
443 fskyfie(nin)%P(7,niskyfiel)=fz2(i)
444 fskyfie(nin)%P(8,niskyfiel)=stif(i)*abs(hs2(i))
445 assert(cs_loc(i)-nedge > 0)
446 iskyfie(nin)%P(niskyfiel) = cs_loc(i)-nedge
447 END IF
448 END IF
449 END DO
450C WRITE(6,*) __FILE__,"[OUT] I25ASS2",NISKYFIEL
451
452C
453 DO i=1,jlt
454 IF(pene(i)==zero.AND.tagip(i)==0) cycle
455C
456 IF (hm1(i)/=zero.OR.tagip(i)==1) THEN
457 niskyl = niskyl + 1
458 fskyi(niskyl,1)=fx3(i)
459 fskyi(niskyl,2)=fy3(i)
460 fskyi(niskyl,3)=fz3(i)
461 fskyi(niskyl,4)=stif(i)*abs(hm1(i))
462 isky(niskyl) = m1(i)
463 ENDIF
464C
465 IF ((hm1(i)/=zero.OR.tagip(i)==1).AND.ibm(i)>=0) THEN
466 niskyl = niskyl + 1
467 fskyi(niskyl,1)=fx3(i)
468 fskyi(niskyl,2)=fy3(i)
469 fskyi(niskyl,3)=fz3(i)
470 fskyi(niskyl,4)=stif(i)*abs(hm1(i))
471 isky(niskyl) = m1(i)
472 ENDIF
473 ENDDO
474 DO i=1,jlt
475 IF(pene(i)==zero.AND.tagip(i)==0) cycle
476C
477 IF (hm2(i)/=zero.OR.tagip(i)==1) THEN
478 niskyl = niskyl + 1
479 fskyi(niskyl,1)=fx4(i)
480 fskyi(niskyl,2)=fy4(i)
481 fskyi(niskyl,3)=fz4(i)
482 fskyi(niskyl,4)=stif(i)*abs(hm2(i))
483 isky(niskyl) = m2(i)
484 ENDIF
485C
486 IF ((hm2(i)/=zero.OR.tagip(i)==1).AND.ibm(i)>=0) THEN
487 niskyl = niskyl + 1
488 fskyi(niskyl,1)=fx4(i)
489 fskyi(niskyl,2)=fy4(i)
490 fskyi(niskyl,3)=fz4(i)
491 fskyi(niskyl,4)=stif(i)*abs(hm2(i))
492 isky(niskyl) = m2(i)
493 ENDIF
494 ENDDO
495
496
497C
498 RETURN
499 END
500C
501!||====================================================================
502!|| i25asse25 ../engine/source/interfaces/int25/i25asse.F
503!||--- called by ------------------------------------------------------
504!|| i25for3e ../engine/source/interfaces/int25/i25for3e.F
505!||--- calls -----------------------------------------------------
506!|| ancmsg ../engine/source/output/message/message.F
507!|| arret ../engine/source/system/arret.F
508!||--- uses -----------------------------------------------------
509!|| message_mod ../engine/share/message_module/message_mod.F
510!|| tri7box ../engine/share/modules/tri7box.F
511!||====================================================================
512 SUBROUTINE i25asse25(JLT ,CS_LOC ,N1 ,N2 ,M1 ,
513 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
514 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
515 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
516 5 FY4 ,FZ4 ,ISKY ,NISKYFIE,NEDGE ,
517 6 K1 ,K2 ,K3 ,K4 ,C1 ,
518 7 C2 ,C3 ,C4 ,NIN ,NOINT ,
519 8 PENE ,IBM ,TAGIP )
520C-----------------------------------------------
521C M o d u l e s
522C-----------------------------------------------
523 USE tri7box
524 USE message_mod
525C-----------------------------------------------
526C I m p l i c i t T y p e s
527C-----------------------------------------------
528#include "implicit_f.inc"
529#include "comlock.inc"
530C-----------------------------------------------
531C G l o b a l P a r a m e t e r s
532C-----------------------------------------------
533#include "mvsiz_p.inc"
534C-----------------------------------------------
535C C o m m o n B l o c k s
536C-----------------------------------------------
537#include "parit_c.inc"
538C-----------------------------------------------
539C D u m m y A r g u m e n t s
540C-----------------------------------------------
541 INTEGER JLT, NEDGE,NISKYFIE,NIN,NOINT,
542 + CS_LOC(*),ISKY(*),
543 + N1(*),N2(*),M1(*),M2(*),IBM(*)
544 INTEGER , INTENT(IN) :: TAGIP(MVSIZ)
545 my_real
546 . HS1(*),HS2(*),HM1(*),HM2(*),
547 . FX1(*),FY1(*),FZ1(*),
548 . fx2(*),fy2(*),fz2(*),
549 . fx3(*),fy3(*),fz3(*),
550 . fx4(*),fy4(*),fz4(*),
551 . k1(*),k2(*),k3(*),k4(*),
552 . c1(*),c2(*),c3(*),c4(*),
553 . fskyi(lskyi,nfskyi), pene(*)
554C-----------------------------------------------
555C L o c a l V a r i a b l e s
556C-----------------------------------------------
557 INTEGER I, J1, NISKYL1, NISKYL,IGP,IGM, NISKYFIEL
558C
559 NISKYL1 = 0
560 do i = 1, jlt
561 IF(pene(i)==zero.AND.tagip(i)==0) cycle
562 IF (hm1(i)/=zero.OR.tagip(i)==1) niskyl1 = niskyl1 + 1
563 IF (hm2(i)/=zero.OR.tagip(i)==1) niskyl1 = niskyl1 + 1
564 IF ((hm1(i)/=zero.OR.tagip(i)==1).AND.ibm(i)>=0) niskyl1 = niskyl1 + 1
565 IF ((hm2(i)/=zero.OR.tagip(i)==1).AND.ibm(i)>=0) niskyl1 = niskyl1 + 1
566 ENDDO
567
568 igp = 0
569 igm = 0
570 DO i=1,jlt
571 IF(cs_loc(i)<=nedge) THEN
572 igp = igp+2 !4
573 ELSE
574 igm = igm+1 !2
575 ENDIF
576 ENDDO
577
578#include "lockon.inc"
579 niskyl = nisky
580 nisky = nisky + niskyl1 + igp
581 niskyfiel = niskyfie
582 niskyfie = niskyfie + igm
583#include "lockoff.inc"
584C
585 IF (niskyl+niskyl1+igp > lskyi) THEN
586 CALL ancmsg(msgid=26,anmode=aninfo)
587 CALL arret(2)
588 ENDIF
589 IF (niskyfiel+igm > nlskyfie(nin)) THEN
590 CALL ancmsg(msgid=26,anmode=aninfo)
591 CALL arret(2)
592 ENDIF
593C
594 DO i=1,jlt
595 IF(pene(i)==zero.AND.tagip(i)==0) cycle
596C
597 IF(cs_loc(i)<=nedge) THEN
598 niskyl = niskyl + 1
599 fskyi(niskyl,1)=fx1(i)
600 fskyi(niskyl,2)=fy1(i)
601 fskyi(niskyl,3)=fz1(i)
602 fskyi(niskyl,4)=k1(i)
603 fskyi(niskyl,5)=c1(i)
604 isky(niskyl) = n1(i)
605C
606 niskyl = niskyl + 1
607 fskyi(niskyl,1)=fx2(i)
608 fskyi(niskyl,2)=fy2(i)
609 fskyi(niskyl,3)=fz2(i)
610 fskyi(niskyl,4)=k2(i)
611 fskyi(niskyl,5)=c2(i)
612 isky(niskyl) = n2(i)
613 IF(ibm(i)>=0)THEN
614 niskyl = niskyl + 1
615 fskyi(niskyl,1)=fx1(i)
616 fskyi(niskyl,2)=fy1(i)
617 fskyi(niskyl,3)=fz1(i)
618 fskyi(niskyl,4)=k1(i)
619 fskyi(niskyl,5)=c1(i)
620 isky(niskyl) = n1(i)
621C
622 niskyl = niskyl + 1
623 fskyi(niskyl,1)=fx2(i)
624 fskyi(niskyl,2)=fy2(i)
625 fskyi(niskyl,3)=fz2(i)
626 fskyi(niskyl,4)=k2(i)
627 fskyi(niskyl,5)=c2(i)
628 isky(niskyl) = n2(i)
629 END IF
630 ELSE
631 niskyfiel = niskyfiel + 1
632 fskyfie(nin)%P(1,niskyfiel)=fx1(i)
633 fskyfie(nin)%P(2,niskyfiel)=fy1(i)
634 fskyfie(nin)%P(3,niskyfiel)=fz1(i)
635 fskyfie(nin)%P(4,niskyfiel)=k1(i)
636 fskyfie(nin)%P(5,niskyfiel)=c1(i)
637 fskyfie(nin)%P(6,niskyfiel)=fx2(i)
638 fskyfie(nin)%P(7,niskyfiel)=fy2(i)
639 fskyfie(nin)%P(8,niskyfiel)=fz2(i)
640 fskyfie(nin)%P(9,niskyfiel)=k2(i)
641 fskyfie(nin)%P(10,niskyfiel)=c2(i)
642 iskyfie(nin)%P(niskyfiel) = cs_loc(i)-nedge
643C WRITE(6,*) "ISKYFIE(",NISKYFIEL,")=",ISKYFIE(NIN)%P(NISKYFIEL),LOC(ISKYFIE(NIN)%P(NISKYFIEL))
644
645 assert(cs_loc(i)-nedge > 0)
646 IF(ibm(i)>=0)THEN
647 niskyfiel = niskyfiel + 1
648 fskyfie(nin)%P(1,niskyfiel)=fx1(i)
649 fskyfie(nin)%P(2,niskyfiel)=fy1(i)
650 fskyfie(nin)%P(3,niskyfiel)=fz1(i)
651 fskyfie(nin)%P(4,niskyfiel)=k1(i)
652 fskyfie(nin)%P(5,niskyfiel)=c1(i)
653 fskyfie(nin)%P(6,niskyfiel)=fx2(i)
654 fskyfie(nin)%P(7,niskyfiel)=fy2(i)
655 fskyfie(nin)%P(8,niskyfiel)=fz2(i)
656 fskyfie(nin)%P(9,niskyfiel)=k2(i)
657 fskyfie(nin)%P(10,niskyfiel)=c2(i)
658 iskyfie(nin)%P(niskyfiel) = cs_loc(i)-nedge
659C WRITE(6,*) "ISKYFIE(",NISKYFIEL,")=",ISKYFIE(NIN)%P(NISKYFIEL),LOC(ISKYFIE(NIN)%P(NISKYFIEL))
660 assert(cs_loc(i)-nedge > 0)
661 END IF
662 END IF
663 END DO
664C
665 DO i=1,jlt
666 IF(pene(i)==zero.AND.tagip(i)==0) cycle
667C
668 IF (hm1(i)/=zero.OR.tagip(i)==1) THEN
669 niskyl = niskyl + 1
670 fskyi(niskyl,1)=fx3(i)
671 fskyi(niskyl,2)=fy3(i)
672 fskyi(niskyl,3)=fz3(i)
673 fskyi(niskyl,4)=k3(i)
674 fskyi(niskyl,5)=c3(i)
675 isky(niskyl) = m1(i)
676 ENDIF
677C
678 IF ((hm1(i)/=zero.OR.tagip(i)==1).AND.ibm(i)>=0) THEN
679 niskyl = niskyl + 1
680 fskyi(niskyl,1)=fx3(i)
681 fskyi(niskyl,2)=fy3(i)
682 fskyi(niskyl,3)=fz3(i)
683 fskyi(niskyl,4)=k3(i)
684 fskyi(niskyl,5)=c3(i)
685 isky(niskyl) = m1(i)
686 ENDIF
687 ENDDO
688 DO i=1,jlt
689 IF(pene(i)==zero.AND.tagip(i)==0) cycle
690C
691 IF (hm2(i)/=zero.OR.tagip(i)==1) THEN
692 niskyl = niskyl + 1
693 fskyi(niskyl,1)=fx4(i)
694 fskyi(niskyl,2)=fy4(i)
695 fskyi(niskyl,3)=fz4(i)
696 fskyi(niskyl,4)=k4(i)
697 fskyi(niskyl,5)=c4(i)
698 isky(niskyl) = m2(i)
699 ENDIF
700C
701 IF ((hm2(i)/=zero.OR.tagip(i)==1).AND.ibm(i)>=0) THEN
702 niskyl = niskyl + 1
703 fskyi(niskyl,1)=fx4(i)
704 fskyi(niskyl,2)=fy4(i)
705 fskyi(niskyl,3)=fz4(i)
706 fskyi(niskyl,4)=k4(i)
707 fskyi(niskyl,5)=c4(i)
708 isky(niskyl) = m2(i)
709 ENDIF
710 ENDDO
711C
712 RETURN
713 END
my_real
#define my_real
Definition cppsort.cpp:32
i25asse05
subroutine i25asse05(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, a, stifn, nedge, k1, k2, k3, k4, c1, c2, c3, c4, viscn, nin, jtask, pene, ibm)
Definition i25asse.F:157
i25asse2
subroutine i25asse2(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fskyi, isky, niskyfie, stif, nedge, nin, noint, pene, ibm, edge_id, tagip)
Definition i25asse.F:292
i25asse25
subroutine i25asse25(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, isky, niskyfie, nedge, k1, k2, k3, k4, c1, c2, c3, c4, nin, noint, pene, ibm, tagip)
Definition i25asse.F:520
i25asse0
subroutine i25asse0(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, a, stifn, stif, nedge, nin, jtask, pene, ibm)
Definition i25asse.F:36
message_mod
Definition message_mod.F:1249
tri7box::fskyfie
type(real_pointer2), dimension(:), allocatable fskyfie
Definition tri7box.F:459
tri7box::iskyfie
type(int_pointer), dimension(:), allocatable iskyfie
Definition tri7box.F:480
tri7box::stnfie
type(real_pointer), dimension(:), allocatable stnfie
Definition tri7box.F:449
tri7box::afie
type(real_pointer2), dimension(:), allocatable afie
Definition tri7box.F:459
tri7box::vscfie
type(real_pointer), dimension(:), allocatable vscfie
Definition tri7box.F:449
tri7box::nlskyfie
integer, dimension(:), allocatable nlskyfie
Definition tri7box.F:512
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