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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_impflux (ib, fac, itab, ixs, igrsurf, unitab, igrnod, igrbric, lsubmodel, nimpflux, nitflux, lfacther)

Function/Subroutine Documentation

◆ hm_read_impflux()

subroutine hm_read_impflux ( integer, dimension(nitflux,*) ib,
fac,
integer, dimension(*) itab,
integer, dimension(nixs,*) ixs,
type (surf_), dimension(nsurf) igrsurf,
type (unit_type_), intent(in) unitab,
type (group_), dimension(ngrnod) igrnod,
type (group_), dimension(ngrbric) igrbric,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(in) nimpflux,
integer, intent(in) nitflux,
integer, intent(in) lfacther )

Definition at line 39 of file hm_read_impflux.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE message_mod
47 USE groupdef_mod
48 USE submodel_mod
49 USE hm_option_read_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51 use element_mod , only : nixs
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "param_c.inc"
60#include "units_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 ,INTENT(IN) :: NIMPFLUX
67 INTEGER ,INTENT(IN) :: NITFLUX
68 INTEGER ,INTENT(IN) :: LFACTHER
69 INTEGER IB(NITFLUX,*), ITAB(*), IXS(NIXS,*)
70C
71 my_real fac(lfacther,*)
72
73 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
74C-----------------------------------------------
75 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
76 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
77 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I, J, K, I1, I2, IFU, ISENS, NN, ISU, IS,
82 . ID, UID, IFLAGUNIT, ITY
83 INTEGER IEL, IGBR, K1, K2
84C
85 my_real fcx, fcy, fcx_dim, fcy_dim
86 my_real tstart, tstop, tstop_dim
87 CHARACTER MESS*40
88 CHARACTER(LEN=NCHARTITLE)::TITR
89 LOGICAL IS_AVAILABLE
90C-----------------------------------------------
91C E x t e r n a l F u n c t i o n s
92C-----------------------------------------------
93 DATA mess/'THERMAL FLUX DEFINITION '/
94C=======================================================================
95 is_available = .false.
96 k =0
97 k1=0
98 k2=0
99C--------------------------------------------------
100C START BROWSING MODEL THERMAL FLUX
101C--------------------------------------------------
102 CALL hm_option_start('/IMPFLUX')
103C--------------------------------------------------
104C BROWSING /RADIATION OPTIONS 1->NIMPFLUX
105C--------------------------------------------------
106 DO i=1,nimpflux
107 titr = ''
108C--------------------------------------------------
109C EXTRACT DATAS OF /IMPFLUX/... LINE
110C--------------------------------------------------
111 CALL hm_option_read_key(lsubmodel,
112 . unit_id = uid,
113 . option_id = id,
114 . option_titr = titr)
115C--------------------------------------------------
116C EXTRACT DATAS (INTEGER VALUES)
117C--------------------------------------------------
118 CALL hm_get_intv('entityid',isu,is_available,lsubmodel)
119 CALL hm_get_intv('curveid',ifu,is_available,lsubmodel)
120 CALL hm_get_intv('rad_sensor_id',isens,is_available,lsubmodel)
121 CALL hm_get_intv('grbrick_id',igbr,is_available,lsubmodel)
122C--------------------------------------------------
123C EXTRACT DATAS (REAL VALUES)
124C--------------------------------------------------
125 CALL hm_get_floatv('xscale',fcx,is_available,lsubmodel,unitab)
126 CALL hm_get_floatv_dim('xscale',fcx_dim,is_available,lsubmodel,unitab)
127 CALL hm_get_floatv('magnitude',fcy,is_available,lsubmodel,unitab)
128 CALL hm_get_floatv_dim('magnitude',fcy_dim,is_available,lsubmodel,unitab)
129 CALL hm_get_floatv('rad_tstart',tstart,is_available,lsubmodel,unitab)
130 CALL hm_get_floatv('rad_tstop',tstop,is_available,lsubmodel,unitab)
131 CALL hm_get_floatv_dim('rad_tstop',tstop_dim,is_available,lsubmodel,unitab)
132C--------------------------------------------------
133 iflagunit = 0
134 DO j=1,unitab%NUNITS
135 IF (unitab%UNIT_ID(j) == uid) THEN
136 iflagunit = 1
137 EXIT
138 ENDIF
139 ENDDO
140 IF (uid /= 0.AND.iflagunit == 0) THEN
141 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
142 . i2=uid,i1=id,c1='HEAT FLUX',
143 . c2='HEAT FLUX',c3=titr)
144 ENDIF
145 IF(isu /= 0 .AND. igbr /=0) THEN
146 CALL ancmsg(msgid=1229,anmode=aninfo,msgtype=msgerror,c1=titr,i1=isu,i2=igbr)
147 ENDIF
148C
149 IF (fcx == zero) fcx = fcx_dim
150 IF (fcy == zero) fcy = fcy_dim
151 IF(tstop == zero) tstop= ep30 * tstop_dim
152C
153 IF(isu > 0) THEN
154 is=0
155 DO j=1,nsurf
156 IF (isu == igrsurf(j)%ID) is=j
157 ENDDO
158 IF(is > 0)THEN
159 nn =igrsurf(is)%NSEG
160 DO j=1,nn
161 k=k+1
162 k1=k1+1
163 ib(1,k)=igrsurf(is)%NODES(j,1)
164 ib(2,k)=igrsurf(is)%NODES(j,2)
165 ib(3,k)=igrsurf(is)%NODES(j,3)
166 ity =igrsurf(is)%ELTYP(j)
167 IF(ity==7)THEN
168C true triangles (not segments built from 3 nodes).
169 ib(4,k)=0
170 ELSE
171 ib(4,k)=igrsurf(is)%NODES(j,4)
172 ENDIF
173 ib(5,k) = ifu
174 ib(6,k) = isens
175 ib(7,k) = igrsurf(is)%ELTYP(j)
176 ib(8,k) = igrsurf(is)%ELEM(j)
177 IF(ity == 1) THEN
178 ib(9,k) = ixs(11,igrsurf(is)%ELEM(j))
179 ELSE
180 ib(9,k) = 0
181 ENDIF
182 ib(10,k) = 0
183C
184 fac(1,k) = fcy
185 fac(2,k) = one/fcx
186 fac(3,k) = zero
187 fac(4,k) = tstart
188 fac(5,k) = tstop
189 fac(6,k) = one
190 ENDDO
191 ELSE
192 CALL ancmsg(msgid=1230,anmode=aninfo,msgtype=msgerror,c1=titr,i1=isu)
193 ENDIF
194C
195 ELSEIF(igbr > 0) THEN
196 is=0
197 DO j=1,ngrbric
198 IF (igbr == igrbric(j)%ID) is=j
199 ENDDO
200 IF(is > 0) THEN
201 nn = igrbric(is)%NENTITY
202 DO j=1,nn
203 k=k+1
204 k2=k2+1
205 iel = igrbric(is)%ENTITY(j)
206 ib(1,k) = 0
207 ib(2,k) = 0
208 ib(3,k) = 0
209 ib(4,k) = 0
210 ib(5,k) = ifu
211 ib(6,k) = isens
212 ib(8,k) = iel
213 ib(9,k) = ixs(11,iel)
214 ib(10,k) = 1
215C
216 fac(1,k) = fcy
217 fac(2,k) = one/fcx
218 fac(3,k) = zero
219 fac(4,k) = tstart
220 fac(5,k) = tstop
221 fac(6,k) = one
222 ENDDO
223 ELSE
224 CALL ancmsg(msgid=1231,anmode=aninfo,msgtype=msgerror,c1=titr,i1=igbr)
225 ENDIF
226 ENDIF
227 ENDDO ! I=1,NIMPFLUX
228C
229 IF(k1 > 0) THEN
230 i =0
231 i2=0
232 100 WRITE (iout,2000)
233 WRITE (iout,2001)
234 i1=0
235 150 i=i+1
236 IF(ib(10,i) == 0) THEN
237 i1=i1+1
238 i2=i2+1
239 WRITE (iout,'(5(1X,I10),2(1X,I10),1X,4G20.13)') i,
240 . itab(ib(1,i)),itab(ib(2,i)),itab(ib(3,i)),itab(ib(4,i)),
241 . ib(5,i),ib(6,i),fac(4,i),fac(5,i),one/fac(2,i),
242 . fac(1,i)
243 ENDIF
244 IF(i2 == k1)GO TO 200
245 IF(i1 < 50) GO TO 150
246 GO TO 100
247 200 CONTINUE
248 ENDIF
249C
250 IF(k2 > 0) THEN
251 i =0
252 i2=0
253 300 WRITE (iout,3000)
254 WRITE (iout,3001)
255 i1=0
256 350 i=i+1
257 IF(ib(10,i) == 1) THEN
258 i1=i1+1
259 i2=i2+1
260 WRITE (iout,'(2X,I10,2(2X,I10),1X,4G20.13)') ib(9,i),
261 . ib(5,i),ib(6,i),fac(4,i),fac(5,i),one/fac(2,i),
262 . fac(1,i)
263 ENDIF
264 IF(i2 == k2)GO TO 400
265 IF(i1 < 50) GO TO 350
266 GO TO 300
267 400 CONTINUE
268 ENDIF
269C
270 RETURN
271
272C
273 2000 FORMAT(//
274 .' SURFACIC HEAT FLUX DENSITY '/
275 .' -------------------------- ')
276 2001 FORMAT(/
277 .' SEGMENT NODE1 NODE2 NODE3 NODE4 ',
278 .' CURVE SENSOR T-START T-STOP', 8x,
279 .' SCALE-X SCALE-Y')
280 3000 FORMAT(//
281 .' VOLUMIC HEAT FLUX DENSITY '/
282 .' ------------------------- ')
283 3001 FORMAT(/
284 .' BRICK ELEMENT CURVE SENSOR T-START', 9x,
285 .' T-STOP SCALE-X SCALE-Y')
286
287C
288 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:161
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_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
id
initmumps id
Definition multiplerhs_example.m:4
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
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