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

Go to the source code of this file.

Functions/Subroutines

subroutine create_ipartm1 (npart, ipart, ipartm1)
integer function part_usrtos (iu, ipartm1, npart)
integer function set_usrtos (iu, ipartm1, npart)
integer function set_usrtos_nearest (ui, map, sz, uplow)
subroutine print_ipartm1 (npart, ipartm1)

Function/Subroutine Documentation

◆ create_ipartm1()

subroutine create_ipartm1 ( integer, intent(in) npart,
integer, dimension(lipart1,npart), intent(in) ipart,
integer, dimension(npart,2), intent(inout) ipartm1 )

Definition at line 27 of file ipartm1.F.

28C-----------------------------------------------
29C I m p l i c i t T y p e s
30C-----------------------------------------------
31#include "implicit_f.inc"
32C-----------------------------------------------
33C C o m m o n B l o c k s
34C-----------------------------------------------
35#include "scr17_c.inc"
36C-----------------------------------------------
37C D u m m y A r g u m e n t s
38C-----------------------------------------------
39 INTEGER, INTENT(IN) :: NPART
40 INTEGER, INTENT(IN), DIMENSION(LIPART1,NPART) :: IPART
41 INTEGER, INTENT(INOUT),DIMENSION(NPART,2) :: IPARTM1
42C-----------------------------------------------
43C L o c a l V a r i a b l e s
44C-----------------------------------------------
45 INTEGER I
46 INTEGER, DIMENSION(:),ALLOCATABLE :: IPARTSORT
47 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX_SORT
48 INTEGER, DIMENSION(70000) :: IWORK
49C-----------------------------------------------
50 ALLOCATE(ipartsort(npart))
51 ALLOCATE(index_sort(2*npart))
52
53 DO i=1,npart
54 ipartsort(i)=ipart(4,i)
55 index_sort(i)=i
56 ENDDO
57 CALL my_orders(0,iwork,ipartsort,index_sort,npart,1)
58
59 DO i=1,npart
60 ipartm1(i,1)=ipartsort(index_sort(i))
61 ipartm1(i,2)=index_sort(i)
62 ENDDO
63
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82

◆ part_usrtos()

integer function part_usrtos ( integer iu,
integer, dimension(npart,2) ipartm1,
integer npart )

Definition at line 68 of file ipartm1.F.

69C IDENTIQUE A USR2SYS, SANS GENERER D'ERREUR
70C FONCTION DONNE N0 SYSTEME DU NOEUD USER IU
71C-----------------------------------------------
72C I m p l i c i t T y p e s
73C-----------------------------------------------
74#include "implicit_f.inc"
75C-----------------------------------------------
76C D u m m y A r g u m e n t s
77C-----------------------------------------------
78 INTEGER IU
79 INTEGER NPART
80 INTEGER IPARTM1(NPART,2)
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER JINF, JSUP, J,I
85 jinf=1
86 jsup=npart
87 j=max(1,npart/2)
88 10 IF(jsup<=jinf.AND.(iu-ipartm1(j,1))/=0) THEN
89C
90 part_usrtos=0
91 RETURN
92 ENDIF
93 IF((iu-ipartm1(j,1))==0)THEN
94C >CAS IU=TABM FIN DE LA RECHERCHE
95 part_usrtos=j
96 RETURN
97 ELSE IF (iu-ipartm1(j,1)<0) THEN
98C >CAS IU<TABM
99 jsup=j-1
100 ELSE
101C >CAS IU>TABM
102 jinf=j+1
103 ENDIF
104 j=(jsup+jinf)/2
105 GO TO 10
part_usrtos
integer function part_usrtos(iu, ipartm1, npart)
Definition ipartm1.F:69
max
#define max(a, b)
Definition macros.h:21

◆ print_ipartm1()

subroutine print_ipartm1 ( integer npart,
integer, dimension(npart,2) ipartm1 )

Definition at line 282 of file ipartm1.F.

283C-----------------------------------------------
284C I m p l i c i t T y p e s
285C-----------------------------------------------
286#include "implicit_f.inc"
287C-----------------------------------------------
288C D u m m y A r g u m e n t s
289C-----------------------------------------------
290 INTEGER NPART,I
291 INTEGER IPARTM1(NPART,2)
292 DO i=1,npart
293 print*,i,'IPART=',ipartm1(i,1),'--',ipartm1(i,2)
294 ENDDO

◆ set_usrtos()

integer function set_usrtos ( integer iu,
integer, dimension(npart,2) ipartm1,
integer npart )

Definition at line 127 of file ipartm1.F.

