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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_pfluid (numloadp, iloadp, lloadp, facloadp, npc, sensors, igrsurf, unitab, iframe, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_pfluid()

subroutine hm_read_pfluid ( integer numloadp,
integer, dimension(sizloadp,nloadp) iloadp,
integer, dimension(slloadp) lloadp,
facloadp,
integer, dimension(snpc) npc,
type (sensors_), intent(in) sensors,
type (surf_), dimension(nsurf), target igrsurf,
type (unit_type_), intent(in) unitab,
integer, dimension(liskn,numfram+1) iframe,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 41 of file hm_read_pfluid.F.

43C
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE unitab_mod
48 USE r2r_mod
49 USE message_mod
50 USE groupdef_mod
51 USE submodel_mod
52 USE hm_option_read_mod
53 USE sensor_mod
54 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
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 "com04_c.inc"
64#include "units_c.inc"
65#include "r2r_c.inc"
66#include "tabsiz_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 NPC(SNPC),IFRAME(LISKN,NUMFRAM+1),NUMLOADP, ILOADP(SIZLOADP,NLOADP), LLOADP(SLLOADP)
72 my_real facloadp(lfacload,nloadp)
73C-----------------------------------------------
74 TYPE (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
75 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(NSUBMOD)
76 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 my_real fcx,fcy,fac_fcx,fac_fcy,fcx1,fcy1,fcx2,fcy2
81 INTEGER J,K, SUB_INDEX, SUB_ID, UID, ID, IFLAGUNIT,NN,IAD,TSENS,ISENS,IS,ISU,
82 . FUN_HSP,FUN_CX,FUN_VEL,IFRA1,IFRA2,ICFIELD8,ICFIELD12,ICFIELD9,ICFIELD13,
83 . NCUR_HSP,NCUR_VEL,NCUR_CX
84 CHARACTER MESS*40,char_X*1, char_Y*1, char_Z*1, char_XX*2, char_YY*2, char_ZZ*2
85 CHARACTER(LEN=NCHARFIELD) :: XYZ, XYZ1
86 CHARACTER(LEN=NCHARTITLE) :: TITR
87 LOGICAL IS_AVAILABLE
88
89 DATA char_x/'X'/
90 DATA char_y/'Y'/
91 DATA char_z/'Z'/
92 DATA char_xx/'XX'/
93 DATA char_yy/'YY'/
94 DATA char_zz/'ZZ'/
95 DATA mess/'FLUID PRESSURE LOAD DEFINITION '/
96C----------------------------------------------------------------------------------
97C C o m m e n t s
98C----------------------------------------------------------------------------------
99C /LOAD/PFLUID /LOAD/PBLAST
100C
101C LLOADP(1,K) : K=1,NLOADP_F K=1+NLOADP_F,NLOADP_F+NLOADP_B : . . . SEGMENT STORAGE (surface)
102C ILOADP(1,K) : K=1,NLOADP_F K=1+NLOADP_F,NLOADP_F+NLOADP_B : . . . INTEGER STORAGE (option parameters)
103C FACLOADP(1,K) : K=1,NLOADP_F K=1+NLOADP_F,NLOADP_F+NLOADP_B : . . . REAL STORAGE (option parameters)
104C
105C----------------------------------------------------------------------------------
106C /LOAD/PFLUID /LOAD/PBLAST
107C K=1,NLOADP_F K=1+NLOADP_F,NLOADP_F+NLOADP_B
108C----------------------------------------------------------------------------------
109C ILOADP(1:SIZLOADP,K) : INTEGER STORAGE (option parameters)
110C----------------------------------------------------------------------------------
111C K=1,NLOADP_F K=1+NLOADP_F,NLOADP_F+NLOADP_B
112C
113C ILOADP(1,K) : 4*NN (4 * Nb of segments) 4*NN
114C ILOADP(2,K) : ID IS
115C ILOADP(3,K) : - -
116C ILOADP(4,K) : IAD Address of segments in LLOADP IAD
117C ILOADP(5,K) : 2 3
118C ILOADP(6,K) : Sensor id IZ_UPDATE
119C ILOADP(7,K) : FCT_HSP function No IABAC
120C ILOADP(8,K) : Dir_hsp (1, 2, 3) ID
121C ILOADP(9,K) : frahsp id ITA_SHIFT
122C ILOADP(10,K): FCT_CX function No NDT
123C ILOADP(11,K): FCT_VEL function No IMODEL
124C ILOADP(12,K): Dir_vel (1, 2, 3) -
125C ILOADP(13,K): fravel id -
126C----------------------------------------------------------------------------------
127C /LOAD/PFLUID /LOAD/PBLAST
128C K=1,NLOADP_F K=1+NLOADP_F,NLOADP_F+NLOADP_B
129C----------------------------------------------------------------------------------
130C LLOADP(1:SLLOADP,K) : SEGMENT STORAGE (surface)
131C----------------------------------------------------------------------------------
132C K=1,NLOADP_F K=1+NLOADP_F,NLOADP_F+NLOADP_B
133C
134C LLOADP(1,K) : NODE1 NODE1
135C LLOADP(2,K) : NODE2 NODE2
136C LLOADP(3,K) : NODE3 NODE3
137C LLOADP(4,K) : NODE4 NODE4
138C----------------------------------------------------------------------------------
139C /LOAD/PFLUID /LOAD/PBLAST
140C K=1,NLOADP_F K=1+NLOADP_F,NLOADP_F+NLOADP_B
141C----------------------------------------------------------------------------------
142C FACLOADP(LFACLOAD,K) : REAL STORAGE (option parameters)
143C----------------------------------------------------------------------------------
144C
145C FACLOADP( 1,K) = Fscaley_hsp TDET
146C FACLOADP( 2,K) = ONE/Ascalex_hsp XDET
147C FACLOADP( 3,K) = Fscaley_pc YDET
148C FACLOADP( 4,K) = ONE/Ascalex_pc ZDET
149C FACLOADP( 5,K) = Fscaley_vel WTNT
150C FACLOADP( 6,K) = ONE/Ascalex_vel P0_REF
151C FACLOADP( 7,K) = - ZERO ! TA_SHIFT
152C FACLOADP( 8,K) = - Nx_SURF
153C FACLOADP( 9,K) = - Ny_SURF
154C FACLOADP(10,K) = - Nz_SURF
155C FACLOADP(11,K) = - HC
156C FACLOADP(12,K) = - alpha_zc
157C FACLOADP(13,K) = - TSTOP
158C----------------------------------------------------------------------------------
159C S o u r c e L i n e s
160C----------------------------------------------------------------------------------
161 nn = 0
162C--------------------------------------------------
163C START BROWSING MODEL /LOAD/PFLUID
164C--------------------------------------------------
165 CALL hm_option_start('/LOAD/PFLUID')
166C--------------------------------------------------
167C BROWSING MODEL 1..NLOADP_F
168C--------------------------------------------------
169 DO k=1,nloadp_f
170C--------------------------------------------------
171C EXTRACT DATAS OF /LOAD/PFLUID... LINE
172C--------------------------------------------------
173 CALL hm_option_read_key(lsubmodel,
174 . option_id = id,
175 . unit_id = uid,
176 . submodel_id = sub_id,
177 . submodel_index = sub_index,
178 . option_titr = titr)
179
180 iflagunit = 0
181 DO j=1,unitab%NUNITS
182 IF (unitab%UNIT_ID(j) == uid) THEN
183 iflagunit = 1
184 EXIT
185 ENDIF
186 ENDDO
187 IF (uid /= 0.AND.iflagunit == 0) THEN
188 CALL ancmsg(msgid=659, anmode= aninfo, msgtype=msgerror,
189 . i2=uid,i1=id,c1='FLUID PRESSURE LOAD',c2='FLUID PRESSURE LOAD',c3= titr)
190 ENDIF
191C-----------
192 iloadp(2,k) = id !load identifier
193C-----------
194 iad = numloadp + 1
195 fun_hsp = 0
196 fun_cx = 0
197 fun_vel = 0
198 icfield9 = 0
199 icfield13 = 0
200 !Reader (based on cfg file)
201 CALL hm_get_intv('surf_ID',isu,is_available,lsubmodel)
202 CALL hm_get_intv('sens_ID',isens,is_available,lsubmodel)
203 !-----------
204 !get face nodes N1,N2,N3,N4
205 is=0
206 DO j=1,nsurf
207 IF (isu == igrsurf(j)%ID) is=j
208 ENDDO
209 IF(is /= 0)THEN
210 nn=igrsurf(is)%NSEG
211 DO j=1,nn
212 lloadp(iad+4*(j-1)) =igrsurf(is)%NODES(j,1)
213 lloadp(iad+4*(j-1)+1)=igrsurf(is)%NODES(j,2)
214 lloadp(iad+4*(j-1)+2)=igrsurf(is)%NODES(j,3)
215 IF(igrsurf(is)%ELTYP(j) == 7)THEN
216 lloadp(iad+4*(j-1)+3)=0
217 ELSE
218 lloadp(iad+4*(j-1)+3)=igrsurf(is)%NODES(j,4)
219 ENDIF
220 ENDDO
221 ENDIF
222 iloadp(1,k)=4*nn
223 !-----------
224 !possible Sensor
225 tsens=0
226 DO j=1,sensors%NSENSOR
227 IF(isens /= 0) THEN
228 IF (isens == sensors%SENSOR_TAB(j)%SENS_ID) tsens=j
229 ENDIF
230 ENDDO
231 IF((tsens == 0).AND.(isens /= 0))THEN
232 CALL ancmsg(msgid=930, msgtype=msgerror, anmode=aninfo_blind_1, i1=id, c1=titr, i2=isens)
233 ENDIF
234 !-----------
235 !Input file - Reader
236 CALL hm_get_intv('fct_hsp',ncur_hsp,is_available,lsubmodel)
237 CALL hm_get_floatv('Ascalex_hsp',fcx,is_available,lsubmodel,unitab)
238 CALL hm_get_floatv_dim('Ascalex_hsp',fac_fcx,is_available,lsubmodel,unitab)
239 CALL hm_get_floatv('Fscaley_hsp',fcy,is_available,lsubmodel,unitab)
240 CALL hm_get_floatv_dim('Fscaley_hsp',fac_fcy,is_available,lsubmodel,unitab)
241 IF (fcx == zero) fcx = fac_fcx ! default value
242 IF (fcy == zero) fcy = fac_fcy ! default value
243 !-----------
244 !check function identifier if provided
245 IF(ncur_hsp /= 0)THEN
246 DO j=1,nfunct
247 IF(npc(nfunct+j+1) == ncur_hsp)fun_hsp=j
248 ENDDO
249 IF(fun_hsp == 0)THEN
250 CALL ancmsg(msgid=929, msgtype=msgerror, anmode=aninfo_blind_1, i1=id, c1=titr, i2=ncur_hsp)
251 ENDIF
252 ENDIF
253 !-----------
254 !Reader for XYZ field
255 xyz = ''
256 CALL hm_get_string('Dir_hsp',xyz,ncharfield,is_available)
257 !-----------
258 icfield8 = 0
259 IF(xyz(1:1) == char_x)icfield8=1
260 IF(xyz(1:1) == char_y)icfield8=2
261 IF(xyz(1:1) == char_z)icfield8=3
262 ! XYZ mandatory if hydrostatic pressure (HSP) expected
263 IF (ncur_hsp /= 0)THEN
264 IF(xyz(1:1) /= char_x .AND. xyz(1:1) /= char_y .AND. xyz(1:1) /= char_z) THEN
265 CALL ancmsg(msgid=927, msgtype=msgerror, anmode=aninfo_blind_1, i1=id, c1=titr, c2=xyz)
266 ENDIF
267 ENDIF
268
269 !-----------
270 !possible frame
271 CALL hm_get_intv('frahsp_ID',ifra1,is_available,lsubmodel)
272 !-----------
273 IF(ifra1 == 0 .AND. sub_index /= 0)THEN
274 CALL ancmsg(msgid=1712, anmode=aninfo, msgtype=msgwarning,
275 . i1=id, i2=sub_id, c1='/LOAD/PFLUID - frahsp_ID=0', c2=titr)
276 ENDIF
277
278 DO j=0,numfram
279 IF(ifra1 == iframe(4,j+1)) THEN
280 icfield9=j+1
281 ENDIF
282 ENDDO
283 IF(ifra1 == 0) icfield9 = 1
284 IF (ifra1 /= 0 .AND. icfield9 == 0) THEN
285 CALL ancmsg(msgid=928, msgtype=msgerror, anmode=aninfo_blind_1, i1=id, c1=titr, i2=ifra1)
286 ENDIF
287 !-----------
288 !Reader
289 CALL hm_get_intv('fct_pc',ncur_cx,is_available,lsubmodel)
290 CALL hm_get_floatv('Ascalex_pc',fcx1,is_available,lsubmodel,unitab)
291 CALL hm_get_floatv_dim('Ascalex_pc',fac_fcx,is_available,lsubmodel,unitab)
292 CALL hm_get_floatv('Fscaley_pc',fcy1,is_available,lsubmodel,unitab)
293 CALL hm_get_floatv_dim('Fscaley_pc',fac_fcy,is_available,lsubmodel,unitab)
294 IF (fcx1 == zero) fcx1 = fac_fcx
295 IF (fcy1 == zero) fcy1 = fac_fcy
296 !-----------
297 !check user function identifier
298 IF (ncur_cx /= 0)THEN
299 DO j=1,nfunct
300 IF(npc(nfunct+j+1) == ncur_cx)fun_cx=j
301 ENDDO
302 IF(fun_cx == 0)THEN
303 CALL ancmsg(msgid=929, msgtype=msgerror, anmode=aninfo_blind_1, i1=id, c1=titr, i2=ncur_cx)
304 ENDIF
305 ENDIF
306 !-----------
307 !reader
308 CALL hm_get_intv('fct_vel',ncur_vel,is_available,lsubmodel)
309 CALL hm_get_floatv('Ascalex_vel',fcx2,is_available,lsubmodel,unitab)
310 CALL hm_get_floatv_dim('Ascalex_vel',fac_fcx,is_available,lsubmodel,unitab)
311 CALL hm_get_floatv('Fscaley_vel',fcy2,is_available,lsubmodel,unitab)
312 CALL hm_get_floatv_dim('Fscaley_vel',fac_fcy,is_available,lsubmodel,unitab)
313 IF (fcx2 == zero) fcx2 = fac_fcx
314 IF (fcy2 == zero) fcy2 = fac_fcy
315 !-----------
316 !check user function identifier
317 IF (ncur_vel /= 0)THEN
318 DO j=1,nfunct
319 IF(npc(nfunct+j+1) == ncur_vel)fun_vel=j
320 ENDDO
321 IF(fun_vel == 0)THEN
322 CALL ancmsg(msgid=929, msgtype=msgerror, anmode=aninfo_blind_1, i1=id, c1=titr, i2=ncur_vel)
323 ENDIF
324 ENDIF
325 !-----------
326 CALL hm_get_string('Dir_vel',xyz1,ncharfield,is_available)
327 !-----------
328 icfield12 = 0
329 IF(xyz1(1:1) == char_x)icfield12=1
330 IF(xyz1(1:1) == char_y)icfield12=2
331 IF(xyz1(1:1) == char_z)icfield12=3
332 IF (ncur_vel /= 0)THEN
333 IF(xyz1(1:1) /= char_x .AND. xyz1(1:1) /= char_y .AND. xyz1(1:1) /= char_z) THEN
334 CALL ancmsg(msgid=927, msgtype=msgerror, anmode=aninfo_blind_1, i1=id, c1=titr, c2=xyz1)
335 ENDIF
336 ENDIF
337
338 !-----------
339 CALL hm_get_intv('fravel_ID',ifra2,is_available,lsubmodel)
340 !-----------
341 IF(ifra2 == 0 .AND. sub_index /= 0)THEN
342 CALL ancmsg(msgid=1712, anmode=aninfo, msgtype=msgwarning,
343 . i1 = id, i2 = sub_id, c1 = '/LOAD/PFLUID - fravel_ID=0', c2 = titr)
344 ENDIF
345 DO j=0,numfram
346 IF(ifra2 == iframe(4,j+1)) THEN
347 icfield13=j+1
348 ENDIF
349 ENDDO
350 IF(ifra2 == 0) icfield13 = 1
351 IF (ifra2 /= 0 .AND. icfield13 == 0) THEN
352 CALL ancmsg(msgid=928, msgtype=msgerror, anmode=aninfo_blind_1, i1=id, c1=titr, i2=ifra2)
353 ENDIF
354
355 iloadp(5,k)=2 !type of load 2:PFLUID
356
357 !STORAGE : ILOADP (integer) - FACLOADP (real)
358 IF(is /= 0)THEN
359 iloadp( 4,k) = iad
360 iloadp( 6,k) = isens
361 iloadp( 7,k) = fun_hsp
362 iloadp( 8,k) = icfield8
363 iloadp( 9,k) = icfield9
364 iloadp(10,k) = fun_cx
365 iloadp(11,k) = fun_vel
366 iloadp(12,k) = icfield12
367 iloadp(13,k) = icfield13
368
369 facloadp( 1,k) = fcy
370 facloadp( 2,k) = one/fcx
371 facloadp( 3,k) = fcy1
372 facloadp( 4,k) = one/fcx1
373 facloadp( 5,k) = fcy2
374 facloadp( 6,k) = one/fcx2
375 !Multidomains -> numbering common segments (one single time)
376 IF (iddom > 0) nn = nn-isurf_r2r(1,is)
377 ENDIF
378
379 !OUTPUT STARTER LISTING FILE
380 WRITE (iout,2002)
381 WRITE (iout,'(I10,2X,I10,9X,A1,2X,I10,2X,I10,2X,1PG20.13,2X,1PG20.13)')isu,ifra1,xyz(1:1),ncur_hsp,isens,fcx,fcy
382 WRITE (iout,2003)
383 WRITE (iout,'(I10,4X,1PG20.13,4X,1PG20.13)')ncur_cx,fcx1,fcy1
384 WRITE (iout,2004)
385 WRITE (iout,'(I10,9X,A1,2X,I10,2X,1PG20.13,2X,1PG20.13)')ifra2,xyz1(1:1),ncur_vel,fcx2,fcy2
386
387 numloadp = numloadp + 4*nn
388
389 ENDDO ! next K (next /LOAD/PFLUID)
390C--------------------------------------------------------------------------------C
391 RETURN
392C--------------------------------------------------------------------------------C
393 2002 FORMAT(//
394 .' PFLUID LOAD '/
395 .' ------------------ '/
396 .' SURFACE FRAME_HSP DIR_HSP FUNC_HSP SENSOR',
397 .' SCALE_X SCALE_Y')
398
399 2003 FORMAT(//
400 .' FUNC_CX SCALE_X SCALE_Y')
401
402 2004 FORMAT(//
403 .' FRAME_VEL DIR_VEL FUNC_VEL',
404 .' SCALE_X SCALE_Y')
405C-----------------------------------------------
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_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:76
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
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
r2r_mod
Definition r2r_mod.F:125
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