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