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 40 of file hm_read_impflux.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE unitab_mod
47 USE message_mod
48 USE groupdef_mod
49 USE submodel_mod
50 USE hm_option_read_mod
51 USE names_and_titles_mod , ONLY : nchartitle
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 temp, 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 INTEGER USR2SYS
94 DATA mess/'THERMAL FLUX DEFINITION '/
95C=======================================================================
96 is_available = .false.
97 k =0
98 k1=0
99 k2=0
100C--------------------------------------------------
101C START BROWSING MODEL THERMAL FLUX
102C--------------------------------------------------
103 CALL hm_option_start('/IMPFLUX')
104C--------------------------------------------------
105C BROWSING /RADIATION OPTIONS 1->NIMPFLUX
106C--------------------------------------------------
107 DO i=1,nimpflux
108 titr = ''
109C--------------------------------------------------
110C EXTRACT DATAS OF /IMPFLUX/... LINE
111C--------------------------------------------------
112 CALL hm_option_read_key(lsubmodel,
113 . unit_id = uid,
114 . option_id = id,
115 . option_titr = titr)
116C--------------------------------------------------
117C EXTRACT DATAS (INTEGER VALUES)
118C--------------------------------------------------
119 CALL hm_get_intv('entityid',isu,is_available,lsubmodel)
120 CALL hm_get_intv('curveid',ifu,is_available,lsubmodel)
121 CALL hm_get_intv('rad_sensor_id',isens,is_available,lsubmodel)
122 CALL hm_get_intv('grbrick_id',igbr,is_available,lsubmodel)
123C--------------------------------------------------
124C EXTRACT DATAS (REAL VALUES)
125C--------------------------------------------------
126 CALL hm_get_floatv('xscale',fcx,is_available,lsubmodel,unitab)
127 CALL hm_get_floatv_dim('xscale',fcx_dim,is_available,lsubmodel,unitab)
128 CALL hm_get_floatv('magnitude',fcy,is_available,lsubmodel,unitab)
129 CALL hm_get_floatv_dim('magnitude',fcy_dim,is_available,lsubmodel,unitab)
130 CALL hm_get_floatv('rad_tstart',tstart,is_available,lsubmodel,unitab)
131 CALL hm_get_floatv('rad_tstop',tstop,is_available,lsubmodel,unitab)
132 CALL hm_get_floatv_dim('rad_tstop',tstop_dim,is_available,lsubmodel,unitab)
133C--------------------------------------------------
134 iflagunit = 0
135 DO j=1,unitab%NUNITS
136 IF (unitab%UNIT_ID(j) == uid) THEN
137 iflagunit = 1
138 EXIT
139 ENDIF
140 ENDDO
141 IF (uid /= 0.AND.iflagunit == 0) THEN
142 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
143 . i2=uid,i1=id,c1='HEAT FLUX',
144 . c2='HEAT FLUX',c3=titr)
145 ENDIF
146 IF(isu /= 0 .AND. igbr /=0) THEN
147 CALL ancmsg(msgid=1229,anmode=aninfo,msgtype=msgerror,c1=titr,i1=isu,i2=igbr)
148 ENDIF
149C
150 IF (fcx == zero) fcx = fcx_dim
151 IF (fcy == zero) fcy = fcy_dim
152 IF(tstop == zero) tstop= ep30 * tstop_dim
153C
154 IF(isu > 0) THEN
155 is=0
156 DO j=1,nsurf
157 IF (isu == igrsurf(j)%ID) is=j
158 ENDDO
159 IF(is > 0)THEN
160 nn =igrsurf(is)%NSEG
161 DO j=1,nn
162 k=k+1
163 k1=k1+1
164 ib(1,k)=igrsurf(is)%NODES(j,1)
165 ib(2,k)=igrsurf(is)%NODES(j,2)
166 ib(3,k)=igrsurf(is)%NODES(j,3)
167 ity =igrsurf(is)%ELTYP(j)
168 IF(ity==7)THEN
169C true triangles (not segments built from 3 nodes).
170 ib(4,k)=0
171 ELSE
172 ib(4,k)=igrsurf(is)%NODES(j,4)
173 ENDIF
174 ib(5,k) = ifu
175 ib(6,k) = isens
176 ib(7,k) = igrsurf(is)%ELTYP(is)
177 ib(8,k) = igrsurf(is)%ELEM(is)
178 IF(ity == 1) THEN
179 ib(9,k) = ixs(11,igrsurf(is)%ELEM(j))
180 ELSE
181 ib(9,k) = 0
182 ENDIF
183 ib(10,k) = 0
184C
185 fac(1,k) = fcy
186 fac(2,k) = one/fcx
187 fac(3,k) = zero
188 fac(4,k) = tstart
189 fac(5,k) = tstop
190 fac(6,k) = one
191 ENDDO
192 ELSE
193 CALL ancmsg(msgid=1230,anmode=aninfo,msgtype=msgerror,c1=titr,i1=isu)
194 ENDIF
195C
196 ELSEIF(igbr > 0) THEN
197 is=0
198 DO j=1,ngrbric
199 IF (igbr == igrbric(j)%ID) is=j
200 ENDDO
201 IF(is > 0) THEN
202 nn = igrbric(is)%NENTITY
203 DO j=1,nn
204 k=k+1
205 k2=k2+1
206 iel = igrbric(is)%ENTITY(j)
207 ib(1,k) = 0
208 ib(2,k) = 0
209 ib(3,k) = 0
210 ib(4,k) = 0
211 ib(5,k) = ifu
212 ib(6,k) = isens
213 ib(8,k) = iel
214 ib(9,k) = ixs(11,iel)
215 ib(10,k) = 1
216C
217 fac(1,k) = fcy
218 fac(2,k) = one/fcx
219 fac(3,k) = zero
220 fac(4,k) = tstart
221 fac(5,k) = tstop
222 fac(6,k) = one
223 ENDDO
224 ELSE
225 CALL ancmsg(msgid=1231,anmode=aninfo,msgtype=msgerror,c1=titr,i1=igbr)
226 ENDIF
227 ENDIF
228 ENDDO ! I=1,NIMPFLUX
229C
230 IF(k1 > 0) THEN
231 i =0
232 i2=0
233 100 WRITE (iout,2000)
234 WRITE (iout,2001)
235 i1=0
236 150 i=i+1
237 IF(ib(10,i) == 0) THEN
238 i1=i1+1
239 i2=i2+1
240 WRITE (iout,'(5(1X,I10),2(1X,I10),1X,4G20.13)') i,
241 . itab(ib(1,i)),itab(ib(2,i)),itab(ib(3,i)),itab(ib(4,i)),
242 . ib(5,i),ib(6,i),fac(4,i),fac(5,i),one/fac(2,i),
243 . fac(1,i)
244 ENDIF
245 IF(i2 == k1)GO TO 200
246 IF(i1 < 50) GO TO 150
247 GO TO 100
248 200 CONTINUE
249 ENDIF
250C
251 IF(k2 > 0) THEN
252 i =0
253 i2=0
254 300 WRITE (iout,3000)
255 WRITE (iout,3001)
256 i1=0
257 350 i=i+1
258 IF(ib(10,i) == 1) THEN
259 i1=i1+1
260 i2=i2+1
261 WRITE (iout,'(2X,I10,2(2X,I10),1X,4G20.13)') ib(9,i),
262 . ib(5,i),ib(6,i),fac(4,i),fac(5,i),one/fac(2,i),
263 . fac(1,i)
264 ENDIF
265 IF(i2 == k2)GO TO 400
266 IF(i1 < 50) GO TO 350
267 GO TO 300
268 400 CONTINUE
269 ENDIF
270C
271 RETURN
272
273C
274 2000 FORMAT(//
275 .' SURFACIC HEAT FLUX DENSITY '/
276 .' -------------------------- ')
277 2001 FORMAT(/
278 .' SEGMENT NODE1 NODE2 NODE3 NODE4 ',
279 .' CURVE SENSOR T-START T-STOP', 8x,
280 .' SCALE-X SCALE-Y')
281 3000 FORMAT(//
282 .' VOLUMIC HEAT FLUX DENSITY '/
283 .' ------------------------- ')
284 3001 FORMAT(/
285 .' BRICK ELEMENT CURVE SENSOR T-START', 9x,
286 .' T-STOP SCALE-X SCALE-Y')
287
288C
289 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:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
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
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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