OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
nintrr.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!|| nintri ../starter/source/system/nintrr.F
25!||--- called by ------------------------------------------------------
26!|| ale_euler_init ../starter/source/materials/ale/ale_euler_init.F
27!|| fill_buffer_51 ../starter/source/materials/mat/mat051/fill_buffer_51.F
28!|| fsdcod ../starter/source/system/fsdcod.F
29!|| hm_preread_part ../starter/source/model/assembling/hm_read_part.F
30!|| hm_read_eref ../starter/source/loads/reference_state/eref/hm_read_eref.F
31!|| hm_read_inject1 ../starter/source/properties/injector/hm_read_inject1.F
32!|| hm_read_inject2 ../starter/source/properties/injector/hm_read_inject2.F
33!|| hm_read_part ../starter/source/model/assembling/hm_read_part.F
34!|| hm_read_retractor ../starter/source/tools/seatbelts/hm_read_retractor.F
35!|| hm_read_slipring ../starter/source/tools/seatbelts/hm_read_slipring.F
36!|| hm_read_thpart ../starter/source/output/thpart/hm_read_thpart.F
37!|| lecint ../starter/source/interfaces/interf1/lecint.F
38!|| nbadigemesh ../starter/source/elements/ige3d/nbadigemesh.F
39!|| read_dfs_detcord ../starter/source/initial_conditions/detonation/read_dfs_detcord.F
40!|| read_dfs_detline ../starter/source/initial_conditions/detonation/read_dfs_detline.F
41!|| read_dfs_detplan ../starter/source/initial_conditions/detonation/read_dfs_detplan.F
42!|| read_dfs_detpoint ../starter/source/initial_conditions/detonation/read_dfs_detpoint.F
43!|| read_dfs_wave_shaper ../starter/source/initial_conditions/detonation/read_dfs_wave_shaper.F
44!||====================================================================
45 INTEGER FUNCTION nintri(IEXT,ANTN,M,N,M1)
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER iext, m, n, m1, antn(m,n)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER i, ie
58 DO i=1,n
59 ie=antn(m1,i)
60 IF(ie==iext)THEN
61 nintri=i
62 RETURN
63 ENDIF
64 ENDDO
65 nintri=0
66 RETURN
67 END
68C
69!||====================================================================
70!|| nintlst ../starter/source/system/nintrr.F
71!||--- called by ------------------------------------------------------
72!|| hm_lecgre ../starter/source/groups/hm_lecgre.F
73!||--- calls -----------------------------------------------------
74!|| ancmsg ../starter/source/output/message/message.F
75!||--- uses -----------------------------------------------------
76!|| message_mod ../starter/share/message_module/message_mod.F
77!||====================================================================
78 INTEGER FUNCTION nintlst (LIST,NLIST,IX,NIX,NUMEL,MESS,
79 . IX1,IX2,INDEX,KK,
80 . TYPE,ID,TITR)
81C-----------------------------------------------
82C M o d u l e s
83C-----------------------------------------------
84 USE message_mod
86C FONCTION DONNE N0 SYSTEME D'UNE LISTE D'ELEMENTS USER
87C-----------------------------------------------
88C I m p l i c i t T y p e s
89C-----------------------------------------------
90#include "implicit_f.inc"
91C-----------------------------------------------
92C C o m m o n B l o c k s
93C-----------------------------------------------
94C-----------------------------------------------
95C D u m m y A r g u m e n t s
96C-----------------------------------------------
97 INTEGER nlist,KK,nix,numel
98 CHARACTER mess*40
99 INTEGER list(*),ix(nix,*),index(*),ix1(*),ix2(*)
100 INTEGER id
101 CHARACTER(LEN=NCHARTITLE) :: TYPE,titr
102C-----------------------------------------------
103C L o c a l V a r i a b l e s
104C-----------------------------------------------
105 INTEGER i, j,nel,nold,k,
106 . iwork(70000)
107C-----------------------
108C TRI DE LIST EN ORDRE CROISSANT
109C AVEC SUPPRESSION DES No DOUBLES
110C-----------------------
111 CALL my_orders(0,iwork,list,index,nlist,1)
112 DO i=1,nlist
113 index(nlist+i) = list(index(i))
114 ENDDO
115 k=1
116 nold = index(nlist+1)
117 DO i=1,nlist
118 IF(nold/=index(nlist+i))k=k+1
119 list(k) = index(nlist+i)
120 nold = index(nlist+i)
121 ENDDO
122 nel=k
123C-----------------------
124C TRI DE IX EN ORDRE CROISSANT si KK = 0
125C-----------------------
126 IF(kk==0)THEN
127 DO i=1,numel
128 ix2(i) = ix(nix,i)
129 ENDDO
130 CALL my_orders(0,iwork,ix2,index,numel,1)
131 DO i=1,numel
132 ix1(i) = ix2(index(i))
133 ENDDO
134 DO i=1,numel
135 ix2(i) = index(i)
136 ENDDO
137 ENDIF
138C-----------------------
139C RECHERCHE DES ELEMENTS DE LIST() DANS IX()
140C ALGO < NLIST+NUMEL
141C-----------------------
142 i=1
143 j=1
144 DO i=1,nel
145 DO WHILE(list(i)>ix1(j).AND.j<numel)
146 j=j+1
147 ENDDO
148 IF(list(i)==ix1(j))THEN
149 list(i)=ix2(j)
150 ELSE
151 CALL ancmsg(msgid=70,
152 . msgtype=msgerror,
153 . anmode=aninfo,
154 . c1=TYPE,
155 . i1=id,
156 . c2=titr,
157 . i2=list(i))
158 nintlst=i-1
159 RETURN
160 ENDIF
161 ENDDO
162C
163 nintlst=nel
164 RETURN
165 END
166C
167!||====================================================================
168!|| nintlst2 ../starter/source/system/nintrr.F
169!||--- called by ------------------------------------------------------
170!|| state_admesh ../starter/source/model/remesh/state_admesh.F
171!||--- calls -----------------------------------------------------
172!|| ancmsg ../starter/source/output/message/message.F
173!||--- uses -----------------------------------------------------
174!|| message_mod ../starter/share/message_module/message_mod.F
175!||====================================================================
176 INTEGER FUNCTION nintlst2 (LIST,NLIST,INDEXL,IX,NIX,NUMEL,
177 . MESS,IX1,IX2,INDEX,KK)
178 USE message_mod
179C FONCTION DONNE N0 SYSTEME D'UNE LISTE D'ELEMENTS USER, AUTORISE LES 0.
180C-----------------------------------------------
181C I m p l i c i t T y p e s
182C-----------------------------------------------
183#include "implicit_f.inc"
184C-----------------------------------------------
185C D u m m y A r g u m e n t s
186C-----------------------------------------------
187 INTEGER nlist,kk,nix,numel
188 CHARACTER mess*40
189 INTEGER list(*),indexl(*),ix(nix,*),index(*),ix1(*),ix2(*)
190C-----------------------------------------------
191C L o c a l V a r i a b l e s
192C-----------------------------------------------
193 INTEGER i, j,nold,k,
194 . iwork(70000)
195C-----------------------
196C TRI DE LIST EN ORDRE CROISSANT
197C-----------------------
198 CALL my_orders(0,iwork,list,indexl,nlist,1)
199C-----------------------
200C TRI DE IX EN ORDRE CROISSANT si KK = 0
201C-----------------------
202 IF(kk==0)THEN
203 DO i=1,numel
204 ix2(i) = ix(nix,i)
205 ENDDO
206 CALL my_orders(0,iwork,ix2,index,numel,1)
207 DO i=1,numel
208 ix1(i) = ix2(index(i))
209 ENDDO
210 DO i=1,numel
211 ix2(i) = index(i)
212 ENDDO
213 ENDIF
214C-----------------------
215C RECHERCHE DES ELEMENTS DE LIST() DANS IX()
216C ALGO < NLIST+NUMEL
217C-----------------------
218 i=1
219 j=1
220 DO i=1,nlist
221 DO WHILE(list(indexl(i))>ix1(j).AND.j<numel)
222 j=j+1
223 ENDDO
224 IF(list(indexl(i))==ix1(j))THEN
225 list(indexl(i))=ix2(j)
226 ELSEIF(list(indexl(i))/=0)THEN
227C WRITE(IOUT,*)MESS
228C WRITE(IOUT,*)' ** ERROR : ELEMENT ',LIST(I),
229C . ' DOESNT''EXIST'
230C WRITE(ISTDO,*)MESS
231C WRITE(ISTDO,*)' ** ERROR : ELEMENT ',LIST(I),
232C . ' DOESNT''EXIST'
233C IERR=IERR+1
234 CALL ancmsg(msgid=71,
235 . msgtype=msgerror,
236 . anmode=aninfo,
237 . c1=mess,
238 . i1=list(indexl(i)))
239 nintlst2=i-1
240 RETURN
241 ENDIF
242 ENDDO
243C
244 nintlst2=nlist
245 RETURN
246 END
247C
248!||====================================================================
249!|| ngr2usr ../starter/source/system/nintrr.F
250!||--- called by ------------------------------------------------------
251!|| hm_preread_bcscyc ../starter/source/constraints/general/bcs/lecbcscyc.F
252!|| hm_preread_load_centri ../starter/source/loads/general/load_centri/hm_preread_load_centri.F
253!|| hm_preread_pblast ../starter/source/loads/pblast/hm_preread_pblast.F
254!|| hm_read_ale_link ../starter/source/constraints/ale/hm_read_ale_link_vel.f
255!|| hm_read_alebcs ../starter/source/constraints/ale/hm_read_alebcs.F
256!|| hm_read_bcs ../starter/source/constraints/general/bcs/hm_read_bcs.F
257!|| hm_read_damp ../starter/source/general_controls/damping/hm_read_damp.f
258!|| hm_read_ebcs_fluxout ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_fluxout.F
259!|| hm_read_ebcs_gradp0 ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_gradp0.f
260!|| hm_read_ebcs_inip ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_inip.f
261!|| hm_read_ebcs_iniv ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_iniv.F
262!|| hm_read_ebcs_inlet ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_inlet.F
263!|| hm_read_ebcs_monvol ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_monvol.F
264!|| hm_read_ebcs_normv ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_normv.F
265!|| hm_read_ebcs_nrf ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_nrf.F
266!|| hm_read_ebcs_pres ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_pres.F
267!|| hm_read_ebcs_propellant ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_propellant.f90
268!|| hm_read_ebcs_valvin ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_valvin.f
269!|| hm_read_ebcs_valvout ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_valvout.f
270!|| hm_read_ebcs_vel ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_vel.F
271!|| hm_read_inter_hertz_type17 ../starter/source/interfaces/int17/hm_read_inter_hertz_type17.F
272!|| hm_read_inter_lagdt_type07 ../starter/source/interfaces/int07/hm_read_inter_lagdt_type07.F
273!|| hm_read_inter_lagmul_type02 ../starter/source/interfaces/int02/hm_read_inter_lagmul_type02.F
274!|| hm_read_inter_lagmul_type07 ../starter/source/interfaces/int07/hm_read_inter_lagmul_type07.F
275!|| hm_read_inter_lagmul_type16 ../starter/source/interfaces/int16/hm_read_inter_lagmul_type16.F
277!|| hm_read_inter_type01 ../starter/source/interfaces/int01/hm_read_inter_type01.f
278!|| hm_read_inter_type02 ../starter/source/interfaces/int02/hm_read_inter_type02.F
279!|| hm_read_inter_type03 ../starter/source/interfaces/int03/hm_read_inter_type03.F
280!|| hm_read_inter_type05 ../starter/source/interfaces/int05/hm_read_inter_type05.F
281!|| hm_read_inter_type06 ../starter/source/interfaces/int06/hm_read_inter_type06.F
282!|| hm_read_inter_type07 ../starter/source/interfaces/int07/hm_read_inter_type07.F
283!|| hm_read_inter_type08 ../starter/source/interfaces/int08/hm_read_inter_type08.F
284!|| hm_read_inter_type09 ../starter/source/interfaces/int09/hm_read_inter_type09.F
285!|| hm_read_inter_type10 ../starter/source/interfaces/int10/hm_read_inter_type10.F
286!|| hm_read_inter_type11 ../starter/source/interfaces/int11/hm_read_inter_type11.F
287!|| hm_read_inter_type12 ../starter/source/interfaces/int12/hm_read_inter_type12.f
288!|| hm_read_inter_type14 ../starter/source/interfaces/int14/hm_read_inter_type14.F
289!|| hm_read_inter_type15 ../starter/source/interfaces/int15/hm_read_inter_type15.F
290!|| hm_read_inter_type18 ../starter/source/interfaces/int18/hm_read_inter_type18.F
291!|| hm_read_inter_type20 ../starter/source/interfaces/int20/hm_read_inter_type20.f
292!|| hm_read_inter_type21 ../starter/source/interfaces/int21/hm_read_inter_type21.F
293!|| hm_read_inter_type22 ../starter/source/interfaces/int22/hm_read_inter_type22.F
294!|| hm_read_inter_type23 ../starter/source/interfaces/int23/hm_read_inter_type23.F
295!|| hm_read_inter_type24 ../starter/source/interfaces/int24/hm_read_inter_type24.F
296!|| hm_read_inter_type25 ../starter/source/interfaces/int25/hm_read_inter_type25.F
297!|| hm_read_intsub ../starter/source/output/subinterface/hm_read_intsub.F
298!|| hm_read_link ../starter/source/constraints/rigidlink/hm_read_rlink.F
299!|| hm_read_merge_node ../starter/source/elements/reader/hm_read_merge_node.F
300!|| hm_read_nbcs ../starter/source/constraints/general/bcs/hm_read_nbcs.F
301!|| hm_read_pblast ../starter/source/loads/pblast/hm_read_pblast.F
302!|| hm_read_pcyl ../starter/source/loads/general/load_pcyl/hm_read_pcyl.f
303!|| hm_read_rand ../starter/source/general_controls/computation/hm_read_rand.F
304!|| hm_read_rbody ../starter/source/constraints/general/rbody/hm_read_rbody.F
305!|| hm_read_rwall_cyl ../starter/source/constraints/general/rwall/hm_read_rwall_cyl.F
306!|| hm_read_rwall_lagmul ../starter/source/constraints/general/rwall/hm_read_rwall_lagmul.F
307!|| hm_read_rwall_paral ../starter/source/constraints/general/rwall/hm_read_rwall_paral.F
308!|| hm_read_rwall_plane ../starter/source/constraints/general/rwall/hm_read_rwall_plane.F
309!|| hm_read_rwall_spher ../starter/source/constraints/general/rwall/hm_read_rwall_spher.f
310!|| hm_read_rwall_therm ../starter/source/constraints/general/rwall/hm_read_rwall_therm.F
311!|| hm_read_slipring ../starter/source/tools/seatbelts/hm_read_slipring.F
312!|| hm_read_spcnd ../starter/source/constraints/sph/hm_read_spcnd.F
313!|| lectrans ../starter/source/model/transformation/lectrans.F
314!|| lectranssub ../starter/source/model/submodel/lectranssub.f
315!|| printbcs ../starter/source/constraints/general/bcs/printbcs.F
316!|| setrb2on ../starter/source/constraints/general/rbe2/hm_read_rbe2.f
317!||--- calls -----------------------------------------------------
318!|| ancmsg ../starter/source/output/message/message.F
319!|| hm_get_current_option ../starter/source/devtools/hm_reader/hm_get_current_option.F
320!||--- uses -----------------------------------------------------
321!|| hm_current_option_mod ../starter/share/modules1/hm_current_option_mod.F
322!|| message_mod ../starter/share/message_module/message_mod.F
323!||====================================================================
324 INTEGER FUNCTION ngr2usr(IU,IGR,NGR)
325C-----------------------------------------------
326C M o d u l e s
327C-----------------------------------------------
328 USE message_mod
331C-----------------------------------------------
332C I m p l i c i t T y p e s
333C-----------------------------------------------
334#include "implicit_f.inc"
335C-----------------------------------------------
336C C o m m o n B l o c k s
337C-----------------------------------------------
338#include "ngr2usr_c.inc"
339C-----------------------------------------------
340C D u m m y A r g u m e n t s
341C-----------------------------------------------
342 INTEGER,INTENT(IN) :: iu,igr(*),ngr
343C-----------------------------------------------
344C L o c a l V a r i a b l e s
345C-----------------------------------------------
346 INTEGER i, ie, id
347 CHARACTER(LEN=NCHARKEY) :: key
348 CHARACTER(LEN=NCHARTITLE) :: titr
349C-----------------------------------------------
350C S o u r c e L i n e s
351C-----------------------------------------------
352 ngr2usr=0
353 IF(iu==0)THEN
354 ngr2usr=0
355 RETURN
356 ENDIF
357 DO i=1,ngr
358 ie=igr(i)
359 IF(ie==iu)THEN
360 ngr2usr=i
361 RETURN
362 ENDIF
363 ENDDO
364 IF(iskip_ngr2usr_error==0) THEN
365
366 CALL hm_get_current_option(option_id = id,
367 . option_titr = titr,
368 . keyword1 = key)
369 CALL ancmsg(msgid=2087,
370 . msgtype=msgerror,
371 . anmode=aninfo,
372 . c1=key,
373 . i1=id,
374 . c2=key,
375 . c3=titr,
376 . i2=iu)
377 ENDIF
378 iskip_ngr2usr_error = 0
379 RETURN
380 END
381C
382!||====================================================================
383!|| ngr2usrn ../starter/source/system/nintrr.F
384!||--- called by ------------------------------------------------------
385!|| fail_windshield_init ../starter/source/materials/fail/windshield_alter/fail_windshield_init.F
386!|| hm_pre_read_link ../starter/source/constraints/rigidlink/hm_pre_read_rlink.F
387!|| hm_preread_cload ../starter/source/loads/general/cload/hm_preread_cload.f
388!|| hm_preread_convec ../starter/source/loads/thermic/hm_preread_convec.F
389!|| hm_preread_grav ../starter/source/loads/general/grav/hm_preread_grav.F
390!|| hm_preread_impacc ../starter/source/constraints/general/impvel/hm_preread_impacc.F
391!|| hm_preread_impdisp ../starter/source/constraints/general/impvel/hm_preread_impdisp.F
392!|| hm_preread_impflux ../starter/source/constraints/thermic/hm_preread_impflux.F
393!|| hm_preread_imptemp ../starter/source/constraints/thermic/hm_preread_imptemp.F
394!|| hm_preread_impvel ../starter/source/constraints/general/impvel/hm_preread_impvel.F
395!|| hm_preread_load_centri ../starter/source/loads/general/load_centri/hm_preread_load_centri.F
396!|| hm_preread_pload ../starter/source/loads/general/pload/hm_preread_pload.F
397!|| hm_preread_radiation ../starter/source/loads/thermic/hm_preread_radiation.F
398!|| hm_preread_rbe2 ../starter/source/constraints/general/rbe2/hm_read_rbe2.F
399!|| hm_preread_xelem ../starter/source/elements/reader/hm_preread_xelem.F
400!|| prelecdet ../starter/source/initial_conditions/detonation/prelecdet.F
401!|| random_walk_dmg ../starter/source/materials/fail/fractal/random_walk_dmg.F90
402!|| setrb2on ../starter/source/constraints/general/rbe2/hm_read_rbe2.F
403!||--- uses -----------------------------------------------------
404!|| message_mod ../starter/share/message_module/message_mod.F
405!||====================================================================
406 INTEGER FUNCTION ngr2usrn(IU,IGRNOD,NGRNOD,NUM)
407C-----------------------------------------------
408C M o d u l e s
409C-----------------------------------------------
410 USE message_mod
411 USE groupdef_mod
412C-----------------------------------------------
413C I m p l i c i t T y p e s
414C-----------------------------------------------
415#include "implicit_f.inc"
416C-----------------------------------------------
417C D u m m y A r g u m e n t s
418C-----------------------------------------------
419 INTEGER iu,NGRNOD,num
420C-----------------------------------------------
421 TYPE (group_) ,DIMENSION(NGRNOD) :: igrnod
422C-----------------------------------------------
423C L o c a l V a r i a b l e s
424C-----------------------------------------------
425 INTEGER i
426C-----------------------------------------------
427 ngr2usrn = 0
428 IF(iu == 0)THEN
429 num = 0
430 ngr2usrn=0
431 RETURN
432 ENDIF
433 DO i=1,ngrnod
434 IF (iu == igrnod(i)%ID) THEN
435 num = igrnod(i)%NENTITY
436 ngr2usrn=i
437 RETURN
438 ENDIF
439 ENDDO
440C-----------
441 RETURN
442 END
443C
444!||====================================================================
445!|| grsize ../starter/source/system/nintrr.F
446!||--- uses -----------------------------------------------------
447!||====================================================================
448 INTEGER FUNCTION grsize(IGU,IGRNOD,GRLEN)
449C-----------------------------------------------
450C M o d u l e s
451C-----------------------------------------------
452 USE groupdef_mod
453C-----------------------------------------------
454C I m p l i c i t T y p e s
455C-----------------------------------------------
456#include "implicit_f.inc"
457C-----------------------------------------------
458C C o m m o n B l o c k s
459C-----------------------------------------------
460#include "com04_c.inc"
461C-----------------------------------------------
462C D u m m y A r g u m e n t s
463C-----------------------------------------------
464 INTEGER igu,grlen
465C-----------------------------------------------
466 TYPE (group_) , DIMENSION(NGRNOD) :: igrnod
467C-----------------------------------------------
468C L o c a l V a r i a b l e s
469C-----------------------------------------------
470 INTEGER i,igs
471C-----------------------------------------------
472 grsize = 0
473 IF (igu > 0) THEN
474 DO i=1,grlen
475 IF (igu == igrnod(i)%ID) THEN
476 grsize = igrnod(i)%NENTITY
477 igs = i
478 EXIT
479 ENDIF
480 ENDDO
481 ENDIF
482C-----------
483 RETURN
484 END
485!||====================================================================
486!|| grsizen ../starter/source/system/nintrr.F
487!||--- called by ------------------------------------------------------
488!|| hm_prelecjoi ../starter/source/constraints/general/cyl_joint/hm_prelecjoi.F
489!|| hm_preread_merge ../starter/source/constraints/general/merge/hm_preread_merge.F
490!|| hm_preread_rbody ../starter/source/constraints/general/rbody/hm_preread_rbody.F
491!|| prelecsec ../starter/source/tools/sect/prelecsec.F
492!|| prelecsec4bolt ../starter/source/tools/sect/prelecsec4bolt.F
493!|| preread_rbody_lagmul ../starter/source/constraints/general/rbody/preread_rbody_lagmul.F
494!||--- uses -----------------------------------------------------
495!||====================================================================
496 INTEGER FUNCTION grsizen(IGU,IGRNOD,GRLEN)
497C-----------------------------------------------
498C M o d u l e s
499C-----------------------------------------------
500 USE groupdef_mod
501C-----------------------------------------------
502C I m p l i c i t T y p e s
503C-----------------------------------------------
504#include "implicit_f.inc"
505C-----------------------------------------------
506C D u m m y A r g u m e n t s
507C-----------------------------------------------
508 INTEGER igu,grlen
509C-----------------------------------------------
510 TYPE (group_) , DIMENSION(GRLEN) :: igrnod
511C-----------------------------------------------
512C L o c a l V a r i a b l e s
513C-----------------------------------------------
514 INTEGER i,igs
515C-----------------------------------------------
516 grsizen = 0
517 IF (igu > 0) THEN
518 DO i=1,grlen
519 IF (igu == igrnod(i)%ID) THEN
520 grsizen = igrnod(i)%NENTITY
521 igs = i
522 EXIT
523 ENDIF
524 ENDDO
525 ENDIF
526C-----------
527 RETURN
528 END
529!||====================================================================
530!|| grsize_ele ../starter/source/system/nintrr.F
531!||--- called by ------------------------------------------------------
532!|| lecsec42 ../starter/source/tools/sect/hm_read_sect.F
533!|| prelecsec ../starter/source/tools/sect/prelecsec.F
534!|| prelecsec4bolt ../starter/source/tools/sect/prelecsec4bolt.F
535!||--- uses -----------------------------------------------------
536!||====================================================================
537 INTEGER FUNCTION grsize_ele(IGU,IGRELEM,NGRELEM)
538C-----------------------------------------------
539C M o d u l e s
540C-----------------------------------------------
541 USE groupdef_mod
542C-----------------------------------------------
543C I m p l i c i t T y p e s
544C-----------------------------------------------
545#include "implicit_f.inc"
546C-----------------------------------------------
547C D u m m y A r g u m e n t s
548C-----------------------------------------------
549 INTEGER igu,ngrelem
550C-----------------------------------------------
551 TYPE (group_) , DIMENSION(NGRELEM) :: igrelem
552C-----------------------------------------------
553C L o c a l V a r i a b l e s
554C-----------------------------------------------
555 INTEGER i,IGS
556C-----------------------------------------------
557 grsize_ele = 0
558 IF (igu > 0) THEN
559 DO i=1,ngrelem
560 IF (igu == igrelem(i)%ID) THEN
561 grsize_ele = igrelem(i)%NENTITY
562 igs = i
563 EXIT
564 ENDIF
565 ENDDO
566 ENDIF
567C-----------
568 RETURN
569 END
570!||====================================================================
571!|| grsize_ele_trans ../starter/source/system/nintrr.F
572!||--- called by ------------------------------------------------------
573!|| lecsec42 ../starter/source/tools/sect/hm_read_sect.F
574!|| prelecsec ../starter/source/tools/sect/prelecsec.F
575!||--- uses -----------------------------------------------------
576!||====================================================================
577 INTEGER FUNCTION grsize_ele_trans(IGU,IGRELEM,NGRELEM,SEATBELT_SHELL_TO_SPRING)
578C-----------------------------------------------
579C M o d u l e s
580C-----------------------------------------------
581 USE groupdef_mod
582C-----------------------------------------------
583C I m p l i c i t T y p e s
584C-----------------------------------------------
585#include "implicit_f.inc"
586C-----------------------------------------------
587C C o m m o n B l o c k s
588C-----------------------------------------------
589#include "com04_c.inc"
590C-----------------------------------------------
591C D u m m y A r g u m e n t s
592C-----------------------------------------------
593 INTEGER,INTENT(IN)::igu,ngrelem
594C-----------------------------------------------
595 TYPE (group_) , DIMENSION(NGRELEM) , INTENT(IN) :: igrelem
596 INTEGER,INTENT(IN)::seatbelt_shell_to_spring(numelc,2)
597C-----------------------------------------------
598C L o c a l V a r i a b l e s
599C-----------------------------------------------
600 INTEGER i,j,ie
601C-----------------------------------------------
603 IF (igu > 0) THEN
604 DO i=1,ngrelem
605 IF (igu == igrelem(i)%ID) THEN
606 DO j=1,igrelem(i)%NENTITY
607 ie=igrelem(i)%ENTITY(j)
608 IF(seatbelt_shell_to_spring(ie,1) /= 0)
610 IF(seatbelt_shell_to_spring(ie,2) /= 0)
612 ENDDO
613 ENDIF
614 ENDDO
615 ENDIF
616C-----------
617 RETURN
618 END
619!||====================================================================
620!|| sortgroup ../starter/source/system/nintrr.F
621!||--- called by ------------------------------------------------------
622!|| lectur ../starter/source/starter/lectur.F
623!||--- calls -----------------------------------------------------
624!||====================================================================
625 SUBROUTINE sortgroup(
626 1 IXS_S ,IXS_S_IND,IXQ_S,IXQ_S_IND,IXC_S,IXC_S_IND,
627 2 IXT_S ,IXT_S_IND,IXP_S,IXP_S_IND,IXR_S,IXR_S_IND,
628 3 IXTG_S,IXTG_S_IND,IXS,IXQ,IXC,IXT,IXP,IXR,IXTG,LENI)
629C GROUP SORTING vs USER ID
630C-----------------------------------------------
631C I m p l i c i t T y p e s
632C-----------------------------------------------
633#include "implicit_f.inc"
634C-----------------------------------------------
635C C o m m o n B l o c k s
636C-----------------------------------------------
637#include "com04_c.inc"
638C-----------------------------------------------
639C D u m m y A r g u m e n t s
640C-----------------------------------------------
641 INTEGER IXS_S(*),IXS_S_IND(*),IXQ_S(*),IXQ_S_IND(*),IXC_S(*),
642 1 IXC_S_IND(*),IXT_S(*),IXT_S_IND(*),IXP_S(*),
643 2 IXP_S_IND(*),IXR_S(*),IXR_S_IND(*),
644 3 IXTG_S(*),IXTG_S_IND(*),
645 4 IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*),
646 5 IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*),
647 6 leni
648C-----------------------------------------------
649C L o c a l V a r i a b l e s
650C-----------------------------------------------
651 INTEGER I, J,NEL,NOLD,K,
652 . IWORK(70000)
653 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX ! LENI*2
654C-----------------------
655 ALLOCATE(INDEX(LENI*2))
656 DO I=1,numels
657 ixs_s_ind(i) = ixs(nixs,i)
658 ENDDO
659 CALL my_orders(0,iwork,ixs_s_ind,index,numels,1)
660 DO i=1,numels
661 ixs_s(i) = ixs_s_ind(index(i))
662 ENDDO
663 DO i=1,numels
664 ixs_s_ind(i) = index(i)
665 ENDDO
666
667 DO i=1,numelq
668 ixq_s_ind(i) = ixq(nixq,i)
669 ENDDO
670 CALL my_orders(0,iwork,ixq_s_ind,index,numelq,1)
671 DO i=1,numelq
672 ixq_s(i) = ixq_s_ind(index(i))
673 ENDDO
674 DO i=1,numelq
675 ixq_s_ind(i) = index(i)
676 ENDDO
677
678 DO i=1,numelc
679 ixc_s_ind(i) = ixc(nixc,i)
680 ENDDO
681 CALL my_orders(0,iwork,ixc_s_ind,index,numelc,1)
682 DO i=1,numelc
683 ixc_s(i) = ixc_s_ind(index(i))
684 ENDDO
685 DO i=1,numelc
686 ixc_s_ind(i) = index(i)
687 ENDDO
688
689 DO i=1,numelt
690 ixt_s_ind(i) = ixt(nixt,i)
691 ENDDO
692 CALL my_orders(0,iwork,ixt_s_ind,index,numelt,1)
693 DO i=1,numelt
694 ixt_s(i) = ixt_s_ind(index(i))
695 ENDDO
696 DO i=1,numelt
697 ixt_s_ind(i) = index(i)
698 ENDDO
699
700 DO i=1,numelp
701 ixp_s_ind(i) = ixp(nixp,i)
702 ENDDO
703 CALL my_orders(0,iwork,ixp_s_ind,index,numelp,1)
704 DO i=1,numelp
705 ixp_s(i) = ixp_s_ind(index(i))
706 ENDDO
707 DO i=1,numelp
708 ixp_s_ind(i) = index(i)
709 ENDDO
710
711 DO i=1,numelr
712 ixr_s_ind(i) = ixr(nixr,i)
713 ENDDO
714 CALL my_orders(0,iwork,ixr_s_ind,index,numelr,1)
715 DO i=1,numelr
716 ixr_s(i) = ixr_s_ind(index(i))
717 ENDDO
718 DO i=1,numelr
719 ixr_s_ind(i) = index(i)
720 ENDDO
721
722 DO i=1,numeltg
723 ixtg_s_ind(i) = ixtg(nixtg,i)
724 ENDDO
725 CALL my_orders(0,iwork,ixtg_s_ind,index,numeltg,1)
726 DO i=1,numeltg
727 ixtg_s(i) = ixtg_s_ind(index(i))
728 ENDDO
729 DO i=1,numeltg
730 ixtg_s_ind(i) = index(i)
731 ENDDO
732 DEALLOCATE(index)
733 RETURN
734 END
735
736!||====================================================================
737!|| user2sys ../starter/source/system/nintrr.F
738!||--- called by ------------------------------------------------------
739!|| nintlstn ../starter/source/system/nintrr.F
740!||====================================================================
741 INTEGER FUNCTION user2sys(IU,IXX_S,NIX,CUR,LAST)
742C FONCTION DONNE N0 SYSTEME D'UNE LISTE D'ELEMENTS USER OR ZERO IF NOT FOUND
743C-----------------------------------------------
744C I m p l i c i t T y p e s
745C-----------------------------------------------
746#include "implicit_f.inc"
747C-----------------------------------------------
748C D u m m y A r g u m e n t s
749C-----------------------------------------------
750 INTEGER NIX,numel, cur, last
751 INTEGER iu,ixx_s(*)
752C-----------------------------------------------
753C L o c a l V a r i a b l e s
754C-----------------------------------------------
755 INTEGER i, j, jinf, jsup
756C-----------------------
757
758 IF (last==0) THEN
759 user2sys=0
760 RETURN
761 END IF
762 jinf=cur
763 jsup=last
764 j=min(cur,(last+cur)/2)
765 10 IF(jsup<=jinf.AND.(iu-ixx_s(j))/=0) THEN
766C >CAS ELEM non trouve
767 user2sys=0
768 RETURN
769 ENDIF
770 IF((iu-ixx_s(j))==0)THEN
771C >CAS IU=TABM FIN DE LA RECHERCHE
772 user2sys=j
773 RETURN
774 ELSE IF (iu-ixx_s(j)<0) THEN
775C >CAS IU<TABM
776 jsup=j-1
777 ELSE
778C >CAS IU>TABM
779 jinf=j+1
780 ENDIF
781 j=(jsup+jinf)/2
782 GO TO 10
783
784 RETURN
785 END
786
787C
788
789!||====================================================================
790!|| nintlstn ../starter/source/system/nintrr.F
791!||--- called by ------------------------------------------------------
792!|| hm_lecgre ../starter/source/groups/hm_lecgre.F
793!||--- calls -----------------------------------------------------
794!|| ancmsg ../starter/source/output/message/message.F
795!|| user2sys ../starter/source/system/nintrr.F
796!||--- uses -----------------------------------------------------
797!|| message_mod ../starter/share/message_module/message_mod.F
798!||====================================================================
799 INTEGER FUNCTION nintlstn(LIST,NLIST,IXX_S,NIX,NUMEL,MESS,
800 . IXX_S_IND,INDEX,TYPE,ID,TITR)
801 USE message_mod
803C FONCTION DONNE N0 SYSTEME D'UNE LISTE D'ELEMENTS USER
804C-----------------------------------------------
805C I m p l i c i t T y p e s
806C-----------------------------------------------
807#include "implicit_f.inc"
808C-----------------------------------------------
809C D u m m y A r g u m e n t s
810C-----------------------------------------------
811 INTEGER nlist,nix,numel
812 CHARACTER mess*40
813 INTEGER list(*),ixx_s(*),index(*),ixx_s_ind(*)
814 INTEGER id
815 CHARACTER(LEN=NCHARTITLE) :: titr
816 CHARACTER type*4
817C-----------------------------------------------
818C L o c a l V a r i a b l e s
819C-----------------------------------------------
820 INTEGER i, j,nel,nold,k,
821 . iwork(70000)
822 INTEGER user2sys
823C-----------------------
824C TRI DE LIST EN ORDRE CROISSANT
825C AVEC SUPPRESSION DES No DOUBLES
826C-----------------------
827 CALL my_orders(0,iwork,list,index,nlist,1)
828 DO i=1,nlist
829 index(nlist+i) = list(index(i))
830 ENDDO
831 k=1
832 nold = index(nlist+1)
833 DO i=1,nlist
834 IF(nold/=index(nlist+i))k=k+1
835 list(k) = index(nlist+i)
836 nold = index(nlist+i)
837 ENDDO
838 nel=k
839C-----------------------
840C RECHERCHE DES ELEMENTS DE LIST() DANS IXX_S (sorted)
841C-----------------------
842 j=0
843 DO i=1,nel
844 j=user2sys(list(i),ixx_s,nix,j+1,numel)
845 IF(j /= 0)THEN
846 list(i)=ixx_s_ind(j)
847 ELSE
848 CALL ancmsg(msgid=70,
849 . msgtype=msgerror,
850 . anmode=aninfo,
851 . c1=TYPE,
852 . i1=id,
853 . c2=titr,
854 . i2=list(i))
855 nintlstn=i-1
856 RETURN
857 ENDIF
858 ENDDO
859C
860 nintlstn=nel
861
862 RETURN
863 END
864C
865!||====================================================================
866!|| nintrigr ../starter/source/system/nintrr.F
867!||--- called by ------------------------------------------------------
868!|| hm_read_thpart ../starter/source/output/thpart/hm_read_thpart.F
869!||--- uses -----------------------------------------------------
870!||====================================================================
871 INTEGER FUNCTION nintrigr(IEXT,IGR,NGR)
872C-----------------------------------------------
873C M o d u l e s
874C-----------------------------------------------
875 USE groupdef_mod
876C-----------------------------------------------
877C I m p l i c i t T y p e s
878C-----------------------------------------------
879#include "implicit_f.inc"
880C-----------------------------------------------
881C D u m m y A r g u m e n t s
882C-----------------------------------------------
883 INTEGER iext,ngr
884C-----------------------------------------------
885 TYPE (group_) , DIMENSION(NGR) :: igr
886C-----------------------------------------------
887C L o c a l V a r i a b l e s
888C-----------------------------------------------
889 INTEGER i, ie
890C-----------------------------------------------
891 DO i=1,ngr
892 ie=igr(i)%ID
893 IF(ie==iext)THEN
894 nintrigr=i
895 RETURN
896 ENDIF
897 ENDDO
898 nintrigr=0
899!
900 RETURN
901 END
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
subroutine hm_preread_cload(numcld, igrnod, igrsurf, lsubmodel)
subroutine hm_read_damp(dampr, igrnod, iskn, lsubmodel, unitab, snpc1, npc1, ndamp_vrel_rby, igrpart, damp_range_part)
subroutine hm_read_ebcs_gradp0(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_inip(igrsurf, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_valvin(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_valvout(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_inter_lagmul_type17(ipari, stfac, frigap, noint, igrbric, lsubmodel)
subroutine hm_read_inter_type01(ipari, stfac, frigap, igrsurf, lsubmodel, nsurf, noint, npari, nparir)
subroutine hm_read_inter_type12(ipari, stfac, frigap, noint, igrsurf, itab, itabm1, iskn, lsubmodel, unitab, sitab, sitabm1, npari, nparir, siskwn, liskn)
subroutine hm_read_inter_type20(ipari, stfac, frigap, noint, igrnod, igrsurf, igrslin, xfiltr, fric_p, unitab, lsubmodel, titr)
subroutine hm_read_pcyl(loads, igrsurf, nsensor, sensor_tab, table, iframe, unitab, lsubmodel, number_load_cyl)
subroutine setrb2on(ixs, ixc, ixtg, igrnod, igrnrb2, isoloff, isheoff, itrioff, itabm1, lsubmodel)
subroutine hm_read_rbe2(irbe2, lrbe2, itab, itabm1, igrnod, iskn, ikine, iddlevel, nom_opt, itagnd, icdns10, lsubmodel)
subroutine hm_read_rwall_spher(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchspher, k, offs, ikine1)
subroutine lectranssub(x, igrnod, itab, itabm1, unitab, rtrans, lsubmodel, is_dyna)
Definition lectranssub.F:46
#define min(a, b)
Definition macros.h:20
initmumps id
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
integer, parameter nchartitle
integer, parameter ncharkey
integer function grsizen(igu, igrnod, grlen)
Definition nintrr.F:497
integer function nintlst(list, nlist, ix, nix, numel, mess, ix1, ix2, index, kk, type, id, titr)
Definition nintrr.F:81
integer function nintrigr(iext, igr, ngr)
Definition nintrr.F:872
integer function nintlstn(list, nlist, ixx_s, nix, numel, mess, ixx_s_ind, index, type, id, titr)
Definition nintrr.F:801
integer function ngr2usrn(iu, igrnod, ngrnod, num)
Definition nintrr.F:407
integer function nintlst2(list, nlist, indexl, ix, nix, numel, mess, ix1, ix2, index, kk)
Definition nintrr.F:178
integer function grsize_ele(igu, igrelem, ngrelem)
Definition nintrr.F:538
subroutine sortgroup(ixs_s, ixs_s_ind, ixq_s, ixq_s_ind, ixc_s, ixc_s_ind, ixt_s, ixt_s_ind, ixp_s, ixp_s_ind, ixr_s, ixr_s_ind, ixtg_s, ixtg_s_ind, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, leni)
Definition nintrr.F:629
integer function grsize_ele_trans(igu, igrelem, ngrelem, seatbelt_shell_to_spring)
Definition nintrr.F:578
integer function grsize(igu, igrnod, grlen)
Definition nintrr.F:449
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
integer function nintri(iext, antn, m, n, m1)
Definition nintrr.F:46
integer function user2sys(iu, ixx_s, nix, cur, last)
Definition nintrr.F:742
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
program starter
Definition starter.F:39