OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
insurf_dx.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!|| insurf_dx ../starter/source/interfaces/interf1/insurf_dx.F
25!||--- called by ------------------------------------------------------
26!|| lecint ../starter/source/interfaces/interf1/lecint.F
27!||--- uses -----------------------------------------------------
28!|| format_mod ../starter/share/modules1/format_mod.F90
29!|| message_mod ../starter/share/message_module/message_mod.F
30!||====================================================================
31 SUBROUTINE insurf_dx(NRT ,MSN ,IR ,IRECT ,NOINT ,
32 . SURF_NODES,ITAB ,MSV ,ID ,TITR ,
33 . NTAG ,S_MSV ,SIRECT, X, STIFF_STAT)
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE message_mod
38 USE names_and_titles_mod , ONLY : nchartitle
39 USE format_mod , ONLY : fmw_4i
40C-----------------------------------------------
41C LECTURE DES SURFACES ET DECOMPTE DES SEGMENTS
42C ENTREE :
43C NRT NOMBRE DE RENSEIGNEMENTS A LIRE
44C SORTIE :
45C IRECT
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "units_c.inc"
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "scr03_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NRT,IR,MSN
61 INTEGER,INTENT(IN) :: S_MSV,SIRECT
62 INTEGER IRECT(4,SIRECT/4), ITAB(NUMNOD), MSV(S_MSV),SURF_NODES(NRT,4)
63 INTEGER ID
64 my_real, INTENT(INOUT) :: x(3,numnod)
65 CHARACTER(LEN=NCHARTITLE) :: TITR
66 INTEGER, DIMENSION(2*NUMNOD+1), INTENT(INOUT) :: NTAG
67 my_real, INTENT(INOUT) :: stiff_stat(3)
68 INTEGER,INTENT(IN) :: NOINT
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I,K,K4
73 my_real :: SURF, S2n(3), D1(3), D2(3), SURF_MAX, SURF_MIN, SURF_MEAN, STVAL,VEL
74C-----------------------------------------------
75C S o u r c e L i n e s
76C-----------------------------------------------
77
78 surf_min = ep20
79 surf_max = zero
80 surf_mean = zero
81 DO i=1,nrt
82 IF(irect(3,i)==irect(4,i)) THEN
83 d1(1)=x(1,irect(1,i))-x(1,irect(3,i))
84 d1(2)=x(2,irect(1,i))-x(2,irect(3,i))
85 d1(3)=x(3,irect(1,i))-x(3,irect(3,i))
86 d2(1)=x(1,irect(2,i))-x(1,irect(1,i))
87 d2(2)=x(2,irect(2,i))-x(2,irect(1,i))
88 d2(3)=x(3,irect(2,i))-x(3,irect(1,i))
89 s2n(1) = d1(2)*d2(3)-d1(3)*d2(2)
90 s2n(2) = - d1(1)*d2(3)+d1(3)*d2(1)
91 s2n(3) = d1(1)*d2(2)-d1(2)*d2(1)
92 surf = s2n(1)*s2n(1) + s2n(2)*s2n(2) + s2n(3)*s2n(3)
93 surf = sqrt(fourth*surf)
94 ELSE
95 d1(1)=x(1,irect(1,i))-x(1,irect(3,i))
96 d1(2)=x(2,irect(1,i))-x(2,irect(3,i))
97 d1(3)=x(3,irect(1,i))-x(3,irect(3,i))
98 d2(1)=x(1,irect(2,i))-x(1,irect(4,i))
99 d2(2)=x(2,irect(2,i))-x(2,irect(4,i))
100 d2(3)=x(3,irect(2,i))-x(3,irect(4,i))
101 s2n(1) = d1(2)*d2(3)-d1(3)*d2(2)
102 s2n(2) = - d1(1)*d2(3)+d1(3)*d2(1)
103 s2n(3) = d1(1)*d2(2)-d1(2)*d2(1)
104 surf = s2n(1)*s2n(1) + s2n(2)*s2n(2) + s2n(3)*s2n(3)
105 surf = sqrt(fourth*surf)
106 ENDIF
107
108 surf_max = max(surf_max,surf)
109 surf_min = min(surf_min,surf)
110 surf_mean = surf_mean + surf/real(nrt)
111
112 ENDDO
113
114 stval = stiff_stat(1)*stiff_stat(2)*surf_mean/stiff_stat(3)
115
116 stiff_stat(1) = -stval
117
118
119 WRITE(iout,1000)noint
120 WRITE(iout,3021)stval, stiff_stat(2), surf_mean, surf_min, surf_max
121 IF(ipri>=1) THEN
122 WRITE(iout,'(/,A,/)')' SEGMENTS USED FOR SURFACE DEFINITION'
123 k=1
124 k4=4
125 IF(n2d/=0)k4=2
126 DO i=1,nrt
127 WRITE(iout,fmt=fmw_4i)(itab(irect(k,i)),k=1,k4)
128 ENDDO
129 ENDIF
130
131C------------------------------------------------------------
132 RETURN
1331000 FORMAT(/1x,' INTERFACE NUMBER :',i10,1x,a)
1343021 FORMAT(
135 . ' COMPUTED STIFFNESS VALUE. . . . . . . . . . ',1pg20.13,/,
136 . ' . . .USING DENSITY. . . . ',1pg20.13,/,
137 . ' . . .USING MEAN AREA. . . ',1pg20.13,/,
138 . ' . . . . . . . . .MIN. . . ',1pg20.13,/,
139 . ' . . . . . . . . .MAX . . ',1pg20.13)
140
141
142 END
my_real
#define my_real
Definition cppsort.cpp:32
insurf_dx
subroutine insurf_dx(nrt, msn, ir, irect, noint, surf_nodes, itab, msv, id, titr, ntag, s_msv, sirect, x, stiff_stat)
Definition insurf_dx.F:34
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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