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