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