OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_pload.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "scr03_c.inc"
#include "com04_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_pload (ipres, pres, nprel, itab, itabm1, igrsurf, unitab, lsubmodel, loads)

Function/Subroutine Documentation

◆ hm_read_pload()

subroutine hm_read_pload ( integer, dimension(nibcld,*) ipres,
pres,
integer nprel,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
type (surf_), dimension(nsurf) igrsurf,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type (loads_), intent(inout) loads )

Definition at line 41 of file hm_read_pload.F.

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 IF (uid/=0.AND.iflagunit==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 IF(ipres(4,i) == 0 .AND. 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 ELSEIF(ipres(4,i) == 0 .AND. 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
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_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
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
r2r_mod::isurf_r2r
integer, dimension(:,:), allocatable isurf_r2r
Definition r2r_mod.F:143
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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