OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
upidmid.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!|| upidmid_dum ../engine/source/user_interface/upidmid.F
25!||--- called by ------------------------------------------------------
26!|| radioss2 ../engine/source/engine/radioss2.F
27!||--- calls -----------------------------------------------------
28!|| get_var_user_f ../engine/source/user_interface/eng_callback_c.c
29!|| get_var_user_f_sp ../engine/source/user_interface/eng_callback_c.c
30!|| get_var_user_i ../engine/source/user_interface/eng_callback_c.c
31!||====================================================================
32 SUBROUTINE upidmid_dum(IERR)
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C D u m m y A r g u m e n t s
39C-----------------------------------------------
40 INTEGER IERR
41C-----------------------------------------------
42C S o u r c e L i n e s
43C-----------------------------------------------
44 ierr=0
45 END
46 my_real FUNCTION
47 . get_u_mat(ivar,im)
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "param_c.inc"
56#include "units_c.inc"
57#include "scr05_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER,INTENT(IN) :: ivar,im
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER nvar,depla,iadbuf
66C-----------------------------------------------
67C S o u r c e L i n e s
68C-----------------------------------------------
69C NVAR = NUPARAM = NINT(PM(26,IM)) old
70C NVAR = NUPARAM = IPM(9,IM)
71C
72 depla= 9+(im-1)*npropmi
73 CALL get_var_user_i(19,depla,nvar)
74 IF(ivar==0)THEN
75C GET_U_MAT = PM(1,IM)
76 depla=1+(im-1)*npropm
77 IF (iresp==1) THEN
78 CALL get_var_user_f_sp(1,depla,get_u_mat)
79 ELSE
80 CALL get_var_user_f(1,depla,get_u_mat)
81 ENDIF
82 ELSEIF(ivar>nvar)THEN
83 WRITE(iout,*) ' **ERROR USER MATERIAL PARAMETER INDEX(',ivar,') EXCEED NUPARAM(',nvar,')'
84 WRITE(istdo,*)' **ERROR USER MATERIAL PARAMETER INDEX(',ivar,') EXCEED NUPARAM(',nvar,')'
85 ELSE
86C IADBUF = IPM(7,IM)
87C GET_U_MAT = BUFMAT(IADBUF-1+IVAR)
88 depla = 7+(im-1)*npropmi
89 CALL get_var_user_i(19,depla,iadbuf)
90 depla = iadbuf-1+ivar
91 IF (iresp==1) THEN
92 CALL get_var_user_f_sp(2,depla,get_u_mat)
93 ELSE
94 CALL get_var_user_f(2,depla,get_u_mat)
95 ENDIF
96 ENDIF
97C
98 RETURN
99 END
100C 029
101 my_real FUNCTION
102 . get_u_geo(ivar,ip)
103C-----------------------------------------------
104C I m p l i c i t T y p e s
105C-----------------------------------------------
106#include "implicit_f.inc"
107C-----------------------------------------------
108C C o m m o n B l o c k s
109C-----------------------------------------------
110#include "param_c.inc"
111#include "units_c.inc"
112#include "scr05_c.inc"
113C-----------------------------------------------
114C D u m m y A r g u m e n t
115C-----------------------------------------------
116 INTEGER,INTENT(IN) :: ivar,ip
117C-----------------------------------------------
118C L o c a l V a r i a b l e s
119C-----------------------------------------------
120 INTEGER nvar,depla
121 my_real nv
122C-----------------------------------------------
123C S o u r c e L i n e s
124C-----------------------------------------------
125C GEO(I,J) == LOCA(ISH3+I+(J-1)*NPROPG)
126C BUFGEO(I) == LOCA(ISH4+I)
127 depla=26+(ip-1)*npropg
128 IF (iresp == 1) THEN
129 CALL get_var_user_f_sp(3,depla,nv)
130 ELSE
131 CALL get_var_user_f(3,depla,nv)
132 ENDIF
133 nvar = nint(nv)
134C NVAR = NINT(GEO(26,IP))
135 IF(ivar>nvar)THEN
136 WRITE(iout,*) ' **ERROR USER PROPERTY PARAMETER INDEX(',ivar,') EXCEED NUPARAG(',nvar,')'
137 WRITE(istdo,*)' **ERROR USER PROPERTY PARAMETER INDEX(',ivar,') EXCEED NUPARAG(',nvar,')'
138 ELSE
139 depla=27+(ip-1)*npropg
140 IF (iresp == 1) THEN
141 CALL get_var_user_f_sp(3,depla,nv)
142 depla=nint(nv)-1+ivar
143 CALL get_var_user_f_sp(4,depla,get_u_geo)
144 ELSE
145 CALL get_var_user_f(3,depla,nv)
146 depla=nint(nv)-1+ivar
147 CALL get_var_user_f(4,depla,get_u_geo)
148 ENDIF
149C GET_U_GEO = BUFGEO(NINT(GEO(27,IP))-1+IVAR)
150 ENDIF
151C
152 RETURN
153 END
154
155!||====================================================================
156!|| get_u_pnu ../engine/source/user_interface/upidmid.F
157!||--- called by ------------------------------------------------------
158!|| ruser32 ../engine/source/elements/spring/ruser32.F
159!|| ruser33 ../engine/source/elements/joint/ruser33.F
160!|| ruser35 ../engine/source/elements/spring/ruser35.F
161!|| ruser36 ../engine/source/elements/spring/ruser36.F
162!|| ruser44 ../engine/source/elements/spring/ruser44.F
163!|| ruser46 ../engine/source/elements/spring/ruser46.F
164!|| xanim28 ../engine/source/elements/xelem/xanim28.F
165!|| xanim29 ../engine/source/output/anim/generate/xanim29.F
166!|| xanim30 ../engine/source/output/anim/generate/xanim30.F
167!|| xanim31 ../engine/source/output/anim/generate/xanim31.F
168!|| xforc28 ../engine/source/elements/xelem/xforc28.F
169!|| xforc29 ../engine/source/elements/xelem/xforc29.F
170!|| xforc30 ../engine/source/elements/xelem/xforc30.F
171!|| xforc31 ../engine/source/elements/xelem/xforc31.F
172!||--- calls -----------------------------------------------------
173!|| get_var_user_f ../engine/source/user_interface/eng_callback_c.c
174!|| get_var_user_f_sp ../engine/source/user_interface/eng_callback_c.c
175!||====================================================================
176 INTEGER FUNCTION get_u_pnu(IVAR,IP,K)
177C-----------------------------------------------
178C I m p l i c i t T y p e s
179C-----------------------------------------------
180#include "implicit_f.inc"
181C-----------------------------------------------
182C C o m m o n B l o c k s
183C-----------------------------------------------
184#include "param_c.inc"
185#include "units_c.inc"
186#include "scr05_c.inc"
187C-----------------------------------------------
188C D u m m y A r g u m e n t s
189C-----------------------------------------------
190 INTEGER,INTENT(IN) :: ivar,ip,k
191C-----------------------------------------------
192C L o c a l V a r i a b l e s
193C-----------------------------------------------
194 INTEGER depla,nvar
195 my_real nv
196C-----------------------------------------------
197C S o u r c e L i n e s
198C-----------------------------------------------
199C GEO(I,J) == LOCA(ISH3+I+(J-1)*NPROPG)
200C BUFGEO(I) == LOCA(ISH4+I)
201C
202 get_u_pnu = 0
203 depla=k-1+(ip-1)*npropg
204 IF (iresp==1) THEN
205 CALL get_var_user_f_sp(3,depla,nv)
206 ELSE
207 CALL get_var_user_f(3,depla,nv)
208 ENDIF
209 nvar=nint(nv)
210C NVAR = NINT(GEO(K-1,IP))
211 IF(ivar>nvar)THEN
212 WRITE(iout,*) ' **ERROR IN FUNCTION GET_U_PNU(INDEX,IP,GEO,BUFGEO,',k,'), INDEX(',ivar,') EXCEED ALLOCATED VALUE(',nvar,')'
213 WRITE(istdo,*)' **ERROR IN FUNCTION GET_U_PNU(INDEX,IP,GEO,BUFGEO,',k,'), INDEX(',ivar,') EXCEED ALLOCATED VALUE(',nvar,')'
214 ELSE
215 depla=k+(ip-1)*npropg
216 IF (iresp==1) THEN
217 CALL get_var_user_f_sp(3,depla,nv)
218 depla=nint(nv)-1+ivar
219 CALL get_var_user_f_sp(4,depla,nv)
220 ELSE
221 CALL get_var_user_f(3,depla,nv)
222 depla=nint(nv)-1+ivar
223 CALL get_var_user_f(4,depla,nv)
224 ENDIF
225 get_u_pnu=nint(nv)
226C GET_U_PNU = NINT(BUFGEO(NINT(GEO(K,IP))-1+IVAR))
227 ENDIF
228C
229 RETURN
230 END
231!||====================================================================
232!|| get_u_mnu ../engine/source/user_interface/upidmid.F
233!||--- called by ------------------------------------------------------
234!|| ruser32 ../engine/source/elements/spring/ruser32.F
235!|| ruser33 ../engine/source/elements/joint/ruser33.F
236!|| ruser35 ../engine/source/elements/spring/ruser35.F
237!|| ruser36 ../engine/source/elements/spring/ruser36.F
238!|| ruser44 ../engine/source/elements/spring/ruser44.F
239!|| ruser46 ../engine/source/elements/spring/ruser46.F
240!|| xanim28 ../engine/source/elements/xelem/xanim28.F
241!|| xanim29 ../engine/source/output/anim/generate/xanim29.F
242!|| xanim30 ../engine/source/output/anim/generate/xanim30.F
243!|| xanim31 ../engine/source/output/anim/generate/xanim31.F
244!|| xforc28 ../engine/source/elements/xelem/xforc28.F
245!|| xforc29 ../engine/source/elements/xelem/xforc29.F
246!|| xforc30 ../engine/source/elements/xelem/xforc30.F
247!|| xforc31 ../engine/source/elements/xelem/xforc31.F
248!||--- calls -----------------------------------------------------
249!|| get_var_user_i ../engine/source/user_interface/eng_callback_c.c
250!||====================================================================
251 INTEGER FUNCTION get_u_mnu(IVAR,IM,K)
252C-----------------------------------------------
253C I m p l i c i t T y p e s
254C-----------------------------------------------
255#include "implicit_f.inc"
256C-----------------------------------------------
257C C o m m o n B l o c k s
258C-----------------------------------------------
259#include "param_c.inc"
260#include "units_c.inc"
261C-----------------------------------------------
262C D u m m y A r g u m e n t s
263C-----------------------------------------------
264 INTEGER,INTENT(IN) :: ivar,im,k
265C-----------------------------------------------
266C L o c a l V a r i a b l e s
267C-----------------------------------------------
268 INTEGER kfunc,depla,nfunc
269 parameter(kfunc=29)
270C-----------------------------------------------
271C S o u r c e L i n e s
272C-----------------------------------------------
273C NFUNC = IPM(10,IM))
274 depla = 10+(im-1)*npropmi
275 CALL get_var_user_i(19,depla,nfunc)
276C
277 IF (ivar > nfunc)THEN
278 WRITE(iout,*) ' **ERROR IN FUNCTION GET_U_MNU(INDEX,IP,GEO,BUFGEO,',k,'), INDEX(',ivar,') EXCEED ALLOCATED VALUE(',nfunc,')'
279 WRITE(istdo,*)' **ERROR IN FUNCTION GET_U_MNU(INDEX,IP,GEO,BUFGEO,',k,'), INDEX(',ivar,') EXCEED ALLOCATED VALUE(',nfunc,')'
280 ELSEIF(k==kfunc) THEN
281C GET_U_MNU = IFUNC = IPM(10+IVAR,IM))
282 depla = 10+ivar+(im-1)*npropmi
283 CALL get_var_user_i(19,depla,get_u_mnu)
284C
285 ENDIF
286C
287 RETURN
288 END
289
290!||====================================================================
291!|| get_u_pid ../engine/source/user_interface/upidmid.F
292!||--- called by ------------------------------------------------------
293!|| get_u_p ../engine/source/user_interface/upidmid.F
294!|| ruser32 ../engine/source/elements/spring/ruser32.F
295!|| ruser33 ../engine/source/elements/joint/ruser33.F
296!|| ruser35 ../engine/source/elements/spring/ruser35.F
297!|| ruser36 ../engine/source/elements/spring/ruser36.F
298!|| ruser44 ../engine/source/elements/spring/ruser44.F
299!|| ruser46 ../engine/source/elements/spring/ruser46.F
300!|| xanim28 ../engine/source/elements/xelem/xanim28.F
301!|| xanim29 ../engine/source/output/anim/generate/xanim29.F
302!|| xanim30 ../engine/source/output/anim/generate/xanim30.F
303!|| xanim31 ../engine/source/output/anim/generate/xanim31.F
304!|| xforc28 ../engine/source/elements/xelem/xforc28.F
305!|| xforc29 ../engine/source/elements/xelem/xforc29.F
306!|| xforc30 ../engine/source/elements/xelem/xforc30.F
307!|| xforc31 ../engine/source/elements/xelem/xforc31.F
308!||--- calls -----------------------------------------------------
309!|| get_var_user_i ../engine/source/user_interface/eng_callback_c.c
310!||====================================================================
311 INTEGER FUNCTION get_u_pid(IP)
312C-----------------------------------------------
313C I m p l i c i t T y p e s
314C-----------------------------------------------
315#include "implicit_f.inc"
316C-----------------------------------------------
317C C o m m o n B l o c k s
318C----------------------------------------------
319#include "param_c.inc"
320C-----------------------------------------------
321C D u m m y A r g u m e n t s
322C-----------------------------------------------
323 INTEGER,INTENT(IN) :: ip
324C-----------------------------------------------
325C L o c a l V a r i a b l e s
326C-----------------------------------------------
327 INTEGER depla,var
328C-----------------------------------------------
329C S o u r c e C o d e
330C-----------------------------------------------
331C GET_U_PID = NINT(GEO(40,IP))
332 depla = 1+(ip-1)*npropgi
333 CALL get_var_user_i(20,depla,var)
334 get_u_pid = var
335C---
336 RETURN
337 END
338!||====================================================================
339!|| get_u_mid ../engine/source/user_interface/upidmid.F
340!||--- called by ------------------------------------------------------
341!|| get_u_m ../engine/source/user_interface/upidmid.F
342!|| ruser32 ../engine/source/elements/spring/ruser32.F
343!|| ruser33 ../engine/source/elements/joint/ruser33.F
344!|| ruser35 ../engine/source/elements/spring/ruser35.F
345!|| ruser36 ../engine/source/elements/spring/ruser36.F
346!|| ruser44 ../engine/source/elements/spring/ruser44.F
347!|| ruser46 ../engine/source/elements/spring/ruser46.F
348!|| xanim28 ../engine/source/elements/xelem/xanim28.F
349!|| xanim29 ../engine/source/output/anim/generate/xanim29.F
350!|| xanim30 ../engine/source/output/anim/generate/xanim30.F
351!|| xanim31 ../engine/source/output/anim/generate/xanim31.F
352!|| xforc28 ../engine/source/elements/xelem/xforc28.F
353!|| xforc29 ../engine/source/elements/xelem/xforc29.F
354!|| xforc30 ../engine/source/elements/xelem/xforc30.F
355!|| xforc31 ../engine/source/elements/xelem/xforc31.F
356!||--- calls -----------------------------------------------------
357!|| get_var_user_i ../engine/source/user_interface/eng_callback_c.c
358!||====================================================================
359 INTEGER FUNCTION get_u_mid(IM)
360C-----------------------------------------------
361C I m p l i c i t T y p e s
362C-----------------------------------------------
363#include "implicit_f.inc"
364C-----------------------------------------------
365C C o m m o n B l o c k s
366C-----------------------------------------------
367#include "param_c.inc"
368C-----------------------------------------------
369C D u m m y A r g u m e n t s
370C-----------------------------------------------
371 INTEGER,INTENT(IN) :: im
372C-----------------------------------------------
373C L o c a l V a r i a b l e s
374C-----------------------------------------------
375 INTEGER depla
376C-----------------------------------------
377C GET_U_MID =IPM(1,IM)
378C---
379 depla = 1+(im-1)*npropmi
380 CALL get_var_user_i(19,depla,get_u_mid)
381C---
382 RETURN
383 END
384
385!||====================================================================
386!|| get_u_m ../engine/source/user_interface/upidmid.F
387!||--- calls -----------------------------------------------------
388!|| get_u_mid ../engine/source/user_interface/upidmid.F
389!||====================================================================
390 INTEGER FUNCTION get_u_m(MID)
391C-----------------------------------------------
392C I m p l i c i t T y p e s
393C-----------------------------------------------
394#include "implicit_f.inc"
395C-----------------------------------------------
396C C o m m o n B l o c k s
397C-----------------------------------------------
398#include "com04_c.inc"
399C-----------------------------------------------
400C D u m m y A r g u m e n t s
401C-----------------------------------------------
402 INTEGER,INTENT(IN) :: mid
403C-----------------------------------------------
404C L o c a l V a r i a b l e s
405C-----------------------------------------------
406 INTEGER i,get_u_mid
407 EXTERNAL get_u_mid
408C-----------------------------------------------
409C S o u r c e L i n e s
410C-----------------------------------------------
411 get_u_m = 0
412 DO i=1,nummat
413 IF(get_u_mid(i)==mid)THEN
414 get_u_m = i
415 RETURN
416 ENDIF
417 ENDDO
418 RETURN
419 END
420
421!||====================================================================
422!|| get_u_p ../engine/source/user_interface/upidmid.F
423!||--- calls -----------------------------------------------------
424!|| get_u_pid ../engine/source/user_interface/upidmid.F
425!||====================================================================
426 INTEGER FUNCTION get_u_p(PID)
427C-----------------------------------------------
428C I m p l i c i t T y p e s
429C-----------------------------------------------
430#include "implicit_f.inc"
431C-----------------------------------------------
432C C o m m o n B l o c k s
433C-----------------------------------------------
434#include "com04_c.inc"
435C-----------------------------------------------
436C D u m m y A r g u m e n t s
437C-----------------------------------------------
438 INTEGER,INTENT(IN) :: pid
439C-----------------------------------------------
440C L o c a l V a r i a b l e s
441C-----------------------------------------------
442 INTEGER i,get_u_pid
443 EXTERNAL get_u_pid
444C-----------------------------------------------
445C S o u r c e L i n e s
446C-----------------------------------------------
447 get_u_p = 0
448 DO i=1,numgeo
449 IF(get_u_pid(i)==pid)THEN
450 get_u_p = i
451 RETURN
452 ENDIF
453 ENDDO
454 RETURN
455 END
456C
457!||====================================================================
458!|| get_u_proc ../engine/source/user_interface/upidmid.F
459!||====================================================================
460 INTEGER FUNCTION get_u_proc()
461C-----------------------------------------------
462C I m p l i c i t T y p e s
463C-----------------------------------------------
464#include "implicit_f.inc"
465C-----------------------------------------------
466C C o m m o n B l o c k s
467C-----------------------------------------------
468#include "task_c.inc"
469C-----------------------------------------------
470C S o u r c e L i n e s
471C-----------------------------------------------
472 get_u_proc = ispmd+1
473C
474 RETURN
475 END
476C
477!||====================================================================
478!|| get_u_task ../engine/source/user_interface/upidmid.F
479!||--- calls -----------------------------------------------------
480!|| omp_get_thread_num ../engine/source/engine/openmp_stub.F90
481!||====================================================================
482 INTEGER FUNCTION get_u_task()
483C-----------------------------------------------
484C I m p l i c i t T y p e s
485C-----------------------------------------------
486#include "implicit_f.inc"
487C-----------------------------------------------
488C L o c a l V a r i a b l e s
489C-----------------------------------------------
490 INTEGER omp_get_thread_num
491 EXTERNAL omp_get_thread_num
492C-----------------------------------------------
493C S o u r c e L i n e s
494C-----------------------------------------------
495 get_u_task = omp_get_thread_num()+1
496C
497 RETURN
498 END
my_real
#define my_real
Definition cppsort.cpp:32
depla
subroutine depla(v, d, x, vr, dr, xdp, ddp, numnod)
Definition depla.F:29
get_var_user_f
void get_var_user_f(int *buf, int *decalage, double *resultat)
Definition eng_callback_c.c:88
get_var_user_i
void get_var_user_i(int *buf, int *decalage, int *resultat)
Definition eng_callback_c.c:163
get_var_user_f_sp
void get_var_user_f_sp(int *buf, int *decalage, float *resultat)
Definition eng_callback_c.c:108
nvar
integer function nvar(text)
Definition nvar.F:32
upidmid_dum
subroutine upidmid_dum(ierr)
Definition upidmid.F:33
get_u_m
integer function get_u_m(mid)
Definition upidmid.F:391
get_u_p
integer function get_u_p(pid)
Definition upidmid.F:427
get_u_pid
integer function get_u_pid(ip)
Definition upidmid.F:312
get_u_pnu
integer function get_u_pnu(ivar, ip, k)
Definition upidmid.F:177
get_u_task
integer function get_u_task()
Definition upidmid.F:483
get_u_mid
integer function get_u_mid(im)
Definition upidmid.F:360
get_u_proc
integer function get_u_proc()
Definition upidmid.F:461
get_u_mnu
integer function get_u_mnu(ivar, im, k)
Definition upidmid.F:252