OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_load_pressure.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_load_pressure ../starter/source/loads/general/load_pressure/hm_read_load_pressure.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.f
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
32!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
33!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
34!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.f
35!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
36!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
37!||--- uses -----------------------------------------------------
38!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
39!|| message_mod ../starter/share/message_module/message_mod.F
40!|| r2r_mod ../starter/share/modules1/r2r_mod.F
41!|| submodel_mod ../starter/share/modules1/submodel_mod.F
42!||====================================================================
43 SUBROUTINE hm_read_load_pressure(
44 . NUMLOADP ,ILOADP ,LLOADP ,INTERLOADP ,FACLOADP ,
45 . KLOADPINTER,LOADPINTER ,NPC ,SENSORS ,IGRSURF ,
46 . UNITAB ,ISKN ,LSUBMODEL ,DGAPINT ,INTGAPLOADP,
47 . DGAPLOADINT,S_LOADPINTER,PBLAST )
48C
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE unitab_mod
53 USE r2r_mod
54 USE message_mod
55 USE groupdef_mod
56 USE submodel_mod
57 USE hm_option_read_mod
58 USE sensor_mod
59 USE pblast_mod
60 USE names_and_titles_mod , ONLY : nchartitle, ncharline, ncharfield
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "param_c.inc"
69#include "scr03_c.inc"
70#include "com04_c.inc"
71#include "units_c.inc"
72#include "r2r_c.inc"
73#include "sphcom.inc"
74C-----------------------------------------------
75C D u m m y A r g u m e n t s
76C-----------------------------------------------
77 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
78 INTEGER NUMLOADP
79 INTEGER NPC(*),ISKN(LISKN,*),
80 . ILOADP(SIZLOADP,*), LLOADP(*)
81 INTEGER, INTENT(IN) :: S_LOADPINTER
82 INTEGER, INTENT(INOUT) :: KLOADPINTER(NINTER+1) ,LOADPINTER(S_LOADPINTER),
83 . interloadp(nintloadp)
84 my_real facloadp(lfacload,*)
85 my_real , INTENT(INOUT) :: dgapint(ninter),
86 . intgaploadp(nintloadp),dgaploadint(s_loadpinter )
87C-----------------------------------------------
88 TYPE (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
89 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
90 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
91 TYPE (PBLAST_) , INTENT(INOUT) :: PBLAST
92C-----------------------------------------------
93C L o c a l V a r i a b l e s
94C-----------------------------------------------
95
96 INTEGER I,J,K, N,NI,
97 . SUB_INDEX, SUB_ID, UID, ID, IFLAGUNIT,NIP,
98 . NN,IAD,ISENS,IS,ISU,NOSKEW,IDIR,IFUNC,NINTERP,INORM,
99 . TINTER,IDINT,NIK,NBINTER,NOINT,STAT,IFUNCL,
100 . idsens,idskew,iload,ninters,nidxload
101 INTEGER, DIMENSION(:), ALLOCATABLE :: ID_INTER,INTER_TYP
102 my_real
103 . FCX,FCY,FAC_FCX,FAC_FCY,GAP_I
104 CHARACTER MESS*40, char_X*1, char_Y*1, char_Z*1
105 CHARACTER(LEN=NCHARFIELD) ::DIR
106 CHARACTER(LEN=NCHARTITLE) :: TITR
107 CHARACTER(LEN=NCHARLINE) :: KEY
108 LOGICAL IS_AVAILABLE
109
110
111 DATA char_x/'X'/
112 DATA char_y/'Y'/
113 DATA char_z/'Z'/
114 DATA mess/'PRESSURE LOAD DEFINITION '/
115C----------------------------------------------------------------------------------
116C C o m m e n t s
117C----------------------------------------------------------------------------------
118C
119C /LOAD/PRESSURE
120C
121C----------------------------------------------------------------------------------
122
123C ILOADP(SIZLOADP,*)
124C ILOADP(1,K) : NN (Nb of segments) NN
125C ILOADP(2,K) : ID IS
126C ILOADP(3,K) : Pressure Function number IFUNC
127C ILOADP(4,K) : IAD Address of segments in LLOADP IAD
128C ILOADP(5,K) : Number of interfaces associated NINTERP
129C ILOADP(6,K) : Direction IDIR
130C ILOADP(7,K) : Sensor Number ISENS
131C ILOADP(8,K) : Skew Number NOSKEW
132C ILOADP(9,K) : Inorm flag INORM
133C ILOADP(10,K): Iload flag ILOAD
134
135C----------------------------------------------------------------------------------
136C LLOADP(1,K) : NODE1 NODE1
137C LLOADP(2,K) : NODE2 NODE2
138C LLOADP(3,K) : NODE3 NODE3
139C LLOADP(4,K) : NODE4 NODE4
140C----------------------------------------------------------------------------------
141C FACLOADP(LFACLOAD,*)
142C FACLOADP( 1,K) = y_scalep FCY
143C FACLOADP( 2,K) = ONE/x_scalep 1/FCX
144C----------------------------------------------------------------------------------
145C S o u r c e L i n e s
146C----------------------------------------------------------------------------------
147
148
149C******* Interface reading **************
150
151 ALLOCATE (id_inter(hm_ninter ),stat=stat)
152 id_inter(1:hm_ninter ) = 0
153 ALLOCATE (inter_typ(hm_ninter),stat=stat)
154 inter_typ(1:hm_ninter ) = 0
155C
156 CALL hm_option_start('/INTER')
157C
158 nbinter = 0
159C
160 DO i =1,hm_ninter
161
162C--------------------------------------------------
163C EXTRACT DATAS OF /INTER/... LINE
164C--------------------------------------------------
165 CALL hm_option_read_key(lsubmodel,
166 . option_id = noint,
167 . keyword2 = key)
168
169 IF(key(1:len_trim(key))/='SUB') THEN
170 nbinter=nbinter+1
171C
172 id_inter(nbinter) = noint
173
174 IF(key(1:len_trim(key))=='TYPE21') inter_typ(nbinter)=21
175
176 ENDIF
177 ENDDO
178
179C******* /LOAD/PRESSURE reading **************
180
181 nn = 0
182C--------------------------------------------------
183C START BROWSING MODEL /LOAD/PRESSURE
184C--------------------------------------------------
185 CALL hm_option_start('/LOAD/PRESSURE')
186C--------------------------------------------------
187C BROWSING MODEL 1..NLOADP_F
188C--------------------------------------------------
189 nidxload = nloadp_f+pblast%NLOADP_B
190 DO k=1,nloadp_hyd
191C--------------------------------------------------
192C EXTRACT DATAS OF /LOAD/PFLUID... LINE
193C--------------------------------------------------
194 CALL hm_option_read_key(lsubmodel,
195 . option_id = id,
196 . unit_id = uid,
197 . submodel_id = sub_id,
198 . submodel_index = sub_index,
199 . option_titr = titr)
200
201 iflagunit = 0
202
203 DO j=1,unitab%NUNITS
204 IF (unitab%UNIT_ID(j) == uid) THEN
205 iflagunit = 1
206 EXIT
207 ENDIF
208 ENDDO
209 IF (uid/=0.AND.iflagunit==0) THEN
210 CALL ancmsg(msgid = 659,
211 . anmode = aninfo,
212 . msgtype = msgerror,
213 . i2 = uid,
214 . i1 = id,
215 . c1 = 'PRESSURE LOAD',
216 . c2 = 'PRESSURE LOAD',
217 . c3 = titr)
218 ENDIF
219C-----------
220 iloadp(2,k+nidxload) = id
221C-----------
222 iad = numloadp + 1
223
224 pdel = 1 ! Idel option is default optioon
225
226 dir = ''
227 ninterp = 0
228 idsens = 0
229 idskew = 0
230 idir = 0
231C--------------------------------------------------
232C EXTRACT DATAS (INTEGER VALUES)
233C--------------------------------------------------
234
235 CALL hm_get_intv('surf_ID',isu,is_available,lsubmodel)
236 CALL hm_get_intv('fct_ID',ifunc,is_available,lsubmodel)
237 CALL hm_get_intv('Inorm',inorm,is_available,lsubmodel)
238 CALL hm_get_intv('sens_ID',idsens,is_available,lsubmodel)
239 CALL hm_get_intv('Iload',iload,is_available,lsubmodel)
240 IF(inorm == 0) inorm = 1 ! default value
241 IF(iload == 0) iload = 1 ! default value
242
243 IF (inorm > 1) THEN
244 CALL hm_get_intv('skew_ID',idskew,is_available,lsubmodel)
245 !-----------EXTRACT DATAS (STRING VALUES)
246 CALL hm_get_string('Direction',dir,ncharfield,is_available)
247
248 IF(dir(1:1)=='X') idir=1
249 IF(dir(1:1)=='Y') idir=2
250 IF(dir(1:1)=='Z') idir=3
251 ENDIF
252
253 !-----------
254 is=0
255 DO j=1,nsurf
256 IF (isu==igrsurf(j)%ID) is=j
257 ENDDO
258 IF(is/=0)THEN
259 nn=igrsurf(is)%NSEG
260 DO j=1,nn
261 lloadp(iad+4*(j-1)) =igrsurf(is)%NODES(j,1)
262 lloadp(iad+4*(j-1)+1)=igrsurf(is)%NODES(j,2)
263 lloadp(iad+4*(j-1)+2)=igrsurf(is)%NODES(j,3)
264 IF(igrsurf(is)%NODES(j,2)==igrsurf(is)%NODES(j,3))THEN
265 lloadp(iad+4*(j-1)+3)=0
266 ELSE
267 lloadp(iad+4*(j-1)+3)=igrsurf(is)%NODES(j,4)
268 ENDIF
269 ENDDO
270 ENDIF
271 iloadp(1,k+nidxload)=4*nn
272
273C-----------
274 ifuncl=0
275 DO j=1,nfunct
276 IF(npc(nfunct+j+1)==ifunc)ifuncl=j
277 ENDDO
278 IF(ifuncl==0)THEN
279 CALL ancmsg(msgid=883,
280 . msgtype=msgerror,
281 . anmode=aninfo_blind_1,
282 . i1=id,
283 . c1=titr,
284 . i2=ifunc)
285 ENDIF
286 !-----------
287 isens = 0
288 IF(idsens > 0) THEN
289 DO j=1,sensors%NSENSOR
290 IF(idsens/=0) THEN
291 IF(idsens == sensors%SENSOR_TAB(j)%SENS_ID) THEN
292 isens=j
293 EXIT
294 ENDIF
295 ENDIF
296 ENDDO
297 IF(isens==0)THEN
298 CALL ancmsg(msgid=930,
299 . msgtype=msgerror,
300 . anmode=aninfo_blind_1,
301 . i1=id,
302 . c1=titr,
303 . i2=idsens)
304 ENDIF
305 ENDIF
306
307 !-----------
308
309 noskew = 0
310 IF(idskew == 0 .AND. sub_index /= 0 ) idskew = lsubmodel(sub_index)%SKEW
311
312 IF(idskew > 0) THEN
313 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
314 IF(idskew == iskn(4,j+1)) THEN
315 noskew=j+1
316 ENDIF
317 ENDDO
318 IF(noskew==0)THEN
319 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
320 . c1='LOAD PRESSURE',
321 . c2='LOAD PRESSURE',
322 . i2=idskew,i1=id,c3=titr)
323 ENDIF
324 ENDIF
325
326C--------------------------------------------------
327C EXTRACT DATAS (REAL VALUES)
328C--------------------------------------------------
329 CALL hm_get_floatv('xscale_p',fcx,is_available,lsubmodel,unitab)
330 CALL hm_get_floatv_dim('xscale_p',fac_fcx,is_available,lsubmodel,unitab)
331 CALL hm_get_floatv('yscale_p',fcy,is_available,lsubmodel,unitab)
332 CALL hm_get_floatv_dim('yscale_p',fac_fcy,is_available,lsubmodel,unitab)
333
334 IF (fcx == zero) fcx = fac_fcx
335 IF (fcy == zero) fcy = fac_fcy
336C--------------------------------------------------
337C EXTRACT DATAS (INTEGER VALUES) : Interfaces reading
338C--------------------------------------------------
339 CALL hm_get_intv('N_inter_P',ninterp,is_available,lsubmodel)
340
341 ninters = 0
342 IF(ninterp > 0) THEN
343 DO nip=1,ninterp
344
345C EXTRACT DATAS (INTEGER VALUES)
346
347 CALL hm_get_int_array_index('Inter_IDs',idint,nip,is_available,lsubmodel)
348 CALL hm_get_float_array_index('Gap_shift_i',gap_i,nip,is_available,lsubmodel,unitab)
349 tinter = 0
350 IF(idint > 0 ) THEN
351 DO ni=1,nbinter
352 IF(id_inter(ni) == idint)THEN
353 interloadp(nintloadp+nip)= ni
354 IF(inter_typ(ni) == 21) nintloadp21 = nintloadp21 + 1
355 tinter = 1
356 dgapint(ni)=max(dgapint(ni),gap_i)
357 intgaploadp(nintloadp+nip)= gap_i
358 END IF
359 END DO
360 IF(tinter==0)THEN
361 CALL ancmsg(msgid=2021,
362 . msgtype=msgerror,
363 . anmode=aninfo,
364 . i1=id,
365 . c1=titr,
366 . i2=idint)
367 ENDIF
368 ninters = ninters + 1
369 ENDIF
370 ENDDO
371 ENDIF
372C--------------
373C Storage
374C--------------
375 IF(is/=0)THEN
376 iloadp( 3,k+nidxload) = ifuncl
377 iloadp( 4,k+nidxload) = iad
378 iloadp( 5,k+nidxload) = ninters
379 iloadp( 6,k+nidxload) = idir
380 iloadp( 7,k+nidxload) = isens
381 iloadp( 8,k+nidxload) = noskew
382 iloadp( 9,k+nidxload) = inorm
383 iloadp(10,k+nidxload) = iload
384
385 facloadp( 1,k+nidxload) = fcy
386 facloadp( 2,k+nidxload) = one/fcx
387 !Multidomaines -> on decompte les seg communs, on ne les compte qu'une foi---
388 IF (iddom>0) nn = nn-isurf_r2r(1,is)
389 ENDIF
390
391 WRITE (iout,2002)
392 WRITE (iout,'(I10,2X,I10,2X,I10,2X,I10,9X,A1,2X,I10,2X,
393 . 1PG20.13,2X,1PG20.13)')isu,ifunc,idsens,inorm,dir(1:1),idskew,fcx,fcy
394 IF(ninters > 0) THEN
395 WRITE (iout,2003)
396 j = 0
397 DO i=1,(ninters/10)
398 WRITE (iout,'(10(6X,I10,4X))')id_inter(interloadp(nintloadp+1:nintloadp+10))
399 WRITE (iout,'(10G20.13)')intgaploadp(nintloadp+1:nintloadp+10)
400 j = j +10
401 ENDDO
402 IF(modulo(ninters,10) > 0) THEN
403 WRITE (iout,'(10(6X,I10,4X))')id_inter(interloadp(nintloadp+j+1:nintloadp+ninterp))
404 WRITE (iout,'(10G20.13)')intgaploadp(nintloadp+j+1:nintloadp+ninters)
405 ENDIF
406 ENDIF
407 numloadp = numloadp + 4*nn
408 nintloadp = nintloadp + ninters
409
410 ENDDO ! next K (next /LOAD/PRESSURE)
411
412
413 IF(nintloadp > 0) THEN
414 nik = 0
415 DO k=1,nloadp_hyd
416 ninterp = iloadp(5,k+nidxload)
417 DO n=1,ninterp
418 ni = interloadp(nik + n)
419 kloadpinter(ni) = kloadpinter(ni)+1
420 ENDDO
421 nik = nik + ninterp
422 ENDDO
423
424 DO n=1,ninter
425 kloadpinter(n+1) = kloadpinter(n+1) + kloadpinter(n)
426 END DO
427
428 DO n=ninter,1,-1
429 kloadpinter(n+1) = kloadpinter(n)
430 END DO
431 kloadpinter(1)=0
432
433 nik = 0
434 DO k=1,nloadp_hyd
435 ninterp = iloadp(5,k+nidxload)
436 DO n=1,ninterp
437 ni = interloadp(nik + n)
438 kloadpinter(ni) = kloadpinter(ni)+1
439 loadpinter(kloadpinter(ni)) = k
440 dgaploadint(kloadpinter(ni)) = intgaploadp(nik + n)
441
442 ENDDO
443 nik = nik + ninterp
444 ENDDO
445
446 DO n=ninter,1,-1
447 kloadpinter(n+1) = kloadpinter(n)
448 END DO
449 kloadpinter(1)=0
450
451 ENDIF
452
453 DEALLOCATE (id_inter,inter_typ)
454
455C-------------------------------------------------------------------------------C
456 RETURN
457C--------------------------------------------------------------------------------C
458 2002 FORMAT(//
459
460 . ' PRESSURE LOADS (GENERAL) '/
461 . ' ------------------ '/
462 . ' SURFACE CURVE SENSOR INORM DIRECTION SKEW',
463 . ' SCALE_X SCALE_Y')
464
465 2003 FORMAT(//
466 . ' INTERFACES AND GAP SHIFTS')
467
468C-----------------------------------------------
469 END SUBROUTINE hm_read_load_pressure
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
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_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
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_read_load_pressure
subroutine hm_read_load_pressure(numloadp, iloadp, lloadp, interloadp, facloadp, kloadpinter, loadpinter, npc, sensors, igrsurf, unitab, iskn, lsubmodel, dgapint, intgaploadp, dgaploadint, s_loadpinter, pblast)
Definition hm_read_load_pressure.F:48
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
lectur
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723