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