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,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
266 END
my_real
#define my_real
Definition cppsort.cpp:32
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_read_pcyl
subroutine hm_read_pcyl(loads, igrsurf, nsensor, sensor_tab, table, iframe, unitab, lsubmodel, number_load_cyl)
Definition hm_read_pcyl.F:44
id
initmumps id
Definition multiplerhs_example.m:4
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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