OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_ebcs_inip.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_ebcs_inip (igrsurf, multi_fvm, unitab, id, titr, lsubmodel, ebcs)

Function/Subroutine Documentation

◆ hm_read_ebcs_inip()

subroutine hm_read_ebcs_inip ( type (surf_), dimension(nsurf), target igrsurf,
type (multi_fvm_struct), intent(inout) multi_fvm,
type (unit_type_), intent(in) unitab,
integer id,
character(len=nchartitle), intent(in) titr,
type(submodel_data), dimension(nsubmod) lsubmodel,
type(t_ebcs_inip), intent(inout) ebcs )

Definition at line 37 of file hm_read_ebcs_inip.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE unitab_mod
42 USE message_mod
43 USE multi_fvm_mod
44 USE groupdef_mod
45 USE submodel_mod
46 USE ebcs_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "units_c.inc"
56#include "com04_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
61 INTEGER ID
62 TYPE (MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
63 TYPE (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
64 CHARACTER(LEN=nchartitle), INTENT(IN) :: TITR
65 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
66 TYPE(t_ebcs_inip), INTENT(INOUT) :: EBCS
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER ISU,SURF,NGR2USR,NSEG
71 my_real c,rho,lcar
72 EXTERNAL ngr2usr
73 INTEGER, DIMENSION(:), POINTER :: INGR2USR
74 LOGICAL IS_ENCRYPTED, IS_AVAILABLE
75C-----------------------------------------------
76C S o u r c e L i n e s
77C-----------------------------------------------
78
79 ebcs%title = trim(titr)
80
81 CALL hm_option_is_encrypted(is_encrypted)
82 CALL hm_get_intv('entityid', surf ,is_available,lsubmodel)
83
84 isu=0
85 ingr2usr => igrsurf(1:nsurf)%ID
86 IF (surf/=0) isu=ngr2usr(surf,ingr2usr,nsurf)
87 nseg = 0
88 IF (isu/=0) nseg=igrsurf(isu)%NSEG
89 IF (surf==0)THEN
90 ierr=ierr+1
91 WRITE(istdo,'(6X,A)')' ** A SURFACE SHOULD BE INPUT'
92 WRITE(iout, '(6X,A)')' ** A SURFACE SHOULD BE INPUT'
93 ELSEIF(isu==0)THEN
94 ierr=ierr+1
95 WRITE(istdo,*)' ** ERROR SURFACE NOT FOUND, ID=',surf
96 WRITE(iout,*) ' ** ERROR SURFACE NOT FOUND, ID=',surf
97 ELSEIF(nseg==0)THEN
98 ierr=ierr+1
99 WRITE(istdo,*)' ** ERROR EMPTY SURFACE, ID=',surf
100 WRITE(iout,*) ' ** ERROR EMPTY SURFACE, ID=',surf
101 ELSE
102 WRITE(iout,1006)id,trim(titr)
103 CALL hm_get_floatv('rad_ebcs_rho', rho ,is_available,lsubmodel,unitab)
104 CALL hm_get_floatv('rad_ebcs_c', c ,is_available,lsubmodel,unitab)
105 CALL hm_get_floatv('rad_ebcs_lc', lcar ,is_available,lsubmodel,unitab)
106
107 WRITE(iout,1104)surf,nseg,rho,c,lcar
108 ENDIF
109
110 ebcs%title = titr
111 ebcs%c = c
112 ebcs%rho = rho
113 ebcs%lcar = lcar
114
115 IF (multi_fvm%IS_USED) THEN
116 CALL ancmsg(msgid = 1602, msgtype = msgerror, anmode = aninfo,
117 . i1 = id, c1 = trim(titr), c2 = "NOT COMPATIBLE WITH LAW 151")
118 ENDIF
119
120
121C-----------
122 RETURN
123C-----------
124 1006 FORMAT( //'INITIAL PRESSURE EBCS NUMBER . . . . . . :',i8,1x,a)
125 1104 FORMAT(
126 . ' ON SURFACE . . . . . . . . . . . . . . . ',i8,/,
127 . ' NUMBER OF SEGMENTS FOUND. . . . . . . . . ',i8,/,
128 . ' DENSITY . . . . . . . . . . . . . . . . . ',e16.6,/,
129 . ' SOUND SPEED . . . . . . . . . . . . . . . ',e16.6,/,
130 . ' CHARACTERISTIC LENGTH . . . . . . . . . . ',e16.6,/)
131
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
initmumps id
integer, parameter nchartitle
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
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