OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
link_with_unique_master_cell.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

integer function link_with_unique_main_cell (sharedface, centroid)

Function/Subroutine Documentation

◆ link_with_unique_main_cell()

integer function link_with_unique_main_cell ( sharedface,
centroid )

Definition at line 33 of file link_with_unique_master_cell.F.

35C-----------------------------------------------
36C D e s c r i p t i o n
37C-----------------------------------------------
38C Interface Type22 (/INTER/TYPE22) is an FSI coupling method based on cut cell method.
39C This experimental cut cell method is not completed, abandoned, and is not an official option.
40C
41! With interface 22 Hexahedral cell is cut and
42! main one is the biggest one which is greater
43! then 50%. In case of multiple choice (2 are
44! 50%-50% or several if criteria is reduced) we
45! must ensure a unique choice which is repeatable
46! with plateform and also different numbering.
47!
48! Here is chosen a sort by coordinates weighting
49! X,Y,Z components. a score is computed
50C-----------------------------------------------
51C M o d u l e s
52C-----------------------------------------------
53 USE initbuf_mod
55 USE i22tri_mod
56 USE elbufdef_mod
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "comlock.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER :: LINK_WITH_UNIQUE_MAIN_CELL
69 my_real :: sharedface(6), centroid(3,6)
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER :: IsMain, N, IPOS, LEVEL, IIP
74 my_real :: score(6), max, nextmax, mysum
75 my_real :: xyzmax(3)
76C-----------------------------------------------
77C P r e - C o n d i t i o n
78C-----------------------------------------------
79 !IF(INT22==0)RETURN !already checked
80 !IF(K<2) RETURN !already checked
81C-----------------------------------------------
82C S o u r c e L i n e s
83C-----------------------------------------------
84 ipos = 1
85 level = 3 !3:X, 2:Y, 1:Z
86 score(1:6) = zero
87
88 ipos = maxloc(sharedface(1:6),1)
89
90 IF(sharedface(ipos) == zero) THEN
92 RETURN
93 ENDIF
94
95 mysum = sum(sharedface(1:ipos-1))
96 IF (ipos/=6)THEN
97 mysum = mysum + sum(sharedface(ipos+1:6))
98 ENDIF
99 IF (mysum == zero)THEN
101 RETURN
102 ENDIF
103
104 xyzmax(1) = maxval(centroid(1,1:6))
105 xyzmax(2) = maxval(centroid(2,1:6))
106 xyzmax(3) = maxval(centroid(3,1:6))
107
108 !find max
109 max = sharedface(ipos) !init with maximum value
111 !score it
112 score(ipos) = 1000*(xyzmax(1)-centroid(1,ipos))+ 100*(xyzmax(2)-centroid(2,ipos))+ 10*(xyzmax(3)-centroid(3,ipos))
113
114 !find other ones equal to MAX
115 IF (ipos == 6)RETURN
116 iip = ipos
117 DO WHILE(iip < 6)
118 iip = maxloc(sharedface(iip+1:6),1)
119 nextmax = sharedface(iip)
120 IF (nextmax == max) THEN
121 score(ipos) = 1000*(xyzmax(1)-centroid(1,iip))+100 * (xyzmax(2)-centroid(2,iip)) + 10*(xyzmax(3)-centroid(3,iip))
122 ENDIF
123 ENDDO
124
125 ipos = maxloc(score(1:6),1)
127
128 RETURN
#define my_real
Definition cppsort.cpp:32
#define max(a, b)
Definition macros.h:21