OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_sphio.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_sphio ../starter/source/loads/sph/hm_read_sphio.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| get_u_geo ../starter/source/user_interface/uaccess.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_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!|| subrotpoint ../starter/source/model/submodel/subrot.F
36!|| udouble ../starter/source/system/sysfus.F
37!|| usr2sys ../starter/source/system/sysfus.F
38!||--- uses -----------------------------------------------------
39!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
40!|| message_mod ../starter/share/message_module/message_mod.F
41!|| r2r_mod ../starter/share/modules1/r2r_mod.F
42!|| submodel_mod ../starter/share/modules1/submodel_mod.F
43!||====================================================================
44 SUBROUTINE hm_read_sphio(ISPHIO ,VSPHIO ,IPART ,IGRSURF ,
45 . NOD2SP ,IPARTSP ,ITAB ,X ,
46 . MFI ,LWASPIO ,ITABM1 ,UNITAB ,
47 . LSUBMODEL,RTRANS ,NRTRANS )
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE message_mod
52 USE r2r_mod
53 USE groupdef_mod
54 USE hm_option_read_mod
55 USE submodel_mod
56 USE unitab_mod
57 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "com04_c.inc"
66#include "sphcom.inc"
67#include "units_c.inc"
68#include "scr17_c.inc"
69#include "r2r_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER ISPHIO(NISPHIO,*), IPART(LIPART1,*),
74 . NOD2SP(*),IPARTSP(*),
75 . ITAB(*),MFI,LWASPIO,ITABM1(*)
76 INTEGER, INTENT(IN) :: NRTRANS
77 my_real
78 . VSPHIO(*),X(3,*)
79 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
80 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
81 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
82 my_real, DIMENSION(NTRANSF,NRTRANS),INTENT(IN) :: rtrans
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER I, N, ID, J, IDS, IDPRT, IPRT, INOD, ICEL,
87 . IPROP, ISU, NSEG,
88 . MFITMP, IVAD, LVAD, ITYPE, IDSURF, IFTEMP,
89 . ifvits,ifdens, ifpres, ifener,skip,
90 . iad,in1,in2,in3,in4, iun,nbox,nboy,nboz,nband,sub_id
91 CHARACTER MESS*40
92 CHARACTER(LEN=NCHARTITLE) :: TITR
93 CHARACTER(LEN=NCHARKEY) :: KEY
94 my_real
95 . bid,rhoin,pin,ein,dist,
96 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
97 . x12,y12,z12,x13,y13,z13,nn,nx,ny,nz,
98 . dbucs,xbmin,ybmin,zbmin,xbmax,ybmax,zbmax,
99 . pinfini,carl,xx(9),fcut,
100 . rhoin_unit,pin_unit,ein_unit,xl(3)
101 LOGICAL IS_AVAILABLE,FOUND
102C-----------------------------------------------
103 DATA MESS/'SPH INLET/OUTLET DEFINITION '/
104 DATA iun/1/
105C-----------------------------------------------
106C E x t e r n a l F u n c t i o n s
107C-----------------------------------------------
108 INTEGER USR2SYS
109 my_real
110 . GET_U_GEO
111 EXTERNAL get_u_geo
112C-----------------------------------------------
113C TYPE=1 TYPE=2 TYPE=3 TYPE=4
114C ISPHIO(1,N) = CONDITION TYPE x x x x
115C 1: INLET 2:GENERAL OUTLET 3:CONTINUE OUTLET
116C ISPHIO(2,N) = NODES GROUP RELATED TO THE CONDITION x x x x
117C ISPHIO(3,N) = SURFACE x x x
118C ISPHIO(4,N) = x x x
119C IVAD : INDEX OF REAL CORRESPONDING ARRAY INTO VSPHIO
120C ISPHIO(5,N) = DENSITY FUNCTION NUMBER x x
121C ISPHIO(6,N) = PRESSURE FUNCTION NUMBER x x
122C ISPHIO(7,N) = ENERGY FUNCTION NUMBER x x
123C ISPHIO(8,N) = NORMAL VELOCITY FUNCTION NUMBER x
124C ISPHIO(9,N) = CONDITION IDENTIFIER x x x x
125C ISPHIO(10,N) = NB SEG IO x x x
126C ISPHIO(11,N) = IAD for // outlet x x x x
127C ISPHIO(12,N) = type of input x x x
128C ISPHIO(13,N) = id of nod1 x x x
129C ISPHIO(14,N) = id of nod2 x x x
130C ISPHIO(15,N) = id of nod3 x x x
131C-----------------------------------------------
132C TYPE=1 TYPE=2 TYPE=3 TYPE=4
133C VSPHIO(IVAD ) = RHOIN x
134C VSPHIO(IVAD+1) = PIN x x x
135C VSPHIO(IVAD+2) = EIN x
136C VSPHIO(IVAD+3) = WITHIN/WITHOUT DISTANCE x x x x
137C
138Case TYPE=1
139C VSPHIO(IVAD+4+2*J,J=0,NSEG-1) = x
140C MASS FLOW THROUGH SEGMENT J SINCE LAST ENTRY
141C VSPHIO(IVAD+5+2*J,J=0,NSEG-1) = SEGMENTS WIDTH x
142Case TYPE=2,3,4 control section + new outlet / silent boundary (if surface defined by coordinates)
143C VSPHIO(IVAD+4->6) = X1 x x x
144C VSPHIO(IVAD+7->9) = X2 x x x
145C VSPHIO(IVAD+10->12) = X3 x x x
146Case TYPE=2,3,4 control section + new outlet / silent boundary
147C VSPHIO(IVAD+13) = Total mass that cross section x x x
148C VSPHIO(IVAD+14) = DT12 x x x
149C VSPHIO(IVAD+15) = Fcut Butterworth filter x x x
150C VSPHIO(IVAD+16) = Filtered mass that cross section x x x
151C VSPHIO(IVAD+17->21) = Butterworth data x x x
152C-----------------------------------------------
153 lwaspio = 0
154 nseg_io = 0
155 is_available = .false.
156C
157 mfitmp = mfi
158 ivad = 1
159C
160 ! Start reading the option
161 CALL hm_option_start('/SPH/INOUT')
162C
163 ! Loop over /SPH/INOUT
164 i = 0
165 DO n = 1,nsphio
166 skip = 0
167CC----------Multidomaines --> on ignore les inlets non tages------------
168 IF (nsubdom > 0) THEN
169 IF (tagsphio(n) == 0) skip = 1
170 ENDIF
171C----------------------------------------------------------------------
172 IF (skip == 0) THEN
173C
174 ! Title and ID
175 titr = ''
176 CALL hm_option_read_key(lsubmodel,
177 . option_id = id,
178 . option_titr = titr,
179 . submodel_id = sub_id)
180C
181 i = i+1
182 isphio(nisphio,i)=id
183C
184 ! Read card 1
185 CALL hm_get_intv('Itype' ,itype ,is_available,lsubmodel)
186 CALL hm_get_intv('pid' ,idprt ,is_available,lsubmodel)
187 CALL hm_get_intv('SURF_ID' ,idsurf ,is_available,lsubmodel)
188 CALL hm_get_floatv('DIST' ,dist ,is_available,lsubmodel, unitab)
189
190 CALL hm_get_intv('node_ID1',in1 ,is_available,lsubmodel)
191 CALL hm_get_intv('node_ID2',in2 ,is_available,lsubmodel)
192 CALL hm_get_intv('node_ID3',in3 ,is_available,lsubmodel)
193 CALL hm_get_floatv('Fcut' ,fcut ,is_available,lsubmodel, unitab)
194 isphio(1,i) =itype
195C
196 ids = 0
197 found = .false.
198 DO j = 1,npart
199 IF (ipart(4,j) == idprt) THEN
200 ids = j
201 found = .true.
202 EXIT
203 ENDIF
204 ENDDO
205 IF (.NOT.found) THEN
206 CALL ancmsg(msgid=437,
207 . msgtype=msgerror,
208 . anmode=aninfo,
209 . i1=id,
210 . c1=titr,
211 . i2=idprt)
212 ENDIF
213 isphio(2,i) = ids
214 isphio(4,i) = ivad
215C
216 IF (idsurf > 0) THEN
217C input by surfid
218 ids=0
219 found = .false.
220 DO j=1,nsurf
221 IF (igrsurf(j)%ID == idsurf) THEN
222 ids=j
223 found = .true.
224 EXIT
225 ENDIF
226 ENDDO
227 IF (.NOT.found) THEN
228 CALL ancmsg(msgid=438,
229 . msgtype=msgerror,
230 . anmode=aninfo,
231 . i1=id,
232 . c1=titr,
233 . i2=idsurf)
234 ENDIF
235 isphio(3,i) =ids
236 ELSEIF ((in1 == 0).AND.(in2 == 0).AND.(in3 == 0)) THEN
237C input by coordinates -> ISPHIO(12,I) = 1
238 isphio(12,i) =1
239 CALL hm_get_floatv('XM' ,xx(1) ,is_available,lsubmodel, unitab)
240 CALL hm_get_floatv('YM' ,xx(2) ,is_available,lsubmodel, unitab)
241 CALL hm_get_floatv('ZM' ,xx(3) ,is_available,lsubmodel, unitab)
242 CALL hm_get_floatv('XM1' ,xx(4) ,is_available,lsubmodel, unitab)
243 CALL hm_get_floatv('YM1' ,xx(5) ,is_available,lsubmodel, unitab)
244 CALL hm_get_floatv('ZM1' ,xx(6) ,is_available,lsubmodel, unitab)
245 CALL hm_get_floatv('XM2' ,xx(7) ,is_available,lsubmodel, unitab)
246 CALL hm_get_floatv('YM2' ,xx(8) ,is_available,lsubmodel, unitab)
247 CALL hm_get_floatv('ZM2' ,xx(9) ,is_available,lsubmodel, unitab)
248 IF(sub_id /= 0) THEN
249 xl(1:3) = xx(1:3)
250 CALL subrotpoint(xl(1),xl(2),xl(3),rtrans,sub_id,lsubmodel)
251 xx(1:3) = xl(1:3)
252 xl(1:3) = xx(4:6)
253 CALL subrotpoint(xl(1),xl(2),xl(3),rtrans,sub_id,lsubmodel)
254 xx(4:6) = xl(1:3)
255 xl(1:3) = xx(7:9)
256 CALL subrotpoint(xl(1),xl(2),xl(3),rtrans,sub_id,lsubmodel)
257 xx(7:9) = xl(1:3)
258 END IF
259 DO j = 1,9
260 vsphio(ivad+3+j) = xx(j)
261 ENDDO
262 ELSE
263C input by node ID -> ISPHIO(12,I) = 2
264 isphio(12,i) = 2
265 isphio(13,i) = usr2sys(in1,itabm1,mess,id)
266 isphio(14,i) = usr2sys(in2,itabm1,mess,id)
267 isphio(15,i) = usr2sys(in3,itabm1,mess,id)
268 ENDIF
269C
270 IF (itype == 1) THEN
271 nseg=igrsurf(ids)%NSEG
272 lvad=4+2*nseg
273 ELSE
274 lvad=22
275 ENDIF
276C
277 IF (itype == 1)THEN
278 CALL hm_get_intv('FUN_A1' ,ifdens ,is_available,lsubmodel)
279 CALL hm_get_floatv('R0k0' ,rhoin ,is_available,lsubmodel,unitab)
280 IF ((rhoin == zero).AND.(ifdens>0)) THEN
281 CALL hm_get_floatv_dim('R0k0' ,rhoin_unit ,is_available, lsubmodel, unitab)
282 rhoin = one * rhoin_unit
283 ENDIF
284 CALL hm_get_intv('FUN_A6' ,ifener ,is_available,lsubmodel)
285 CALL hm_get_floatv('MAT_E0',ein ,is_available,lsubmodel,unitab)
286 IF ((ein == zero).AND.(ifener>0)) THEN
287 CALL hm_get_floatv_dim('MAT_E0' ,ein_unit ,is_available, lsubmodel, unitab)
288 ein = one * ein_unit
289 ENDIF
290 CALL hm_get_intv('FUN_A3' ,ifvits ,is_available,lsubmodel)
291 ELSEIF (itype == 2) THEN
292 CALL hm_get_intv('FUN_A2' ,ifpres ,is_available,lsubmodel)
293 CALL hm_get_floatv('MAT_P0' ,pin ,is_available,lsubmodel,unitab)
294 IF ((pin == zero).AND.(ifpres>0)) THEN
295 CALL hm_get_floatv_dim('MAT_P0' ,pin_unit ,is_available, lsubmodel, unitab)
296 pin = one * pin_unit
297 ENDIF
298 ELSEIF (itype == 3) THEN
299 CALL hm_get_intv('FUN_A4' ,ifpres ,is_available,lsubmodel)
300 CALL hm_get_floatv('MAT_PScale',pin ,is_available,lsubmodel, unitab)
301 IF ((pin == zero).AND.(ifpres>0)) THEN
302 CALL hm_get_floatv_dim('MAT_PScale' ,pin_unit ,is_available, lsubmodel, unitab)
303 pin = one * pin_unit
304 ENDIF
305 CALL hm_get_floatv('Lc' ,carl ,is_available,lsubmodel, unitab)
306 ENDIF
307C
308 IF (itype == 1) THEN
309 isphio(5,i) = ifdens
310 isphio(7,i) = ifener
311 isphio(8,i) = ifvits
312 ELSEIF (itype == 2) THEN
313 isphio(6,i) = ifpres
314 ELSEIF (itype == 3) THEN
315 isphio(6,i) = ifpres
316 ENDIF
317!
318 IF (itype == 1) THEN
319 IF ((ifdens /= 0).AND.(rhoin == zero)) rhoin = one
320 IF ((ifener /= 0).AND.(ein == zero)) ein = one
321 vsphio(ivad ) = rhoin
322 vsphio(ivad+2) = ein
323 vsphio(ivad+3) = dist
324 ELSEIF (itype == 2) THEN
325 vsphio(ivad+1) = pin
326 vsphio(ivad+3) = dist
327 vsphio(ivad+15) = fcut
328 ELSEIF (itype == 3) THEN
329 vsphio(ivad+1) = pin
330 vsphio(ivad+2) = carl
331 vsphio(ivad+3) = dist
332 vsphio(ivad+15) = fcut
333 ELSEIF (itype == 4) THEN
334 vsphio(ivad+15) = fcut
335 ENDIF
336 mfitmp = mfitmp+lvad
337 ivad = ivad+lvad
338C----------------------------------------------------------------------
339 ENDIF
340 ENDDO
341 mfi = mfitmp
342C-------------------------------------
343C Recherche des ID doubles
344C-------------------------------------
345 CALL udouble(isphio(nisphio,1),nisphio,nsphio,mess,0,bid)
346C-------------------------------------
347C inlets, pre-computes surface of segments.
348C-------------------------------------
349 DO n=1,nsphio
350 IF(isphio(1,n)==1)THEN
351 ivad=isphio(4,n)+5
352 isu =isphio(3,n)
353 nseg=igrsurf(isu)%NSEG
354 DO j=1,nseg
355 in1=igrsurf(isu)%NODES(j,1)
356 in2=igrsurf(isu)%NODES(j,2)
357 in3=igrsurf(isu)%NODES(j,3)
358 in4=igrsurf(isu)%NODES(j,4)
359 x1=x(1,in1)
360 y1=x(2,in1)
361 z1=x(3,in1)
362 x2=x(1,in2)
363 y2=x(2,in2)
364 z2=x(3,in2)
365 x3=x(1,in3)
366 y3=x(2,in3)
367 z3=x(3,in3)
368 x12=x1-x2
369 y12=y1-y2
370 z12=z1-z2
371 x13=x3-x2
372 y13=y3-y2
373 z13=z3-z2
374 nx=y12*z13-z12*y13
375 ny=z12*x13-x12*z13
376 nz=x12*y13-y12*x13
377 nn =sqrt(nx*nx+ny*ny+nz*nz)
378 IF(in4/=in3)THEN
379 x4=x(1,in4)
380 y4=x(2,in4)
381 z4=x(3,in4)
382 x12=x1-x4
383 y12=y1-y4
384 z12=z1-z4
385 x13=x3-x4
386 y13=y3-y4
387 z13=z3-z4
388 nx=y12*z13-z12*y13
389 ny=z12*x13-x12*z13
390 nz=x12*y13-y12*x13
391 nn =nn+sqrt(nx*nx+ny*ny+nz*nz)
392 ENDIF
393 vsphio(ivad)=half*nn
394 ivad=ivad+2
395 ENDDO
396 ENDIF
397 ENDDO
398C-------------------------------------
399C inlets, outlets : necessary work space (cf engine).
400C-------------------------------------
401 DO n=1,nsphio
402 IF(isphio(12,n)==0)THEN
403 ivad=isphio(4,n)
404 isu =isphio(3,n)
405 nseg=igrsurf(isu)%NSEG
406 nseg_io = nseg_io + nseg
407 dist =vsphio(ivad+3)
408 dbucs=dist
409 xbmin =1.e+20
410 ybmin =1.e+20
411 zbmin =1.e+20
412 xbmax=-1.e+20
413 ybmax=-1.e+20
414 zbmax=-1.e+20
415 DO j=1,nseg
416 in1=igrsurf(isu)%NODES(j,1)
417 in2=igrsurf(isu)%NODES(j,2)
418 in3=igrsurf(isu)%NODES(j,3)
419 in4=igrsurf(isu)%NODES(j,4)
420 x1=x(1,in1)
421 y1=x(2,in1)
422 z1=x(3,in1)
423 x2=x(1,in2)
424 y2=x(2,in2)
425 z2=x(3,in2)
426 x3=x(1,in3)
427 y3=x(2,in3)
428 z3=x(3,in3)
429 xbmin=min(xbmin,x1)
430 ybmin=min(ybmin,y1)
431 zbmin=min(zbmin,z1)
432 xbmax=max(xbmax,x1)
433 ybmax=max(ybmax,y1)
434 zbmax=max(zbmax,z1)
435 xbmin=min(xbmin,x2)
436 ybmin=min(ybmin,y2)
437 zbmin=min(zbmin,z2)
438 xbmax=max(xbmax,x2)
439 ybmax=max(ybmax,y2)
440 zbmax=max(zbmax,z2)
441 xbmin=min(xbmin,x3)
442 ybmin=min(ybmin,y3)
443 zbmin=min(zbmin,z3)
444 xbmax=max(xbmax,x3)
445 ybmax=max(ybmax,y3)
446 zbmax=max(zbmax,z3)
447 dbucs=max(dbucs,abs(x1-x2))
448 dbucs=max(dbucs,abs(y1-y2))
449 dbucs=max(dbucs,abs(z1-z2))
450 dbucs=max(dbucs,abs(x2-x3))
451 dbucs=max(dbucs,abs(y2-y3))
452 dbucs=max(dbucs,abs(z2-z3))
453 dbucs=max(dbucs,abs(x3-x1))
454 dbucs=max(dbucs,abs(y3-y1))
455 dbucs=max(dbucs,abs(z3-z1))
456 in4=igrsurf(isu)%NODES(j,4)
457 IF(in4/=in3)THEN
458 x4=x(1,in4)
459 y4=x(2,in4)
460 z4=x(3,in4)
461 xbmin=min(xbmin,x4)
462 ybmin=min(ybmin,y4)
463 zbmin=min(zbmin,z4)
464 xbmax=max(xbmax,x4)
465 ybmax=max(ybmax,y4)
466 zbmax=max(zbmax,z4)
467 dbucs=max(dbucs,abs(x1-x4))
468 dbucs=max(dbucs,abs(y1-y4))
469 dbucs=max(dbucs,abs(z1-z4))
470 dbucs=max(dbucs,abs(x2-x4))
471 dbucs=max(dbucs,abs(y2-y4))
472 dbucs=max(dbucs,abs(z2-z4))
473 dbucs=max(dbucs,abs(x3-x4))
474 dbucs=max(dbucs,abs(y3-y4))
475 dbucs=max(dbucs,abs(z3-z4))
476 ENDIF
477 ENDDO
478 xbmin=xbmin-dist
479 ybmin=ybmin-dist
480 zbmin=zbmin-dist
481 xbmax=xbmax+dist
482 ybmax=ybmax+dist
483 zbmax=zbmax+dist
484 nbox =max(iun,int((xbmax-xbmin)/dbucs))
485 nboy =max(iun,int((ybmax-ybmin)/dbucs))
486 nboz =max(iun,int((zbmax-zbmin)/dbucs))
487 nband=max(nbox,nboy,nboz)+1
488 ELSE
489 nband = 2
490 ENDIF
491 lwaspio=max(lwaspio,15*numsph+6*(nband+1)+12*nseg)
492 ENDDO
493 lwaspio=max(lwaspio,3*nsphio)
494C-------------------------------------
495C print
496C-------------------------------------
497 WRITE(iout,1000)
498 DO n=1,nsphio
499 ivad=isphio(4,n)
500 IF(isphio(1,n)==1)THEN
501 WRITE(iout,1100) isphio(nisphio,n),
502 . ipart(4,isphio(2,n)),igrsurf(isphio(3,n))%ID,
503 . isphio(5,n),vsphio(ivad),isphio(7,n),
504 . vsphio(ivad+2),isphio(8,n),vsphio(ivad+3)
505 ELSE
506 IF(isphio(1,n)==2)THEN
507 IF (isphio(12,n)==0) THEN
508 WRITE(iout,1200) isphio(nisphio,n),
509 . ipart(4,isphio(2,n)),igrsurf(isphio(3,n))%ID,
510 . isphio(6,n),vsphio(ivad+1),vsphio(ivad+3)
511 ELSE
512 WRITE(iout,1400) isphio(nisphio,n),
513 . ipart(4,isphio(2,n)),isphio(6,n),vsphio(ivad+1),vsphio(ivad+3)
514 ENDIF
515 ELSEIF(isphio(1,n)==3)THEN
516 IF (isphio(12,n)==0) THEN
517 WRITE(iout,1300) isphio(nisphio,n),
518 . ipart(4,isphio(2,n)),igrsurf(isphio(3,n))%ID,vsphio(ivad+3),
519 . isphio(6,n),vsphio(ivad+1),vsphio(ivad+2)
520 ELSEIF (isphio(12,n)==1) THEN
521 WRITE(iout,1500) isphio(nisphio,n),ipart(4,isphio(2,n)),
522 . isphio(6,n),vsphio(ivad+1),vsphio(ivad+2)
523 ENDIF
524 ELSEIF(isphio(1,n)==4)THEN
525 IF (isphio(12,n)==0) THEN
526 WRITE(iout,1600) isphio(nisphio,n),ipart(4,isphio(2,n)),
527 . igrsurf(isphio(3,n))%ID
528 ELSE
529 WRITE(iout,1700) isphio(nisphio,n),ipart(4,isphio(2,n))
530 ENDIF
531 ENDIF
532 IF (isphio(12,n)==1) THEN
533C input by coordinates
534 ivad=isphio(4,n)
535 WRITE(iout,2100) vsphio(ivad+4),vsphio(ivad+5),vsphio(ivad+6),
536 . vsphio(ivad+7),vsphio(ivad+8),vsphio(ivad+9),vsphio(ivad+10),
537 . vsphio(ivad+11),vsphio(ivad+12)
538 ELSEIF (isphio(12,n)==2) THEN
539C input by node ID
540 WRITE(iout,2200) itab(isphio(13,n)),itab(isphio(14,n)),itab(isphio(15,n))
541 ENDIF
542 IF (vsphio(ivad+15)>em20) WRITE(iout,2300) vsphio(ivad+15)
543 ENDIF
544 ENDDO
545C-------------------------------------
546C
547 RETURN
548C
549 1000 FORMAT(//
550 .' SPH INLET/OUTLET CONDITIONS '/
551 .' --------------------------- ')
552 1100 FORMAT(/5x ,'SPH INLET/OUTLET CONDITION ID ',i10
553 . /5x ,'TYPE INLET ',
554 . /10x,'PART RELATED TO CONDITION ',i10
555 . /10x,'INLET SURFACE ',i10
556 . /10x,'DENSITY FUNCTION ',i10
557 . /10x,'SCALE FACTOR ON DENSITY FUNCTION ',1pg20.13
558 . /10x,'ENERGY FUNCTION ',i10
559 . /10x,'SCALE FACTOR ON ENERGY FUNCTION ',1pg20.13
560 . /10x,'NORMAL VELOCITY FUNCTION ',i10
561 . /10x,'WITHIN DISTANCE FOR PARTICLES SETTING ',1pg20.13)
562 1200 FORMAT(/5x ,'SPH INLET/OUTLET CONDITION ID ',i10
563 . /5x ,'TYPE GENERAL OUTLET ',
564 . /10x,'PART RELATED TO CONDITION ',i10
565 . /10x,'OUTLET SURFACE ',i10
566 . /10x,'PRESSURE FUNCTION ',i10
567 . /10x,'SCALE FACTOR ON PRESSURE FUNCTION ',1pg20.13
568 . /10x,'WITHOUT DISTANCE FOR PARTICLES SETTING ',1pg20.13)
569 1300 FORMAT(/5x ,'SPH INLET/OUTLET CONDITION ID ',i10
570 . /5x ,'TYPE SILENT BOUNDARY ',
571 . /10x,'PART RELATED TO CONDITION ',i10
572 . /10x,'OUTLET SURFACE ',i10
573 . /10x,'WITHOUT DISTANCE FOR PARTICLES SETTING ',1pg20.13
574 . /10x,'PRESSURE FUNCTION ',i10
575 . /10x,'SCALE FACTOR ON PRESSURE FUNCTION ',1pg20.13
576 . /10x,'CHARACTERISTIC LENGTH ',1pg20.13)
577 1400 FORMAT(/5x ,'SPH INLET/OUTLET CONDITION ID ',i10
578 . /5x ,'TYPE GENERAL OUTLET ',
579 . /10x,'PART RELATED TO CONDITION ',i10
580 . /10x,'PRESSURE FUNCTION ',i10
581 . /10x,'SCALE FACTOR ON PRESSURE FUNCTION ',1pg20.13
582 . /10x,'WITHOUT DISTANCE FOR PARTICLES SETTING ',1pg20.13)
583 1500 FORMAT(/5x ,'SPH INLET/OUTLET CONDITION ID ',i10
584 . /5x ,'TYPE SILENT BOUNDARY ',
585 . /10x,'PART RELATED TO CONDITION ',i10
586 . /10x,'PRESSURE FUNCTION ',i10
587 . /10x,'SCALE FACTOR ON PRESSURE FUNCTION ',1pg20.13
588 . /10x,'WITHOUT DISTANCE FOR PARTICLES SETTING ',1pg20.13
589 . /10x,'CHARACTERISTIC LENGTH ',1pg20.13)
590 1600 FORMAT(/5x ,'SPH INLET/OUTLET CONDITION ID ',i10
591 . /5x ,'TYPE SPH CONTROL SECTION ',
592 . /10x,'PART RELATED TO CONTROL SECTION ',i10
593 . /10x,'SURFACE ',i10)
594 1700 FORMAT(/5x ,'SPH INLET/OUTLET CONDITION ID ',i10
595 . /5x ,'TYPE SPH CONTROL SECTION ',
596 . /10x,'PART RELATED TO CONTROL SECTION ',i10)
597C
598 2100 FORMAT(10x,'SURFACE DEFINED BY COORDINATES ',
599 . /10x,' --> COORDINATES OF NODE1 ',1pg20.13,1pg20.13,1pg20.13,
600 . /10x,' --> COORDINATES OF NODE2 ',1pg20.13,1pg20.13,1pg20.13,
601 . /10x,' --> COORDINATES OF NODE3 ',1pg20.13,1pg20.13,1pg20.13)
602C
603 2200 FORMAT(10x,'SURFACE DEFINED BY NODES ',i10,i10,i10)
604C
605 2300 FORMAT(10x,'4-POLE BUTTERWORTH CORNER FREQUENCY ',1pg20.13)
606C
607 RETURN
608 END
609
610
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_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_sphio
subroutine hm_read_sphio(isphio, vsphio, ipart, igrsurf, nod2sp, ipartsp, itab, x, mfi, lwaspio, itabm1, unitab, lsubmodel, rtrans, nrtrans)
Definition hm_read_sphio.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::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagsphio
integer, dimension(:), allocatable tagsphio
Definition r2r_mod.F:139
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
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589
subrotpoint
subroutine subrotpoint(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:180