OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_convec.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_convec (ib, fac, itab, ixs, igrsurf, unitab, lsubmodel, nconvec, niconv, numconv, lfacther)

Function/Subroutine Documentation

◆ hm_read_convec()

subroutine hm_read_convec ( integer, dimension(niconv,*) 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) nconvec,
integer, intent(in) niconv,
integer, intent(in) numconv,
integer, intent(in) lfacther )

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