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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_lines_of_lines (igrslin, inseg, flag, icount, iter, nsets, lsubmodel)

Function/Subroutine Documentation

◆ hm_lines_of_lines()

subroutine hm_lines_of_lines ( type (surf_), dimension(nslin+nsets) igrslin,
integer inseg,
integer flag,
integer icount,
integer iter,
integer nsets,
type(submodel_data), dimension(nsubmod) lsubmodel )

Definition at line 38 of file hm_lines_of_lines.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE my_alloc_mod
43 USE message_mod
44 USE groupdef_mod
45 USE submodel_mod
46 USE hm_option_read_mod
47 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
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 "com04_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER INSEG,FLAG,ICOUNT,ITER
60 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I,K,L,J,ID,IGS,IGRS,JREC,IAD0,IADV,NSEG,NSEGV,
65 . FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,SKIPFLAG,UID,NSEG_TOT,
66 . NSETS,NENTITY,KK,JJ
67 CHARACTER(LEN=NCHARTITLE) :: TITR
68 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
69!
70 TYPE (SURF_) , DIMENSION(NSLIN+NSETS) :: IGRSLIN
71 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
72C-----------------------------------------------
73! IGRSLIN(IGS)%ID :: LINE identifier
74! IGRSLIN(IGS)%TITLE :: LINE title
75! IGRSLIN(IGS)%NSEG :: Number of lines
76! IGRSLIN(IGS)%LEVEL :: FLAG "SUBLEVEL DONE" FOR LINES OF LINES
77! = 0 ! initialized line
78! = 1 ! uninitialized line
79! IGRSLIN(IGS)%ELEM(J) :: element attached to the line segment
80! IGRSLIN(IGS)%NODES(J,2) :: 2 nodes of the line segment
81! IGRSLIN(IGS)%PROC(J) :: field to store the processor ID (/LINE only)
82!
83! 1. Set processor only when no element is set in lines
84! 2. Split lines accordingly
85!
86C-----------------------------------------------
87C LIGNES DES LIGNES ...
88C=======================================================================
89 IF (flag == 0) icount=0
90
91C boucle sur les lignes
92 CALL hm_option_start('/LINE')
93 DO igs=1,nslin
94 CALL hm_option_read_key(lsubmodel,
95 . option_id = id,
96 . option_titr = titr ,
97 . unit_id = uid,
98 . keyword2 = key ,
99 . keyword3 = key2)
100 skipflag = 0
101 nseg=0
102 IF (key(1:4) == 'LINE') THEN
103 IF (flag == 0 .AND. igrslin(igs)%NSEG == -1) THEN
104 CALL hm_get_intv ('idsmax' ,nentity,is_available,lsubmodel)
105 IF (skipflag == 0) THEN
106 DO kk=1,nentity
107 CALL hm_get_int_array_index ('ids' ,jj ,kk,is_available,lsubmodel)
108 IF (jj /= 0) THEN
109 igrs=0
110 DO k=1,nslin
111 IF (jj == igrslin(k)%ID) THEN
112 igrs=k
113 EXIT
114 ENDIF
115 ENDDO
116 IF (igrs == 0)THEN
117 CALL ancmsg(msgid=180,
118 . msgtype=msgerror,
119 . anmode=aninfo,
120 . i1=id,
121 . c1=titr,
122 . i2=jj)
123 !! comme les /surf/surf ELSEIF (IGRSLIN(IGRS)%NSEG == -1) THEN
124 ELSEIF (igrslin(igrs)%LEVEL == 0)THEN
125C reference a une ligne non initialise
126 IF (iter > nslin) GOTO 900
127 igrslin(igs)%NSEG=-1
128 igrslin(igs)%LEVEL=0
129 icount=1
130 nseg = 0
131 skipflag = 1
132 cycle
133 ELSE
134C reference a une ligne initialise
135 nsegv=igrslin(igrs)%NSEG
136 nseg=nseg+nsegv
137 ENDIF
138 ENDIF
139 ENDDO
140 ENDIF
141 IF (skipflag == 0) THEN
142 inseg=inseg+6*nseg
143 igrslin(igs)%NSEG= nseg
144 CALL my_alloc(igrslin(igs)%NODES,nseg,2)
145 igrslin(igs)%NODES(1:nseg,1:2) = 0
146 CALL my_alloc(igrslin(igs)%ELTYP,nseg)
147 igrslin(igs)%ELTYP(1:nseg) = 0
148 CALL my_alloc(igrslin(igs)%ELEM,nseg)
149 igrslin(igs)%ELEM(1:nseg) = 0
150 CALL my_alloc(igrslin(igs)%PROC,nseg)
151 igrslin(igs)%PROC(1:nseg) = 0
152 ENDIF
153C-----------
154 ELSEIF (flag == 1 .AND. igrslin(igs)%LEVEL == 0 .AND. igrslin(igs)%NSEG > -1) THEN
155 nseg_tot = 0
156 CALL hm_get_intv ('idsmax' ,nentity,is_available,lsubmodel)
157 DO kk=1,nentity
158 CALL hm_get_int_array_index ('ids' ,jj ,kk,is_available,lsubmodel)
159 IF (jj /= 0) THEN
160 igrs=0
161 DO k=1,nslin
162 IF (jj == igrslin(k)%ID) THEN
163 igrs=k
164 EXIT
165 ENDIF
166 ENDDO
167 IF (igrslin(igrs)%NSEG == -1) THEN
168 cycle
169 ELSE
170 nsegv=igrslin(igrs)%NSEG
171 DO l=1,nsegv
172 nseg_tot = nseg_tot + 1
173 igrslin(igs)%NODES(nseg_tot,1) = igrslin(igrs)%NODES(l,1)
174 igrslin(igs)%NODES(nseg_tot,2) = igrslin(igrs)%NODES(l,2)
175 igrslin(igs)%ELTYP(nseg_tot) = igrslin(igrs)%ELTYP(l)
176 igrslin(igs)%ELEM(nseg_tot) = igrslin(igrs)%ELEM(l)
177 ENDDO
178 ENDIF
179 ENDIF
180 ENDDO
181 igrslin(igs)%LEVEL=1
182 ENDIF
183 ENDIF
184 ENDDO
185C-----------
186 RETURN
187 900 CONTINUE
188 CALL ancmsg(msgid=189,
189 . msgtype=msgerror,
190 . anmode=aninfo,
191 . c1='LINE',
192 . c2='LINE',
193 . i1=id,
194 . c3='LINE',
195 . c4=titr,
196 . c5='LINE',
197 . i2=igrslin(igs)%ID)
198C-----------
199 RETURN
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
submodel_mod
Definition submodel_mod.F:712
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:889