38
39
40
41 USE ebcs_mod
44 USE multi_fvm_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,UID
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 LOGICAL IS_AVAILABLE,IS_ENCRYPTED
67 TYPE(t_ebcs_nrf), INTENT(INOUT) :: EBCS
68
69
70
71 INTEGER ISU,SURF,J,NSEG
72 INTEGER IMAT,IFLAGUNIT
74 INTEGER, DIMENSION(:), POINTER :: INGR2USR
75 INTEGER, EXTERNAL :: NGR2USR
76
77
78
79
80 ebcs%title = trim(titr)
81
82 iflagunit=0
83 DO j=1,unitab%NUNITS
84 IF (unitab%UNIT_ID(j) == uid) THEN
85 iflagunit = 1
86 EXIT
87 ENDIF
88 ENDDO
89 IF (uid/=0.AND.iflagunit==0) THEN
90 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,i2=uid,i1=
id,c1=
'EBCS',c2=
'EBCS',c3=titr)
91 ENDIF
92
94 CALL hm_get_intv(
'entityid', surf ,is_available,lsubmodel)
95 CALL hm_get_floatv(
'tcar_p', tcar_p ,is_available,lsubmodel,unitab)
96 CALL hm_get_floatv(
'tcar_vf', tcar_vf ,is_available,lsubmodel,unitab)
97
98 IF(tcar_vf == zero)tcar_vf = infinity
99
100 ebcs%TITLE = titr
101 ebcs%tcar_p = tcar_p
102 ebcs%tcar_vf = tcar_vf
103 ebcs%HAS_IELEM = .true.
104
105 IF(multi_fvm%IS_USED)THEN
106 ebcs%is_multifluid = .true.
107 ENDIF
108
109 ebcs%fvm_inlet_data%FUNC_VEL(1:3) = -1
110 ebcs%fvm_inlet_data%VAL_VEL(1:3) = zero
111 ebcs%fvm_inlet_data%FORMULATION = 2
112 ebcs%fvm_inlet_data%VECTOR_VELOCITY
113 DO imat = 1, 21
114 ebcs%fvm_inlet_data%FUNC_ALPHA(imat) = -1
115 ebcs%fvm_inlet_data%FUNC_RHO(imat) = -1
116 ebcs%fvm_inlet_data%FUNC_PRES(imat) = -1
117 ebcs%fvm_inlet_data%VAL_ALPHA(imat) = zero
118 ebcs%fvm_inlet_data%VAL_RHO(imat) = zero
119 ebcs%fvm_inlet_data%VAL_PRES(imat) = zero
120 ENDDO
121
122 isu=0
123 ingr2usr => igrsurf(1:nsurf)%ID
124 IF (surf/=0) isu=
ngr2usr(surf,ingr2usr,nsurf)
125 nseg=0
126 IF (isu/=0) nseg=igrsurf(isu)%NSEG
127 IF(surf==0)THEN
128 ierr=ierr+1
129 WRITE(istdo,'(6X,A)')' ** A SURFACE SHOULD BE INPUT'
130 WRITE(iout, '(6X,A)')' ** A SURFACE SHOULD BE INPUT'
131 ELSEIF(isu==0)THEN
132 ierr=ierr+1
133 WRITE(istdo,*)' ** ERROR SURFACE NOT FOUND, ID=',surf
134 WRITE(iout,*) ' ** ERROR SURFACE NOT FOUND, ID=',surf
135 ELSEIF(nseg==0)THEN
136 ierr=ierr+1
137 WRITE(istdo,*)' ** ERROR EMPTY SURFACE',surf
138 WRITE(iout,*) ' ** ERROR EMPTY SURFACE',surf
139 ENDIF
140
141 ebcs%nb_elem = nseg
142
143 WRITE(iout,1001)
id, trim(titr)
144 WRITE(iout,1118)surf,nseg,tcar_p,tcar_vf
145
146
147
148 RETURN
149
150 1001 FORMAT( //'NON-REFLECTING FRONTIER EBCS NUMBER. . . . :',i8,1x,a)
151
152 1118 FORMAT(
153 . ' ON SURFACE . . . . . . . . . . . . . . . ',i8,/,
154 . ' NUMBER OF SEGMENTS FOUND. . . . . . . . . ',i8,/,
155 . ' TCAR_P . . . . . . . . . . . . . . . . . ',e20.12,/,
156 . ' TCAT_ALPHA . . . . . . . . . . . . . . . ',e20.12,/)
157
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, parameter ncharkey
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)