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

Go to the source code of this file.

Functions/Subroutines

subroutine intcontp25e (n, isky, nsnfi, isizenv, nsnfitot, len)

Function/Subroutine Documentation

◆ intcontp25e()

subroutine intcontp25e ( integer n,
integer, dimension(*) isky,
integer, dimension(*) nsnfi,
integer, dimension(2,*) isizenv,
integer, dimension(*) nsnfitot,
integer len )

Definition at line 28 of file intcontp25e.F.

29C
30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C C o m m o n B l o c k s
36C-----------------------------------------------
37#include "com01_c.inc"
38#include "assert.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 INTEGER N, LEN,
43 . NSNFI(*), ISKY(*), ISIZENV(2,*), NSNFITOT(*)
44C-----------------------------------------------
45C L o c a l V a r i a b l e s
46C-----------------------------------------------
47 INTEGER IG, P, I, LASTIG
48 INTEGER LOCAL_ID
49 INTEGER NSNFI_TOT
50C-----------------------------------------------
51C S o u r c e L i n e s
52C-----------------------------------------------
53 nsnfi_tot = 0
54 DO p = 1,nspmd
55 nsnfi_tot = nsnfi(p) + nsnfi_tot
56 ENDDO
57 IF(n > 0) THEN
58 assert(nsnfi_tot > 0)
59 DO i = 1, n
60 p = 1
61 local_id = isky(i)
62 assert(isky(i) > 0)
63 assert(isky(i) <= nsnfi_tot)
64 DO WHILE( nsnfi(p) < local_id .AND. local_id > 0)
65 local_id = local_id - nsnfi(p)
66 p = p + 1
67 ENDDO
68 assert(p <= nspmd)
69 assert(local_id >= 0)
70 IF(p <= nspmd) THEN
71 isizenv(1,p) = isizenv(1,p) + len
72 isizenv(2,p) = isizenv(2,p) + 1
73 ELSE
74 assert(.false.)
75 ENDIF
76 ENDDO
77 ENDIF
78
79 DO p = 1, nspmd
80 nsnfitot(p) = nsnfitot(p) + nsnfi(p)
81 END DO
82C
83 RETURN