OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_initemp.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_initemp ../starter/source/initial_conditions/thermic/hm_read_initemp.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_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!|| udouble ../starter/source/system/sysfus.F
36!|| usr2sys ../starter/source/system/sysfus.F
37!||--- uses -----------------------------------------------------
38!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
39!|| message_mod ../starter/share/message_module/message_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_initemp(TEMP ,NINTEMP ,ITHERM_FE,ITAB ,ITABM1 ,
43 . IGRNOD ,INITIDS ,UNITAB ,LSUBMODEL)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE unitab_mod
48 USE message_mod
49 USE groupdef_mod
50 USE submodel_mod
51 USE hm_option_read_mod
52 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com01_c.inc"
61#include "com04_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
66 INTEGER ITAB(*), ITABM1(*),INITIDS(*)
67 INTEGER ,INTENT(IN) :: NINTEMP
68 INTEGER ,INTENT(IN) :: ITHERM_FE
69 my_real :: temp(*)
70 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
71C-----------------------------------------------
72 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I,J,NNOD,NOSYS,ID,IGR,IGRS,NBTEMP,BID,
77 . uid,typ,nod,nodsys,nb_line
78 my_real
79 . temp0
80 CHARACTER MESS*40
81 CHARACTER(LEN=NCHARTITLE) :: TITR
82 LOGICAL IS_AVAILABLE
83 my_real, DIMENSION(:), ALLOCATABLE :: list_temp0
84 INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_NOD
85C-----------------------------------------------
86C E x t e r n a l F u n c t i o n s
87C-----------------------------------------------
88 INTEGER USR2SYS
89 DATA mess/'INITIAL TEMPERATURE DEFINITION '/
90C=======================================================================
91 bid =0
92 nbtemp = 0
93 is_available = .false.
94 nb_line = 0
95C--------------------------------------------------
96C START BROWSING MODEL INITEMP
97C--------------------------------------------------
98 CALL hm_option_start('/INITEMP')
99C--------------------------------------------------
100C BROWSING /INITEMP OPTIONS 1->NRADIA
101C--------------------------------------------------
102 DO i=1,nintemp
103 titr = ''
104 CALL hm_option_read_key(lsubmodel,
105 . unit_id = uid,
106 . option_id = id,
107 . option_titr = titr)
108
109! IF (ITHERM_FE == 0) THEN
110! CALL ANCMSG(MSGID=858,
111! . MSGTYPE=MSGERROR,
112! . ANMODE=ANINFO)
113! ENDIF
114C--------------------------------------------------
115C EXTRACT DATAS (INTEGER VALUES)
116C--------------------------------------------------
117 CALL hm_get_intv('distribution',typ,is_available,lsubmodel)
118 CALL hm_get_intv('entityid',igr,is_available,lsubmodel)
119 IF (typ == 1) THEN
120 CALL hm_get_intv('grnd_ID',igr,is_available,lsubmodel)
121 CALL hm_get_intv('distribution_table_count',nb_line,is_available,lsubmodel)
122 IF(.NOT.ALLOCATED(list_nod)) ALLOCATE(list_nod(nb_line))
123 list_nod(1:nb_line) = 0
124 IF(.NOT.ALLOCATED(list_temp0)) ALLOCATE(list_temp0(nb_line))
125 list_temp0(1:nb_line) = zero
126 DO j=1,nb_line
127 CALL hm_get_int_array_index('location_unit_node',list_nod(j),j,is_available,lsubmodel)
128 ENDDO
129 ENDIF
130C--------------------------------------------------
131C EXTRACT DATAS (REAL VALUES)
132C--------------------------------------------------
133 IF (typ == 0) THEN
134 CALL hm_get_floatv('magnitude',temp0,is_available,lsubmodel,unitab)
135 ELSEIF (typ == 1) THEN
136 CALL hm_get_float_array_index('T0',temp0,j,is_available,lsubmodel,unitab)
137 DO j=1,nb_line
138 CALL hm_get_float_array_index('magnitude',list_temp0(j),j,is_available,lsubmodel,unitab)
139 ENDDO
140 ENDIF
141C--------------------------------------------------
142 nbtemp = nbtemp+1
143 initids(nbtemp)=id
144 igrs=0
145 IF (typ == 0) THEN
146 IF (igr == 0)THEN
147 CALL ancmsg(msgid=668,
148 . msgtype=msgerror,
149 . anmode=aninfo,
150 . c1='/INITEM',
151 . c2='/INITEM',
152 . c3=titr,
153 . i1=id)
154 ENDIF
155 DO j=1,ngrnod
156 IF (igr == igrnod(j)%ID) igrs=j
157 ENDDO
158 IF(igrs /= 0)THEN
159 DO j=1,igrnod(igrs)%NENTITY
160 nosys=igrnod(igrs)%ENTITY(j)
161 temp(nosys)= temp0
162 ENDDO
163 nnod=igrnod(igrs)%NENTITY
164 ELSE
165 CALL ancmsg(msgid=53,
166 . msgtype=msgerror,
167 . anmode=aninfo,
168 . c1='IN /INITEM OPTION',
169 . i1=igr)
170 ENDIF
171 ELSE
172 DO j=1,ngrnod
173 IF (igr == igrnod(j)%ID) igrs=j
174 ENDDO
175 IF(igrs /= 0)THEN
176 DO j=1,igrnod(igrs)%NENTITY
177 nosys=igrnod(igrs)%ENTITY(j)
178 temp(nosys)= temp0
179 ENDDO
180 nnod=igrnod(igrs)%NENTITY
181 ENDIF
182 DO j=1,nb_line
183 nodsys=usr2sys(list_nod(j),itabm1,mess,id)
184 IF (list_nod(j) == 0) THEN
185 CALL ancmsg(msgid=78,
186 . msgtype=msgerror,
187 . anmode=aninfo,
188 . c1='/initem',
189 . I1=ID,
190 . I2=NOD)
191 ENDIF
192 IF (NODSYS /= 0) TEMP(NODSYS)= LIST_TEMP0(J)
193 ENDDO
194 ENDIF
195 IF(ALLOCATED(LIST_TEMP0)) DEALLOCATE(LIST_TEMP0)
196 IF(ALLOCATED(LIST_NOD)) DEALLOCATE(LIST_NOD)
197 ENDDO
198C---
199 CALL UDOUBLE(INITIDS,1,NBTEMP,MESS,0,BID)
200C--------------------------------------------------
201C PRINT
202C--------------------------------------------------
203 J=0
204 RETURN
205 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
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:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_read_initemp
subroutine hm_read_initemp(temp, nintemp, itherm_fe, itab, itabm1, igrnod, initids, unitab, lsubmodel)
Definition hm_read_initemp.F:44
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
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
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:728