OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_pload.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_pload ../starter/source/loads/general/pload/hm_read_pload.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!|| r2r_mod ../starter/share/modules1/r2r_mod.F
39!|| submodel_mod ../starter/share/modules1/submodel_mod.F
40!||====================================================================
41 SUBROUTINE hm_read_pload(IPRES ,PRES ,NPREL ,ITAB ,ITABM1 ,
42 . IGRSURF ,UNITAB ,LSUBMODEL,LOADS )
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE unitab_mod
47 USE r2r_mod
48 USE message_mod
49 USE groupdef_mod
50 USE submodel_mod
51 USE hm_option_read_mod
52 USE pinchtype_mod
53 USE loads_mod
54 USE names_and_titles_mod , ONLY : nchartitle
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "param_c.inc"
63#include "units_c.inc"
64#include "scr03_c.inc"
65#include "com04_c.inc"
66#include "r2r_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
71 INTEGER NPREL
72 INTEGER IPRES(NIBCLD,*), ITAB(*), ITABM1(*)
73 my_real
74 . pres(lfaccld,*)
75 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
76 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
77 TYPE (LOADS_),INTENT(INOUT) :: LOADS
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER K, M, I1, I2, I3, I4, IFU, I, ISENS,NPR0,NN,ISU,IS,
82 . iad,id,j,uid,iflagunit,ifix_tmp,
83 . capt,h,sub_index,flag_pinch,kpinch,idel,ifunctype
84 INTEGER N1,N2,N3,N4
85 my_real fcx,fcy,fac_fcx,fac_fcy
86 CHARACTER MESS*40
87 CHARACTER(LEN=NCHARTITLE) :: TITR
88 LOGICAL IS_AVAILABLE
89C-----------------------------------------------
90C E x t e r n a l F u n c t i o n s
91C-----------------------------------------------
92 INTEGER USR2SYS
93 DATA mess/'PRESSURE LOADS DEFINITION '/
94C-----------------------------------------------
95C IBCL(NIBCLD,NUMCLD+NUMPRES), NUMCLD = Total nb of (cloads * nodes)
96C NUMPRES = Total nb of (ploads * segments)
97C IPRES = IBCL(1:NIBCLD,NUMCCLD+1,NUMCLD+NUMPRES)
98C 1: 1st node number of the segment
99C 2: 2nd node number of the segment
100C 3: 3rd node number of the segment
101C 4: 4th node number of the segment
102C 5: Function internal number
103C 6: ISENS Sensor User ID
104C 7: User ID
105C 9: Itypfun Function type
106C-----------------------------------------------
107C FORC(LFACCLD,NUMCLD+NUMPRES)
108C PRES = FORC(LFACCLD,NUMCLD+1:NUMCLD+NUMPRES)
109C 1: Fscale_y
110C 2: 1/Ascale_x
111C 3: /=0 <=> Pinching pressure
112C=======================================================================
113 is_available = .false.
114
115 npr0=npreld
116 npreld=0
117 k=0
118 nploadpinch=0
119 kpinch=0
120 pdel = 0
121 ifunctype = 0
122C--------------------------------------------------
123C START BROWSING MODEL /PLOAD
124C--------------------------------------------------
125 CALL hm_option_start('/PLOAD')
126
127C--------------------------------------------------
128C BROWSING MODEL SurPRESe 1->NP0
129C--------------------------------------------------
130 DO i=1,npr0
131 titr = ''
132 CALL hm_option_read_key(lsubmodel,
133 . option_id = id,
134 . unit_id = uid,
135 . submodel_index = sub_index,
136 . option_titr = titr)
137
138C--------------------------------------------------
139C EXTRACT DATAS (INTEGER VALUES)
140C--------------------------------------------------
141 CALL hm_get_intv('entityid',isu,is_available,lsubmodel)
142 CALL hm_get_intv('curveid',ifu,is_available,lsubmodel)
143 CALL hm_get_intv('rad_sensor_id',isens,is_available,lsubmodel)
144 CALL hm_get_intv('ipinch',flag_pinch,is_available,lsubmodel)
145 CALL hm_get_intv('Idel',idel,is_available,lsubmodel)
146 CALL hm_get_intv('Itypfun',ifunctype,is_available,lsubmodel)
147C--------------------------------------------------
148C EXTRACT DATAS (REAL VALUES)
149C--------------------------------------------------
150 CALL hm_get_floatv('xscale',fcx,is_available,lsubmodel,unitab)
151 CALL hm_get_floatv_dim('xscale',fac_fcx,is_available,lsubmodel,unitab)
152 CALL hm_get_floatv('magnitude',fcy,is_available,lsubmodel,unitab)
153 CALL hm_get_floatv_dim('magnitude',FAC_FCY,IS_AVAILABLE,LSUBMODEL,UNITAB)
154C--------------------------------------------------
155 IFLAGUNIT = 0
156 DO J=1,UNITAB%NUNITS
157 IF (UNITAB%UNIT_ID(J) == UID) THEN
158 IFLAGUNIT = 1
159 EXIT
160 ENDIF
161 ENDDO
162.AND. IF (UID/=0IFLAGUNIT==0) THEN
163 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
164 . I2=UID,I1=ID,C1='pressure load',
165 . C2='pressure load',
166 . C3=TITR)
167 ENDIF
168
169 IF (FCX == ZERO) FCX = FAC_FCX
170 IF (FCY == ZERO) FCY = FAC_FCY
171 IS=0
172 DO J=1,NSURF
173 IF (ISU==IGRSURF(J)%ID) IS=J
174 ENDDO
175 IF( IDEL /= 2) THEN
176 PDEL = 1
177 IDEL = 1
178 ELSE
179 PDEL = 0
180 IDEL = 0
181 ENDIF
182C
183 IF(IFUNCTYPE == 0) IFUNCTYPE = 1 ! Abscissa function is time (by default)
184 ! IFUNCTYPE = 2 ! Abscissa function is nodal displacement
185 ! IFUNCTYPE = 3 ! Abscissa function is nodal velocity
186C
187 IF(IS/=0)THEN
188 NN=IGRSURF(IS)%NSEG
189 KPINCH=NN+1
190 DO J=1,NN
191 IF (IDDOM/=0) THEN
192C-----------Multidomaines -> on elimine les seg communs, on ne les traite qu'une foi---
193 CAPT=0
194 DO H=1,4
195 IF (TAGNO(NPART+IGRSURF(IS)%NODES(J,H))==1) CAPT = 1
196 END DO
197 IF (CAPT==0) GOTO 150
198 ENDIF
199C
200 IF(FLAG_PINCH /= 1) THEN
201 K=K+1
202 IPRES(1,K) = IGRSURF(IS)%NODES(J,1)
203 IPRES(2,K) = IGRSURF(IS)%NODES(J,2)
204 IPRES(3,K) = IGRSURF(IS)%NODES(J,3)
205 IF (IGRSURF(IS)%NODES(J,3)==IGRSURF(IS)%NODES(J,4)) THEN
206C true triangles (not segments built from 3 nodes).
207 IPRES(4,K) = 0
208 ELSE
209 IPRES(4,K) = IGRSURF(IS)%NODES(J,4)
210 ENDIF
211 IPRES(5,K) = IFU
212 IPRES(6,K) = ISENS
213 IPRES(7,K) = IDEL
214 IPRES(8,K) = 0
215 IPRES(9,K) = IFUNCTYPE
216 PRES(1,K) = FCY
217 PRES(2,K) = ONE/FCX
218 ELSE
219 NPLOADPINCH = NPLOADPINCH + 1
220 KPINCH=KPINCH-1
221 IPRES(1,KPINCH) = IGRSURF(IS)%NODES(J,1)
222 IPRES(2,KPINCH) = IGRSURF(IS)%NODES(J,2)
223 IPRES(3,KPINCH) = IGRSURF(IS)%NODES(J,3)
224 IF (IGRSURF(IS)%ELTYP(J)==7) THEN
225C true triangles (not segments built from 3 nodes).
226 IPRES(4,KPINCH) = 0
227 ELSE
228 IPRES(4,KPINCH) = IGRSURF(IS)%NODES(J,4)
229 ENDIF
230 IPRES(5,KPINCH) = IFU
231 IPRES(6,KPINCH) = ISENS
232 IPRES(7,KPINCH) = IDEL
233 IPRES(8,KPINCH) = 0
234 IPRES(9,KPINCH) = IFUNCTYPE
235 PRES(1,KPINCH) = FCY
236 PRES(2,KPINCH) = ONE/FCX
237 ENDIF
238C
239 150 CONTINUE
240 ENDDO
241C-----------Multidomaines -> on decompte les seg communs, on ne les compte qu'une foi---
242 IF (IDDOM>0) NN = NN-ISURF_R2R(1,IS)
243 NPRELD=NPRELD+NN
244 ELSE
245 CALL ANCMSG(MSGID=3066,
246 . MSGTYPE=MSGERROR,
247 . ANMODE=ANINFO,
248 . I1=ID,
249 . C1=TITR)
250 ENDIF
251 ENDDO
252C
253 I1=1
254 I2=MIN0(50,NPRELD)
255C----
256 LOADS%NLOAD_PLOAD = NPRELD
257C----
258C
259 90 WRITE (IOUT,2000)
260
261 DO I=I1,I2
262
263.AND. IF(IPRES(4,I) == 0 IPRES(3,I) == 0)THEN
264 ! 2D / Surface made of lines
265 WRITE (IOUT,'(3(1x,i10),a,1x,i10,1x,i10,2g20.13)') I,
266 . ITAB(IPRES(1,I)),ITAB(IPRES(2,I)),' ',
267 . IPRES(5,I),IPRES(6,I),ONE/PRES(2,I),PRES(1,I)
268
269.AND. ELSEIF(IPRES(4,I) == 0 IPRES(3,I) /= 0)THEN
270 ! Surface made of 3 nodes
271 WRITE (IOUT,'(4(1x,i10),a,1x,i10,1x,i10,2g20.13)') I,
272 . ITAB(IPRES(1,I)),ITAB(IPRES(2,I)),ITAB(IPRES(3,I)),' ',
273 . IPRES(5,I),IPRES(6,I),ONE/PRES(2,I),PRES(1,I)
274 ELSE
275 ! Surface made of 4 nodes
276 WRITE (IOUT,'(6(1x,i10),1x,i10,2g20.13)') I,
277 . ITAB(IPRES(1,I)),ITAB(IPRES(2,I)),ITAB(IPRES(3,I)),ITAB(IPRES(4,I)),
278 . IPRES(5,I),IPRES(6,I),ONE/PRES(2,I),PRES(1,I)
279 ENDIF
280
281 ENDDO
282
283 IF(I2==NPRELD)GOTO 200
284 I1=I1+50
285 I2=MIN0(I2+50,NPRELD)
286 GOTO 90
287 200 RETURN
288 300 CALL ANCMSG(MSGID=157,
289 . MSGTYPE=MSGERROR,
290 . ANMODE=ANINFO,
291 . I1=K)
292C---
293 2000 FORMAT(//
294 .' pressure loads '/
295 .' ---------------- '/
296 .' segm node1 node2 node3 node4 curve',
297 .' sensor scale-x scale-y ')
298C-----------
299 RETURN
300 END
301
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_read_pload
subroutine hm_read_pload(ipres, pres, nprel, itab, itabm1, igrsurf, unitab, lsubmodel, loads)
Definition hm_read_pload.F:43
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
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::nploadpinch
integer nploadpinch
Definition pinchtype_mod.F:74
r2r_mod
Definition r2r_mod.F:125
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
submodel_mod::submodel_data
Definition submodel_mod.F:723