128C-----------------------------------------------
129C ROUTINE DESCRIPTION :
130C ===================
131C Dichotomy Over sorted array to obtain Local id from
132C Global ID
133C-----------------------------------------------
134C DUMMY ARGUMENTS DESCRIPTION:
135C ===================
136C
137C NAME DESCRIPTION
138C
139C UI, INTEGER : User ID
140C MAP(SZ,2) : UID,LOCAL ID Map
141C SZ : Size of Option
142C Returns : indice in ipartm1 to get nearest local ID
143C-----------------------------------------------
144C I m p l i c i t T y p e s
145C-----------------------------------------------
146#include "implicit_f.inc"
147C-----------------------------------------------
148C D u m m y A r g u m e n t s
149C-----------------------------------------------
150 INTEGER IU
151 INTEGER NPART
152 INTEGER IPARTM1(NPART,2)
153C-----------------------------------------------
154C L o c a l V a r i a b l e s
155C-----------------------------------------------
156 INTEGER JINF, JSUP, J,I
157 jinf=1
158 jsup=npart
159 j=max(1,npart/2)
160 10 IF(j == 0)THEN
161C
162 set_usrtos=0
163 RETURN
164 ELSEIF(jsup<=jinf.AND.(iu-ipartm1(j,1))/=0) THEN
165C
166 set_usrtos=0
167 RETURN
168 ENDIF
169 IF((iu-ipartm1(j,1))==0)THEN
170C >CAS IU=TABM FIN DE LA RECHERCHE
171 set_usrtos=j
172 RETURN
173 ELSE IF (iu-ipartm1(j,1)<0) THEN
174C >CAS IU<TABM
175 jsup=j-1
176 ELSE
177C >CAS IU>TABM
178 jinf=j+1
179 ENDIF
180 j=(jsup+jinf)/2
181 GO TO 10
set_usrtos
integer function set_usrtos(iu, ipartm1, npart)
Definition ipartm1.F:128

◆ set_usrtos_nearest()

integer function set_usrtos_nearest ( integer ui,
integer, dimension(sz,2) map,
integer sz,
integer uplow )

Definition at line 196 of file ipartm1.F.

197C-----------------------------------------------
198C ROUTINE DESCRIPTION :
199C ===================
200C Dichotomy Over sorted array to obtain Local id from
201C Global ID
202C-----------------------------------------------
203C DUMMY ARGUMENTS DESCRIPTION:
204C ===================
205C
206C NAME DESCRIPTION
207C
208C UI, INTEGER : User ID
209C MAP(SZ,2) : UID,LOCAL ID Map
210C SZ : Size of Option
211C UPLOW : 1 UP (take a majorant), 2 LOW (take a minorant)
212C Returns : indice in ipartm1 to get nearest local ID
213C
214C-----------------------------------------------
215C I m p l i c i t T y p e s
216C-----------------------------------------------
217#include "implicit_f.inc"
218C-----------------------------------------------
219C D u m m y A r g u m e n t s
220C-----------------------------------------------
221 INTEGER UI
222 INTEGER SZ, UPLOW
223 INTEGER MAP(SZ,2)
224C-----------------------------------------------
225C L o c a l V a r i a b l e s
226C-----------------------------------------------
227 INTEGER JINF, JSUP, J,I
228 jinf=1
229 jsup=sz
230
231 IF ( ui >= map(sz,1) ) THEN
232 set_usrtos_nearest = sz
233 RETURN
234 ENDIF
235
236 IF ( ui <= map(1,1) ) THEN
237 set_usrtos_nearest = 1
238 RETURN
239 ENDIF
240
241 j=max(1,sz/2)
242
243 10 IF(jsup<=jinf.AND.(ui-map(j,1))/=0) THEN
244C
245 set_usrtos_nearest=0
246 IF (uplow == 1) THEN
247
248 DO WHILE (map(jinf,1) < ui) ! FIRST Entity higher then UI
249 jinf=jinf+1
250 ENDDO
251 set_usrtos_nearest=jinf
252
253 ELSEIF (uplow == 2) THEN
254
255 DO WHILE (map(jsup,1) > ui) ! FIRST Entity lower then UI
256 jsup=jsup-1
257 ENDDO
258 set_usrtos_nearest=jsup
259
260 ENDIF
261 RETURN
262 ENDIF
263 IF((ui-map(j,1))==0)THEN
264C >CAS IU=TABM FIN DE LA RECHERCHE
265 set_usrtos_nearest=j
266 RETURN
267 ELSE IF (ui-map(j,1)<0) THEN
268C >CAS IU<TABM
269 jsup=j-1
270 ELSE
271C >CAS IU>TABM
272 jinf=j+1
273 ENDIF
274 j=(jsup+jinf)/2
275 GO TO 10
set_usrtos_nearest
integer function set_usrtos_nearest(ui, map, sz, uplow)
Definition ipartm1.F:197