OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inimap1d.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!|| hm_read_inimap1d ../starter/source/initial_conditions/inimap/hm_read_inimap1d.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
34!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
35!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
36!|| lec_inimap1d_file ../starter/source/initial_conditions/inimap/lec_inimap1d_file.F
37!|| usr2sys ../starter/source/system/sysfus.F
38!||--- uses -----------------------------------------------------
39!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
40!|| inimap1d_mod ../starter/share/modules1/inimap1d_mod.f
41!|| message_mod ../starter/share/message_module/message_mod.F
42!|| submodel_mod ../starter/share/modules1/submodel_mod.F
43!||====================================================================
44 SUBROUTINE hm_read_inimap1d(INIMAP1D, NPC ,ITABM1, X, IGRBRIC,
45 . IGRQUAD , IGRSH3N, MULTI_FVM, UNITAB, LSUBMODEL)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE inimap1d_mod
50 USE message_mod
51 USE groupdef_mod
52 USE multi_fvm_mod
53 USE unitab_mod
54 USE submodel_mod
55 USE hm_option_read_mod
56 USE names_and_titles_mod , ONLY : nchartitle, ncharline
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "units_c.inc"
65#include "scr17_c.inc"
66!NFUNCT
67#include "com01_c.inc"
68#include "com04_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER, INTENT(IN) :: NPC(*), ITABM1(*)
73 my_real, INTENT(IN) :: x(3, *)
74 TYPE(inimap1d_struct), DIMENSION(NINIMAP1D), INTENT(INOUT) :: INIMAP1D
75 TYPE(multi_fvm_struct), INTENT(IN) :: MULTI_FVM
76C-----------------------------------------------
77 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
78 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
79 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
80 TYPE (UNIT_TYPE_), INTENT(IN) :: UNITAB
81 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
82C-----------------------------------------------
83C E x t e r n a l F u n c t i o n s
84C-----------------------------------------------
85 INTEGER USR2SYS
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 CHARACTER MESS*40
90 CHARACTER(LEN=NCHARLINE) :: KEY2
91 CHARACTER(LEN=NCHARTITLE) :: TITR
92 INTEGER :: II, JJ, IFUNC1, IFUNC2, IFUNC3, LNODID1, LNODID2, KK, ID, UID, J
93 DATA mess/'INFILE'/
94 INTEGER :: GRBRICID_LOC, GRQUADID_LOC, GRSH3NID_LOC
95 my_real :: x0, y0, z0, x1, y1, z1, norm, fac1, fac2, fac_vel
96 INTEGER :: SIZE, LL
97 LOGICAL :: FOUND
98 CHARACTER(LEN=NCHARLINE) :: FILENAME
99 CHARACTER MSG_DESCRIPTION*32
100 LOGICAL :: IS_AVAILABLE
101
102 IF (ninimap1d > 0) THEN
103 WRITE(iout, 2000)
104 ENDIF
105
106 is_available = .false.
107
108 CALL hm_option_start('/INIMAP1D')
109
110 DO kk = 1, ninimap1d
111 inimap1d(kk)%CORRECTLY_READ=.true.
112 CALL hm_option_read_key(lsubmodel, option_id = id, unit_id = uid, option_titr = titr,
113 . keyword2 = key2)
114 inimap1d(kk)%ID = id
115 inimap1d(kk)%TITLE = trim(titr)
116 WRITE(iout, 2001) id
117 WRITE(iout, 2002) trim(titr)
118 inimap1d(kk)%FILE = .false.
119 IF (key2(1:2) == 'VP') THEN
120 inimap1d(kk)%FORMULATION = 1
121 WRITE(iout, 2010)
122 ELSE IF (key2(1:2) == 'VE') THEN
123 inimap1d(kk)%FORMULATION = 2
124 WRITE(iout, 2020)
125 ELSE IF (key2(1:5) == 'FILE ') THEN
126 inimap1d(kk)%FORMULATION = 1
127 inimap1d(kk)%FILE = .true.
128 WRITE(iout, 2025)
129 ENDIF
130
131 inimap1d(kk)%PROJ = -1
132 CALL hm_get_intv('type', inimap1d(kk)%PROJ, is_available, lsubmodel)
133 inimap1d(kk)%NODEID1 = -1
134 inimap1d(kk)%NODEID2 = -1
135
136 IF (inimap1d(kk)%PROJ == 3) THEN
137C Spherical mapping
138C --> Read 1 node
139 CALL hm_get_intv('node_ID1', inimap1d(kk)%NODEID1, is_available, lsubmodel)
140 WRITE(iout, 2030) "SPHERICAL"
141 ELSE IF (inimap1d(kk)%PROJ == 1) THEN
142C Planar mapping
143C --> Read 2 nodes
144 CALL hm_get_intv('node_ID1', inimap1d(kk)%NODEID1, is_available, lsubmodel)
145 CALL hm_get_intv('node_ID2', inimap1d(kk)%NODEID2, is_available, lsubmodel)
146 WRITE(iout, 2030) "PLANAR"
147 ELSE IF (inimap1d(kk)%PROJ == 2) THEN
148C Cylindrical mapping
149C --> Read 2 nodes
150 CALL hm_get_intv('node_ID1', inimap1d(kk)%NODEID1, is_available, lsubmodel)
151 CALL hm_get_intv('node_id2', INIMAP1D(KK)%NODEID2, IS_AVAILABLE, LSUBMODEL)
152 WRITE(IOUT, 2030) "CYLINDRICAL"
153 ENDIF
154
155 INIMAP1D(KK)%GRBRICID = 0
156 INIMAP1D(KK)%GRQUADID = 0
157 INIMAP1D(KK)%GRSH3NID = 0
158
159 CALL HM_GET_INTV('grbric_id', INIMAP1D(KK)%GRBRICID, IS_AVAILABLE, LSUBMODEL)
160 CALL HM_GET_INTV('grquad_id', INIMAP1D(KK)%GRQUADID, IS_AVAILABLE, LSUBMODEL)
161 CALL HM_GET_INTV('grtria_id', INIMAP1D(KK)%GRSH3NID, IS_AVAILABLE, LSUBMODEL)
162
163C ==============
164C Check if found
165C ==============
166 IF (INIMAP1D(KK)%GRBRICID + INIMAP1D(KK)%GRQUADID + INIMAP1D(KK)%GRSH3NID == 0) THEN
167 CALL ANCMSG(MSGID=1554, MSGTYPE=MSGWARNING, ANMODE=ANINFO,
168 . C1='in /inimap1d option')
169 ELSE
170 GRBRICID_LOC = -1
171 GRQUADID_LOC = -1
172 GRSH3NID_LOC = -1
173 IF (INIMAP1D(KK)%GRBRICID /= 0) THEN
174 DO J = 1,NGRBRIC
175 IF (INIMAP1D(KK)%GRBRICID == IGRBRIC(J)%ID) THEN
176 GRBRICID_LOC = J
177 INIMAP1D(KK)%GRBRICID = J
178 EXIT
179 ENDIF
180 ENDDO
181 IF (GRBRICID_LOC == -1) THEN
182 CALL ANCMSG(MSGID=1554,
183 . MSGTYPE=MSGERROR,
184 . ANMODE=ANINFO,
185 . C1='in /inimap1d option',
186 . I1=INIMAP1D(KK)%GRBRICID)
187 ENDIF
188 ENDIF
189 IF (INIMAP1D(KK)%GRQUADID /= 0) THEN
190 DO J = 1,NGRQUAD
191 IF (INIMAP1D(KK)%GRQUADID == IGRQUAD(J)%ID) THEN
192 GRQUADID_LOC = J
193 INIMAP1D(KK)%GRQUADID = J
194 EXIT
195 ENDIF
196 ENDDO
197 IF (GRQUADID_LOC == -1) THEN
198 CALL ANCMSG(MSGID=1554,
199 . MSGTYPE=MSGERROR,
200 . ANMODE=ANINFO,
201 . C1='in /inimap1d option',
202 . I1=INIMAP1D(KK)%GRQUADID)
203 ENDIF
204 ENDIF
205 IF (INIMAP1D(KK)%GRSH3NID /= 0) THEN
206 DO J = 1,NGRSH3N
207 IF (INIMAP1D(KK)%GRSH3NID == IGRSH3N(J)%ID) THEN
208 GRSH3NID_LOC = J
209 INIMAP1D(KK)%GRSH3NID = J
210 EXIT
211 ENDIF
212 ENDDO
213 IF (GRSH3NID_LOC == -1) THEN
214 CALL ANCMSG(MSGID=1554,
215 . MSGTYPE=MSGERROR,
216 . ANMODE=ANINFO,
217 . C1='in /inimap1d option',
218 . I1=INIMAP1D(KK)%GRSH3NID)
219 ENDIF
220 ENDIF
221 ENDIF
222
223C ==============
224C functions
225C ==============
226.NOT. IF( INIMAP1D(KK)%FILE)THEN
227 CALL HM_GET_INTV('fun_idv', IFUNC3, IS_AVAILABLE, LSUBMODEL)
228 CALL HM_GET_FLOATV('fscalev', FAC_VEL, IS_AVAILABLE, LSUBMODEL, UNITAB)
229
230 MSG_DESCRIPTION = 'cannot READ velocity FUNCTION id'
231 WRITE(IOUT, 2040) IFUNC3, FAC_VEL
232 IF (IFUNC3 > 0) THEN
233 JJ = 0
234 FOUND = .FALSE.
235 DO II = NFUNCT + 2, 2 * NFUNCT + 1
236 JJ = JJ + 1
237 IF (NPC(II) == IFUNC3) THEN
238 INIMAP1D(KK)%FUNC_VEL = JJ
239 FOUND = .TRUE.
240 EXIT
241 ENDIF
242 ENDDO
243.NOT. IF ( FOUND) THEN
244 CALL ANCMSG(MSGID = 120, MSGTYPE = MSGERROR, ANMODE = ANINFO,
245 . C1 = 'in /inimap1d option', I1 = IFUNC3)
246 ENDIF
247 ELSE
248 INIMAP1D(KK)%FUNC_VEL = 0
249 ENDIF
250 IF (FAC_VEL == ZERO) FAC_VEL = ONE
251 INIMAP1D(KK)%FAC_VEL = FAC_VEL
252
253 CALL HM_GET_INTV('nb_integr', SIZE, IS_AVAILABLE, LSUBMODEL)
254
255 INIMAP1D(KK)%NBMAT = SIZE
256 ALLOCATE(INIMAP1D(KK)%FUNC_ALPHA(SIZE), INIMAP1D(KK)%FUNC_RHO(SIZE),
257 . INIMAP1D(KK)%FUNC_ENER(SIZE), INIMAP1D(KK)%FUNC_PRES(SIZE),
258 . INIMAP1D(KK)%FAC_PRES_ENER(SIZE), INIMAP1D(KK)%FAC_RHO(SIZE))
259 INIMAP1D(KK)%FUNC_ALPHA(1:SIZE) = 0
260 DO LL = 1, SIZE
261 CALL HM_GET_INT_ARRAY_INDEX('fct_idvfi', IFUNC1, LL, IS_AVAILABLE, LSUBMODEL)
262 CALL HM_GET_INT_ARRAY_INDEX('fct_idri', IFUNC2, LL, IS_AVAILABLE, LSUBMODEL)
263 CALL HM_GET_FLOAT_ARRAY_INDEX('fscalerhoi', FAC1, LL, IS_AVAILABLE, LSUBMODEL, UNITAB)
264 CALL HM_GET_INT_ARRAY_INDEX('fct_idpei', IFUNC3, LL, IS_AVAILABLE, LSUBMODEL)
265 CALL HM_GET_FLOAT_ARRAY_INDEX('fscalepei', FAC2, LL, IS_AVAILABLE, LSUBMODEL, UNITAB)
266
267C FUNC_RHO, FUNC_PRES AND FUNC_VEL
268C OR FUNC_RHO, FUNC_ENER AND FUNC_VEL depending on the forumlation
269 IF (IFUNC1 > 0) THEN
270 JJ = 0
271 FOUND = .FALSE.
272 DO II = NFUNCT + 2, 2 * NFUNCT + 1
273 JJ = JJ + 1
274 IF (NPC(II) == IFUNC1) THEN
275 INIMAP1D(KK)%FUNC_ALPHA(LL) = JJ
276 FOUND = .TRUE.
277 EXIT
278 ENDIF
279 ENDDO
280.NOT. IF ( FOUND) THEN
281 CALL ANCMSG(MSGID = 120, MSGTYPE = MSGERROR, ANMODE = ANINFO,
282 . C1 = 'in /inimap1d option', I1 = IFUNC3)
283 ENDIF
284 ELSE
285 INIMAP1D(KK)%FUNC_ALPHA(LL) = 0
286 ENDIF
287 IF (IFUNC2 > 0) THEN
288 JJ = 0
289 FOUND = .FALSE.
290 DO II = NFUNCT + 2, 2 * NFUNCT + 1
291 JJ = JJ + 1
292 IF (NPC(II) == IFUNC2) THEN
293 INIMAP1D(KK)%FUNC_RHO(LL) = JJ
294 FOUND = .TRUE.
295 EXIT
296 ENDIF
297 ENDDO
298.NOT. IF ( FOUND) THEN
299 CALL ANCMSG(MSGID = 120, MSGTYPE = MSGERROR, ANMODE = ANINFO,
300 . C1 = 'in /inimap1d option', I1 = IFUNC3)
301 ENDIF
302 ELSE
303 INIMAP1D(KK)%FUNC_RHO(LL) = 0
304 ENDIF
305 IF (IFUNC3 > 0) THEN
306 JJ = 0
307 FOUND = .FALSE.
308 DO II = NFUNCT + 2, 2 * NFUNCT + 1
309 JJ = JJ + 1
310 IF (NPC(II) == IFUNC3) THEN
311 IF (INIMAP1D(KK)%FORMULATION == 1) THEN
312 INIMAP1D(KK)%FUNC_PRES(LL) = JJ
313 INIMAP1D(KK)%FUNC_ENER(LL) = 0
314 ENDIF
315 IF (INIMAP1D(KK)%FORMULATION == 2) THEN
316 INIMAP1D(KK)%FUNC_ENER(LL) = JJ
317 INIMAP1D(KK)%FUNC_PRES(LL) = 0
318 ENDIF
319 FOUND = .TRUE.
320 EXIT
321 ENDIF
322 ENDDO
323.NOT. IF ( FOUND) THEN
324 CALL ANCMSG(MSGID = 120, MSGTYPE = MSGERROR, ANMODE = ANINFO,
325 . C1 = 'in /inimap1d option', I1 = IFUNC3)
326 ENDIF
327 ELSE
328 INIMAP1D(KK)%FUNC_PRES(LL) = 0
329 INIMAP1D(KK)%FUNC_ENER(LL) = 0
330 ENDIF
331 IF (FAC1 == ZERO) FAC1 = ONE
332 IF (FAC2 == ZERO) FAC2 = ONE
333 INIMAP1D(KK)%FAC_RHO(LL) = FAC1
334 INIMAP1D(KK)%FAC_PRES_ENER(LL) = FAC2
335 IF (INIMAP1D(KK)%FORMULATION == 1) THEN
336 WRITE(IOUT, 2060) LL, IFUNC1, IFUNC2, FAC1, IFUNC3, FAC2
337 ENDIF
338 IF (INIMAP1D(KK)%FORMULATION == 2) THEN
339 WRITE(IOUT, 2050) LL, IFUNC1, IFUNC2, FAC1, IFUNC3, FAC2
340 ENDIF
341 ENDDO
342
343 ELSEIF(INIMAP1D(KK)%FILE)THEN
344 CALL HM_GET_STRING('filename', FILENAME, ncharline, IS_AVAILABLE)
345 WRITE(IOUT, 2026)TRIM(FILENAME)
346 CALL LEC_INIMAP1D_FILE(INIMAP1D(KK), FILENAME, ID, TITR)
347 ENDIF
348
349 IF (INIMAP1D(KK)%NODEID1 > 0) THEN
350 LNODID1 = USR2SYS(INIMAP1D(KK)%NODEID1, ITABM1, MESS, INIMAP1D(KK)%NODEID1)
351 INIMAP1D(KK)%NODEID1 = LNODID1
352 ENDIF
353 IF (INIMAP1D(KK)%NODEID2 > 0) THEN
354 LNODID2 = USR2SYS(INIMAP1D(KK)%NODEID2, ITABM1, MESS, INIMAP1D(KK)%NODEID2)
355 INIMAP1D(KK)%NODEID2 = LNODID2
356 ENDIF
357 IF (INIMAP1D(KK)%PROJ == 1) THEN
358 X0 = X(1, LNODID1)
359 Y0 = X(2, LNODID1)
360 Z0 = X(3, LNODID1)
361 X1 = X(1, LNODID2)
362 Y1 = X(2, LNODID2)
363 Z1 = X(3, LNODID2)
364 NORM = SQRT((X1 - X0) * (X1 - X0) + (Y1 - Y0) * (Y1 - Y0) +
365 . (Z1 - Z0) * (Z1 - Z0))
366 INIMAP1D(KK)%NX = (X1 - X0) / NORM
367 INIMAP1D(KK)%NY = (Y1 - Y0) / NORM
368 INIMAP1D(KK)%NZ = (Z1 - Z0) / NORM
369 IF(N2D /=0 )INIMAP1D(KK)%NX = ZERO !force to 0.00 instead of epsilon : Y,Z only in 2D
370 ENDIF
371
372 ENDDO ! KK = 1, NINIMAP1D
373
374 RETURN
375 2000 FORMAT(//
376 .' 1d initial mapping (/INIMAP1D) '/
377 .' ------------------------------ ')
378 2001 FORMAT(' ID : ', 1x, i10)
379 2002 FORMAT(' TITLE : ', a)
380 2010 FORMAT(' FORMULATION : VP (INITIALIZATION FROM DENSITY AND PRESSURE FUNCTIONS)')
381 2020 FORMAT(' FORMULATION : VE (INITIALIZATION FROM DENSITY AND SPECIFIC EINT FUNCTIONS)')
382 2025 FORMAT(' FORMULATION : FILE (INITIALIZATION FROM STATE FILE)')
383 2026 FORMAT(' FILENAME : ', a)
384 2030 FORMAT(' MAPPING TYPE : ', a)
385 2040 FORMAT(' --VELOCITY FUNCT ID, SCALE FACTOR: ', i10, 1pg20.13)
386 2050 FORMAT(' PHASE ', i10,
387 . /, ' VOLUME FRACTION FUNCT ID: ', i10,
388 . /, ' MASS DENSITY FUNCT ID, SCALE FACTOR: ', i10, 1pg20.13,
389 . /, ' SPECIFIC ENERGY FUNCT ID, SCALE FACTOR: ', i10, 1pg20.13)
390 2060 FORMAT(' PHASE ', i10,
391 . /, ' VOLUME FRACTION FUNCT ID: ', i10,
392 . /, ' MASS DENSITY FUNCT ID, SCALE FACTOR: ', i10, 1pg20.13,
393 . /, ' PRESSURE FUNCT ID, SCALE FACTOR: ', i10, 1pg20.13)
394 END SUBROUTINE hm_read_inimap1d
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_read_inimap1d
subroutine hm_read_inimap1d(inimap1d, npc, itabm1, x, igrbric, igrquad, igrsh3n, multi_fvm, unitab, lsubmodel)
Definition hm_read_inimap1d.F:46
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
inimap1d_mod
Definition inimap1d_mod.F:35
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::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1006
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
starter
program starter
Definition starter.F:39
inimap1d_mod::inimap1d_struct
Definition inimap1d_mod.F:45
submodel_mod::submodel_data
Definition submodel_mod.F:728
velocity
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29