38
39
40
43 USE multi_fvm_mod
46 USE ebcs_mod
48
49
50
51#include "implicit_f.inc"
52
53
54
55#include "units_c.inc"
56#include "com04_c.inc"
57
58
59
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
67
68
69
70 INTEGER ISU,SURF,NGR2USR,NSEG
73 INTEGER, DIMENSION(:), POINTER :: INGR2USR
74 LOGICAL IS_ENCRYPTED, IS_AVAILABLE
75
76
77
78
79 ebcs%title = trim(titr)
80
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
121
122 RETURN
123
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
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)
integer, parameter nchartitle
integer function ngr2usr(iu, igr, ngr)
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)