OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
map_tables.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!|| create_map_tables ../starter/source/model/sets/map_tables.f
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
30!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
31!|| map_order ../starter/source/model/sets/map_order.F
32!||--- uses -----------------------------------------------------
33!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
34!|| mapping_option_mod ../starter/share/modules1/dichotomy_mod.F
35!|| message_mod ../starter/share/message_module/message_mod.F
36!|| submodel_mod ../starter/share/modules1/submodel_mod.F
37!||====================================================================
38 SUBROUTINE create_map_tables ( MAP_TABLES ,MODE ,
39 * LSUBMODEL ,SUBSET,
40 * IPART,
41 * IXS ,IXQ, IXC ,IXTG ,
42 * IXT ,IXP ,IXR ,KXSP,LRIVET,
43 * RBY_MSN)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE submodel_mod
48 USE mapping_option_mod
49 USE hm_option_read_mod
50 USE setdef_mod
51 USE groupdef_mod
52 USE message_mod
53 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "com04_c.inc"
62#include "scr17_c.inc"
63#include "sphcom.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER, INTENT(in) :: MODE
68 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
69 TYPE(MAPPING_STRUCT_) :: MAP_TABLES
70 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
71
72 INTEGER, INTENT(IN), DIMENSION(LIPART1,NPART) :: IPART
73 INTEGER, INTENT(IN), DIMENSION(NIXS,NUMELS) :: IXS
74 INTEGER, INTENT(IN), DIMENSION(NIXQ,NUMELQ) :: IXQ
75 INTEGER, INTENT(IN), DIMENSION(NIXC,NUMELC) :: IXC
76 INTEGER, INTENT(IN), DIMENSION(NIXTG,NUMELTG) :: IXTG
77 INTEGER, INTENT(IN), DIMENSION(NIXT,NUMELT) :: IXT
78 INTEGER, INTENT(IN), DIMENSION(NIXP,NUMELP) :: IXP
79 INTEGER, INTENT(IN), DIMENSION(NIXR,NUMELR) :: IXR
80 INTEGER, DIMENSION(NISP,NUMSPH), INTENT(in) :: KXSP
81 INTEGER, DIMENSION(4,NRIVET), INTENT(in) :: LRIVET
82 INTEGER, INTENT(IN), DIMENSION(2,NRBODY) :: RBY_MSN
83
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER I, SET_ID,NSET_G,NSET_COL,OFFSET,NSET1,NSET2
88 INTEGER, DIMENSION(:),ALLOCATABLE :: ISORT,ISORT2,SAV,SAV2
89 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX_SORT,INDEX_SORT2
90 INTEGER, DIMENSION(70000) :: IWORK
91 CHARACTER(LEN=NCHARFIELD) :: KEYSET,SET_TYPE,KEY_TYPE
92 CHARACTER(LEN=NCHARTITLE) :: TITLE,SET_TITLE,TITLE2
93 CHARACTER(LEN=NCHARKEY) :: KEYPART,KEY
94 CHARACTER MESS*40
95 DATA mess/'SET GROUP DEFINITION '/
96C-----------------------------------------------
97 IF(mode==1) THEN
98C Parts
99 ALLOCATE( map_tables%IPARTM(npart,2))
100
101 ALLOCATE(isort(npart))
102 ALLOCATE(index_sort(2*npart))
103
104 DO i=1,npart
105 isort(i)=ipart(4,i)
106 index_sort(i)=i
107 ENDDO
108 CALL my_orders(0,iwork,isort,index_sort,npart,1)
109
110 DO i=1,npart
111 map_tables%IPARTM(i,1)=isort(index_sort(i))
112 map_tables%IPARTM(i,2)=index_sort(i)
113 ENDDO
114
115 DEALLOCATE (isort)
116 DEALLOCATE (index_sort)
117
118C Sets
119 nset_g = 0
120 nset_col = 0
121
122 ! ISORT & INDEX_SORT are used for /SET/GENERAL
123 ALLOCATE(isort(nsets))
124 ALLOCATE(sav(nsets))
125 ALLOCATE(index_sort(2*nsets))
126
127 ! ISORT2 & INDEX_SORT2 are used for /SET/COLLECT
128 ALLOCATE(isort2(nsets))
129 ALLOCATE(sav2(nsets))
130 ALLOCATE(index_sort2(2*nsets))
131
132 CALL hm_option_start('/SET')
133 DO i=1,nsets
134 CALL hm_option_read_key (lsubmodel,
135 . option_id = set_id,
136 . option_titr = set_title,
137 . keyword2 = key)
138
139 IF(trim(key) == 'GENERAL')THEN
140
141 nset_g = nset_g + 1
142 isort(nset_g)=set_id
143 sav(nset_g)=i
144 index_sort(nset_g)=nset_g
145
146 ELSEIF (trim(key) == 'COLLECT') THEN
147
148 nset_col = nset_col + 1
149 isort2(nset_col)=set_id
150 sav2(nset_col)=i
151 index_sort2(nset_col)=i
152
153 ENDIF
154 ENDDO
155
156 ! Sorting SET/GENERAL
157 ! -------------------
158 CALL my_orders(0,iwork,isort,index_sort,nset_g,1)
159 ALLOCATE( map_tables%ISETM(nset_g,2))
160
161 DO i=1,nset_g
162 map_tables%ISETM(i,1)=isort(index_sort(i))
163 map_tables%ISETM(i,2)=sav(index_sort(i))
164 ENDDO
165
166 ! check ID double
167 IF(nset_g > 0) THEN
168 nset1 = map_tables%ISETM(1,1)
169 DO i=2,nset_g
170 nset2 = map_tables%ISETM(i,1)
171 IF (nset2 == nset1) THEN
172 ! error
173 CALL ancmsg(msgid=79,
174 . msgtype=msgerror,
175 . anmode=aninfo,
176 . c1=mess,
177 . i1=nset1)
178 ELSE
179 nset1 = nset2
180 ENDIF
181 ENDDO
182 ENDIF
183
184 map_tables%NSET_GENERAL = nset_g
185
186
187 ! Sorting SET/COLLECT
188 ! -------------------
189 CALL my_orders(0,iwork,isort2,index_sort2,nset_col,1)
190 ALLOCATE( map_tables%ISETCOLM(nset_col,2))
191
192 DO i=1,nset_col
193 map_tables%ISETCOLM(i,1)=isort2(index_sort2(i))
194 map_tables%ISETCOLM(i,2)=sav2(index_sort2(i))
195 ENDDO
196 map_tables%NSET_COLLECT = nset_col
197
198 ! print*,'NSETS=',NSETS
199 ! print*,'SET_GENERAL : ',MAP_TABLES%NSET_GENERAL
200 ! print*,'SET_COLLECT : ',MAP_TABLES%NSET_COLLECT
201
202 ! DO I=1,NSET_COL
203 ! print*,I, MAP_TABLES%ISETCOLM(I,1), MAP_TABLES%ISETCOLM(I,2)
204 ! ENDDO
205 ! print*,'--------------------------------------------------------'
206
207 DEALLOCATE (isort)
208 DEALLOCATE (index_sort)
209 DEALLOCATE (sav)
210
211 DEALLOCATE (isort2)
212 DEALLOCATE (index_sort2)
213 DEALLOCATE (sav2)
214C Subset
215 ALLOCATE( map_tables%ISUBSM(nsubs,2))
216
217 ALLOCATE(isort(nsubs))
218 ALLOCATE(index_sort(2*nsubs))
219
220 DO i=1,nsubs
221 isort(i)=subset(i)%ID
222 index_sort(i)=i
223 ENDDO
224 CALL my_orders(0,iwork,isort,index_sort,nsubs,1)
225
226 DO i=1,nsubs
227 map_tables%ISUBSM(i,1)=isort(index_sort(i))
228 map_tables%ISUBSM(i,2)=index_sort(i)
229 ENDDO
230
231 DEALLOCATE (isort)
232 DEALLOCATE (index_sort)
233C Submodel
234 ALLOCATE( map_tables%ISUBMM(nsubmod,2))
235
236 ALLOCATE(isort(nsubmod))
237 ALLOCATE(index_sort(2*nsubmod))
238
239 DO i=1,nsubmod
240 isort(i) = lsubmodel(i)%NOSUBMOD
241 index_sort(i)=i
242 ENDDO
243 CALL my_orders(0,iwork,isort,index_sort,nsubmod,1)
244
245 DO i=1,nsubmod
246 map_tables%ISUBMM(i,1)=isort(index_sort(i))
247 map_tables%ISUBMM(i,2)=index_sort(i)
248 ENDDO
249
250 DEALLOCATE (isort)
251 DEALLOCATE (index_sort)
252C Rbody
253 ALLOCATE( map_tables%IRBODYM(nrbody,2))
254
255 ALLOCATE(isort(nrbody))
256 ALLOCATE(index_sort(2*nrbody))
257
258 DO i=1,nrbody
259 isort(i)=rby_msn(1,i)
260 index_sort(i)=i
261 ENDDO
262 CALL my_orders(0,iwork,isort,index_sort,nrbody,1)
263
264 DO i=1,nrbody
265 map_tables%IRBODYM(i,1)=isort(index_sort(i))
266 map_tables%IRBODYM(i,2)=index_sort(i)
267 ENDDO
268
269 DEALLOCATE (isort)
270 DEALLOCATE (index_sort)
271 ENDIF
272! ------------------------------------------------------------
273! Element
274C Solid
275 IF(mode==1) ALLOCATE( map_tables%ISOLM(numels,2))
276 CALL map_order(ixs,nixs,nixs,numels,map_tables%ISOLM)
277C Quad
278 IF(mode==1) ALLOCATE( map_tables%IQUADM(numelq,2))
279 CALL map_order(ixq,nixq,nixq,numelq,map_tables%IQUADM)
280C Shell
281 IF(mode==1) ALLOCATE( map_tables%ISH4NM(numelc,2))
282 CALL map_order(ixc,nixc,nixc,numelc,map_tables%ISH4NM)
283C Sh3n
284 IF(mode==1) ALLOCATE( map_tables%ISH3NM(numeltg,2))
285 CALL map_order(ixtg,nixtg,nixtg,numeltg,map_tables%ISH3NM)
286C Tria
287 IF(mode==1) ALLOCATE( map_tables%ITRIAM(numeltg,2))
288 CALL map_order(ixtg,nixtg,nixtg,numeltg,map_tables%ITRIAM)
289C Truss
290 IF(mode==1) ALLOCATE( map_tables%ITRUSSM(numelt,2))
291 CALL map_order(ixt,nixt,nixt,numelt,map_tables%ITRUSSM)
292C Beam
293 IF(mode==1) ALLOCATE( map_tables%IBEAMM(numelp,2))
294 CALL map_order(ixp,nixp,nixp,numelp,map_tables%IBEAMM)
295C Spring
296 IF(mode==1) ALLOCATE( map_tables%ISPRINGM(numelr,2))
297 CALL map_order(ixr,nixr,nixr,numelr,map_tables%ISPRINGM)
298C SPH
299 IF(mode==1) ALLOCATE( map_tables%ISPHM(numsph,2))
300 map_tables%ISPHM(1:numsph,1:2) = 0
301 CALL map_order(kxsp,nisp,nisp,numsph,map_tables%ISPHM)
302! ------------------------------------------------------------
303 IF(mode==2) THEN
304C Rivet
305 ALLOCATE( map_tables%IRIVETM(nrivet,2))
306 CALL map_order(lrivet,4,4,nrivet,map_tables%IRIVETM)
307 ENDIF
308!---
309 RETURN
310 END
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
map_order
subroutine map_order(ixelm, sixelm, uid, num_elm, map)
Definition map_order.F:30
create_map_tables
subroutine create_map_tables(map_tables, mode, lsubmodel, subset, ipart, ixs, ixq, ixc, ixtg, ixt, ixp, ixr, kxsp, lrivet, rby_msn)
Definition map_tables.F:44
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:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
mapping_option_mod
Definition dichotomy_mod.F:36
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
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
setdef_mod
Definition setdef_mod.F:107
setdef_mod::nsets
integer nsets
Definition setdef_mod.F:120
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
starter
program starter
Definition starter.F:39