OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_convec.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_convec ../starter/source/loads/thermic/hm_read_convec.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
33!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
34!|| usr2sys ../starter/source/system/sysfus.F
35!||--- uses -----------------------------------------------------
36!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_convec(IB, FAC, ITAB, IXS ,IGRSURF,UNITAB ,LSUBMODEL,
41 . NCONVEC, NICONV, NUMCONV, LFACTHER)
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
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
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
209 END
210
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_start(entity_type)
subroutine hm_read_convec(ib, fac, itab, ixs, igrsurf, unitab, lsubmodel, nconvec, niconv, numconv, lfacther)
initmumps id
integer, parameter nchartitle
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