OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_pcyl.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_pcyl ../starter/source/loads/general/load_pcyl/hm_read_pcyl.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_count ../starter/source/devtools/hm_reader/hm_option_count.f
33!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!|| ngr2usr ../starter/source/system/nintrr.F
36!||--- uses -----------------------------------------------------
37!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
38!|| message_mod ../starter/share/message_module/message_mod.F
39!|| submodel_mod ../starter/share/modules1/submodel_mod.F
40!|| table_mod ../starter/share/modules1/table_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_pcyl(LOADS ,IGRSURF ,NSENSOR ,SENSOR_TAB,TABLE ,
43 . IFRAME ,UNITAB ,LSUBMODEL, NUMBER_LOAD_CYL)
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,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
266 END
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_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:253
hm_read_pcyl
subroutine hm_read_pcyl(loads, igrsurf, nsensor, sensor_tab, table, iframe, unitab, lsubmodel, number_load_cyl)
Definition hm_read_pcyl.F:44
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
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
table_mod
Definition table_mod.F:113
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
starter
program starter
Definition starter.F:39