OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_radiation.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_radiation (ib, fac, itab, ixs, igrsurf, unitab, lsubmodel, nradia, numradia, niradia, lfacther)

Function/Subroutine Documentation

◆ hm_read_radiation()

subroutine hm_read_radiation ( integer, dimension(niradia,*) ib,
fac,
integer, dimension(*) itab,
integer, dimension(nixs,*) ixs,
type (surf_), dimension(nsurf) igrsurf,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(in) nradia,
integer, intent(in) numradia,
integer, intent(in) niradia,
integer, intent(in) lfacther )

Definition at line 40 of file hm_read_radiation.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 INTEGER ,INTENT(IN) :: NRADIA
66 INTEGER ,INTENT(IN) :: NUMRADIA
67 INTEGER ,INTENT(IN) :: NIRADIA
68 INTEGER ,INTENT(IN) :: LFACTHER
69 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
70 INTEGER IB(NIRADIA,*), ITAB(*), IXS(NIXS,*)
71 my_real fac(lfacther,*)
72
73 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
74 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER K, M, I1, I2, I3, I4, IFU, I, ISENS,NPR0,NN,ISU,IS,
79 . ID,J,UID,IFLAGUNIT,ITY
80 my_real
81 . fcx, fcy, fac_l, fac_t, fac_m, emi, sigma, tstart, tstop,
82 . emiss(numradia),fcx_dim,fcy_dim,tstop_dim
83 CHARACTER MESS*40
84 CHARACTER(LEN=NCHARTITLE) :: TITR
85 LOGICAL IS_AVAILABLE
86C-----------------------------------------------
87C E x t e r n a l F u n c t i o n s
88C-----------------------------------------------
89 INTEGER USR2SYS
90 DATA mess/'RADIATIVE FLUX DEFINITION '/
91C=======================================================================
92 is_available = .false.
93 k = 0
94C--------------------------------------------------
95C START BROWSING MODEL RADIATION
96C--------------------------------------------------
97 CALL hm_option_start('/RADIATION')
98C--------------------------------------------------
99C BROWSING /RADIATION OPTIONS 1->NRADIA
100C--------------------------------------------------
101 DO i=1,nradia
102 titr = ''
103 CALL hm_option_read_key(lsubmodel,
104 . unit_id = uid,
105 . option_id = id,
106 . option_titr = titr)
107 iflagunit = 0
108 DO j=1,unitab%NUNITS
109 IF (unitab%UNIT_ID(j) == uid) THEN
110 iflagunit = 1
111 EXIT
112 ENDIF
113 ENDDO
114 IF (uid /= 0.AND.iflagunit == 0) THEN
115 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
116 . i2=uid,i1=id,c1='CONVECTION HEAT',
117 . c2='CONVECTION HEAT',
118 . c3=titr)
119 ENDIF
120C--------------------------------------------------
121C EXTRACT DATAS (INTEGER VALUES)
122C--------------------------------------------------
123 CALL hm_get_intv('entityid',isu,is_available,lsubmodel)
124 CALL hm_get_intv('curveid',ifu,is_available,lsubmodel)
125 CALL hm_get_intv('rad_sensor_id',isens,is_available,lsubmodel)
126C--------------------------------------------------
127C EXTRACT DATAS (REAL VALUES)
128C--------------------------------------------------
129 CALL hm_get_floatv('xscale',fcx,is_available,lsubmodel,unitab)
130 CALL hm_get_floatv_dim('xscale',fcx_dim,is_available,lsubmodel,unitab)
131 CALL hm_get_floatv('magnitude',fcy,is_available,lsubmodel,unitab)
132 CALL hm_get_floatv_dim('magnitude',fcy_dim,is_available,lsubmodel,unitab)
133 CALL hm_get_floatv('rad_tstart',tstart,is_available,lsubmodel,unitab)
134 CALL hm_get_floatv('rad_tstop',tstop,is_available,lsubmodel,unitab)
135 CALL hm_get_floatv_dim('rad_tstop',tstop_dim,is_available,lsubmodel,unitab)
136 CALL hm_get_floatv('flux',emi,is_available,lsubmodel,unitab)
137C--------------------------------------------------
138 IF (fcx == zero) fcx = fcx_dim
139 IF (fcy == zero) fcy = fcy_dim
140 IF(tstop == zero) tstop= ep30 * tstop_dim
141C
142 fac_m = unitab%FAC_M_WORK
143 fac_t = unitab%FAC_T_WORK
144 sigma=stefboltz*(fac_t*fac_t*fac_t)/fac_m
145C
146 is=0
147 DO j=1,nsurf
148 IF (isu == igrsurf(j)%ID) is=j
149 ENDDO
150 IF(is > 0)THEN
151 nn=igrsurf(is)%NSEG
152 DO j=1,nn
153 k=k+1
154 ib(1,k)=igrsurf(is)%NODES(j,1)
155 ib(2,k)=igrsurf(is)%NODES(j,2)
156 ib(3,k)=igrsurf(is)%NODES(j,3)
157 ity =igrsurf(is)%ELTYP(j)
158 IF(ity==7)THEN
159C true triangles (not segments built from 3 nodes).
160 ib(4,k)=0
161 ELSE
162 ib(4,k)=igrsurf(is)%NODES(j,4)
163 ENDIF
164 ib(5,k) = ifu
165 ib(6,k) = isens
166 ib(7,k) = igrsurf(is)%ELTYP(j)
167 ib(8,k) = igrsurf(is)%ELEM(j)
168 IF(ity == 1) THEN
169 ib(9,k) = ixs(11,igrsurf(is)%ELEM(j))
170 ELSE
171 ib(9,k) = 0
172 ENDIF
173C
174 fac(1,k) = fcy
175 fac(2,k) = one/fcx
176 fac(3,k) = emi*sigma
177 fac(4,k) = tstart
178 fac(5,k) = tstop
179 fac(6,k) = one
180C
181C temporary storage for print out.
182 emiss(k)=emi
183 ENDDO
184 ENDIF
185 ENDDO
186C
187 i1=1
188 i2=min0(50,numradia)
189C
190 90 WRITE (iout,2000)
191 WRITE (iout,2001)
192 DO i=i1,i2
193 WRITE (iout,'(5(1X,I10),1X,1F10.3,2(1X,I10),1X,4G20.13)') i,
194 . itab(ib(1,i)),itab(ib(2,i)),itab(ib(3,i)),itab(ib(4,i)),
195 . emiss(i),ib(5,i),ib(6,i),fac(4,i),fac(5,i),one/fac(2,i),
196 . fac(1,i)
197 ENDDO
198 IF(i2 == numradia)GOTO 200
199 i1=i1+50
200 i2=min0(i2+50,numradia)
201 GOTO 90
202 200 RETURN
203 300 CALL ancmsg(msgid=157,
204 . msgtype=msgerror,
205 . anmode=aninfo,
206 . i1=k)
207C---
208 2000 FORMAT(//
209 .' RADIATION HEAT '/
210 .' ---------------- ')
211 2001 FORMAT(/
212 .' SEGMENT NODE1 NODE2 NODE3 NODE4 EMISSIVITY',
213 .' CURVE SENSOR T-START T-STOP', 8x,
214 .' SCALE-X SCALE-Y')
215C-----------
216 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