OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_pcyl.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "sphcom.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_pcyl (loads, igrsurf, nsensor, sensor_tab, table, iframe, unitab, lsubmodel, number_load_cyl)

Function/Subroutine Documentation

◆ hm_read_pcyl()

subroutine hm_read_pcyl ( type (loads_), intent(inout) loads,
type (surf_), dimension(nsurf), intent(in) igrsurf,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
type (ttable), dimension(ntable), intent(in) table,
integer, dimension(liskn,numfram+1), intent(in) iframe,
type (unit_type_), intent(in) unitab,
type (submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(inout) number_load_cyl )

Definition at line 42 of file hm_read_pcyl.F.

44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE my_alloc_mod
48 USE unitab_mod
49 USE message_mod
50 USE groupdef_mod
51 USE submodel_mod
52 USE hm_option_read_mod
53 USE loads_mod
54 USE table_mod
55 USE sensor_mod
56 USE names_and_titles_mod , ONLY : nchartitle
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "param_c.inc"
65#include "units_c.inc"
66#include "com04_c.inc"
67#include "sphcom.inc"
68#include "tabsiz_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER ,INTENT(IN) :: NSENSOR
73 INTEGER ,DIMENSION(LISKN,NUMFRAM+1) ,INTENT(IN) :: IFRAME
74 TYPE (SURF_) ,DIMENSION(NSURF) ,INTENT(IN) :: IGRSURF
75 TYPE (TTABLE) ,DIMENSION(NTABLE) ,INTENT(IN) :: TABLE
76 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR),INTENT(IN) :: SENSOR_TAB
77 TYPE (SUBMODEL_DATA) ,DIMENSION(*) ,INTENT(IN) :: LSUBMODEL
78 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
79 TYPE (LOADS_) ,INTENT(INOUT) :: LOADS
80 INTEGER, INTENT(INOUT) :: NUMBER_LOAD_CYL ! total number of contribution (1 per node per segment) of /LOAD/CYL
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER I,J,LOAD_ID,TABLE_ID,SURF_ID,SENS_ID,FRAME_ID,UID,ISENS,ISS,
85 . NOFRA,SUB_INDX,NSEG,ITABLE,STAT,NLOAD_CYL,IMOV
86 my_real :: x_r,x_t,yfac,fac_r,fac_t,fac_p
87 CHARACTER MESS*40
88 CHARACTER(LEN=NCHARTITLE) :: TITR
89 LOGICAL IS_AVAILABLE
90 DATA mess/'CYLINDRICAL PRESSURE LOADS DEFINITION '/
91C-----------------------------------------------
92C E x t e r n a l F u n c t i o n s
93C-----------------------------------------------
94 INTEGER NGR2USR
95 EXTERNAL ngr2usr
96C----------------------------------------------------------------------------------
97C C o m m e n t s
98C----------------------------------------------------------------------------------
99C /LOAD/PCYL : imposed pressure in function of radial coordinate around an axis and time
100C----------------------------------------------------------------------------------
101C LOAD_CYL
102c -> PCYL_ID
103c -> NSEG
104c -> SEGNOD(NSEG,4) (N1,N2,NB3,N4) by segment
105c -> AXIS(2) (M1,M2)
106c -> SENS_ID
107c -> TABLE_ID
108c -> XSCALE_R
109c -> XSCALE_T
110c -> YSCALE_P
111c -> SURFBOX(xmin,ymin,zmin,xmax,ymax,zmax)
112C=======================================================================
113 is_available = .false.
114 number_load_cyl = 0
115C--------------------------------------------------
116C START BROWSING MODEL /PCYL
117C--------------------------------------------------
118 CALL hm_option_count('/LOAD/PCYL',nload_cyl)
119 loads%NLOAD_CYL = nload_cyl
120 ALLOCATE(loads%LOAD_CYL(nload_cyl))
121
122 CALL hm_option_start('/LOAD/PCYL')
123C--------------------------------------------------
124 DO i=1,nload_cyl
125
126 titr = ''
127 CALL hm_option_read_key(lsubmodel,
128 . option_id = load_id,
129 . unit_id = uid,
130 . submodel_index = sub_indx,
131 . option_titr = titr)
132c---------------------------------------------------------------------------
133card1
134 CALL hm_get_intv('surf_ID' ,surf_id ,is_available,lsubmodel)
135 CALL hm_get_intv('sens_ID' ,sens_id ,is_available,lsubmodel)
136 CALL hm_get_intv('frame_ID' ,frame_id ,is_available,lsubmodel)
137c
138card2
139 CALL hm_get_intv('table_ID' ,table_id ,is_available,lsubmodel)
140 CALL hm_get_floatv('xscale_r',x_r ,is_available,lsubmodel,unitab)
141 CALL hm_get_floatv('xscale_t',x_t ,is_available,lsubmodel,unitab)
142 CALL hm_get_floatv('yscale_p',yfac ,is_available,lsubmodel,unitab)
143c
144c read units
145 CALL hm_get_floatv_dim('xscale_r' ,fac_r ,is_available,lsubmodel,unitab)
146 CALL hm_get_floatv_dim('xscale_t' ,fac_t ,is_available,lsubmodel,unitab)
147 CALL hm_get_floatv_dim('yscale_p' ,fac_p ,is_available,lsubmodel,unitab)
148c---------------------------------------------------------------------------
149 IF (x_r == zero) x_r = fac_r
150 IF (x_t == zero) x_t = fac_t
151 IF (yfac == zero) yfac = fac_p
152 loads%LOAD_CYL(i)%XSCALE_R = x_r
153 loads%LOAD_CYL(i)%XSCALE_T = x_t
154 loads%LOAD_CYL(i)%YSCALE = yfac
155c
156c read surface segments
157c
158c internal_SURF_ID = NGR2USR(SURF_ID,INGR2USR,NSURF)
159
160 nseg = 0
161 IF (surf_id > 0) THEN
162 DO j=1,nsurf
163 IF (surf_id == igrsurf(j)%ID) THEN
164 iss = j
165 nseg = igrsurf(iss)%NSEG
166 EXIT
167 ENDIF
168 ENDDO
169 loads%LOAD_CYL(i)%ID = load_id
170 loads%LOAD_CYL(i)%NSEG = nseg
171 CALL my_alloc(loads%LOAD_CYL(i)%SEGNOD,nseg,4)
172 DO j=1,nseg
173 loads%LOAD_CYL(i)%SEGNOD(j,1) = igrsurf(iss)%NODES(j,1)
174 loads%LOAD_CYL(i)%SEGNOD(j,2) = igrsurf(iss)%NODES(j,2)
175 loads%LOAD_CYL(i)%SEGNOD(j,3) = igrsurf(iss)%NODES(j,3)
176 loads%LOAD_CYL(i)%SEGNOD(j,4) = igrsurf(iss)%NODES(j,4)
177 IF (igrsurf(iss)%ELTYP(j)==7) loads%LOAD_CYL(i)%SEGNOD(j,4) = 0
178 ENDDO
179 number_load_cyl = number_load_cyl + 4*nseg
180 ENDIF
181c
182c---------------------------------------------------------------------------
183 itable = 0
184 IF (table_id > 0) THEN
185 DO j=1,ntable
186 IF (table_id == table(j)%NOTABLE) THEN
187 itable = j
188 EXIT
189 ENDIF
190 ENDDO
191 ENDIF
192 IF (itable == 0) THEN
193 CALL ancmsg(msgid=488,anmode=aninfo,msgtype=msgerror,
194 . c1='LOAD PCYL',
195 . c2='LOAD PCYL',
196 . i2=table_id,i1=load_id,c3=titr)
197 END IF
198c
199c---------------------------------------------------------------------------
200c check input sensor
201c
202 isens = 0
203 IF (sens_id > 0) THEN
204 DO j=1,nsensor
205 IF (sens_id == sensor_tab(j)%SENS_ID) THEN
206 isens = j
207 EXIT
208 ENDIF
209 ENDDO
210 ENDIF
211c
212c check local frame
213c
214 nofra = 0
215 imov = 0
216 IF (frame_id > 0) THEN
217 DO j=0,numfram
218 IF (frame_id == iframe(4,j+1)) THEN
219 nofra = j
220 imov = iframe(5,j+1)
221 EXIT
222 ENDIF
223 ENDDO
224 ENDIF
225 IF (nofra == 0) THEN
226 CALL ancmsg(msgid=490, msgtype=msgerror, anmode=aninfo_blind_1,
227 . c1='/LOAD/PCYL',
228 . i1=load_id,
229 . c2='/LOAD/PCYL',
230 . c3=titr,
231 . i2=frame_id)
232 ELSE IF (imov == 0) THEN
233 CALL ancmsg(msgid=3011, msgtype=msgerror, anmode=aninfo_blind_1,
234 . c1='/LOAD/PCYL',
235 . i1=load_id,
236 . c2='/LOAD/PCYL',
237 . c3=titr)
238 ENDIF
239c
240 loads%LOAD_CYL(i)%ID = load_id
241 loads%LOAD_CYL(i)%IFRAME = nofra
242 loads%LOAD_CYL(i)%ITABLE = itable
243 loads%LOAD_CYL(i)%ISENS = isens
244c---------------------------------------------------------------------------
245c OUTPUT
246c---------------------------------------------------------------------------
247 WRITE (iout,1000) load_id,frame_id,sens_id,table_id,surf_id,nseg,
248 . x_r,x_t,yfac
249 ENDDO
250c-----------
251 1000 FORMAT(
252 & 5x,' '/,
253 & 5x,'CYLINDRICAL PRESSURE LOAD'/,
254 & 5x,'-------------------------'/,
255 & 5x,'LOAD ID. . . . . . . . . . . . . . . . .=',i10/,
256 & 5x,'FRAME ID . . . . . . . . . . . . . . . .=',i10/,
257 & 5x,'SENSOR ID. . . . . . . . . . . . . . . .=',i10/,
258 & 5x,'TABLE ID . . . . . . . . . . . . . . . .=',i10/,
259 & 5x,'SURFACE ID . . . . . . . . . . . . . . .=',i10/,
260 & 5x,'NUMBER OF SEGMENTS . . . . . . . . . . .=',i10/,
261 & 5x,'RADIUS SCALE FACTOR FOR ABSCISSA . . . .=',1pg20.13/,
262 & 5x,'TIME SCALE FACTOR FOR ABSCISSA . . . .=',1pg20.13/,
263 & 5x,'PRESSURE SCALE FACTOR. . . . . . . . . .=',1pg20.13/)
264c-----------
265 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_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
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
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
table_mod
Definition table_mod.F:112
unitab_mod
Definition unitab_mod.F:513
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
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