OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cm58in3.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!|| cm58in3 ../starter/source/materials/mat/mat058/cm58in3.f
25!||--- called by ------------------------------------------------------
26!|| c3init3 ../starter/source/elements/sh3n/coque3n/c3init3.F
27!|| cinit3 ../starter/source/elements/shell/coque/cinit3.F
28!|| cmaini3 ../starter/source/elements/sh3n/coquedk/cmaini3.F
29!||====================================================================
30 SUBROUTINE cm58in3(IREP ,DIR1 ,DIR2 ,UPARAM ,
31 . UVAR ,ALDT ,NEL ,NUVAR ,TAN_PHI ,
32 . X1 ,X2 ,X3 ,X4 ,Y1 ,Y2 ,
33 . Y3 ,Y4 ,Z1 ,Z2 ,Z3 ,Z4 ,
34 . E1X ,E2X ,E3X ,E1Y ,E2Y ,E3Y ,E1Z ,E2Z ,E3Z )
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "vect01_c.inc"
43#include "param_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER NEL,NUVAR,IREP
48C REAL
49 my_real UPARAM(*),UVAR(NEL,*),ALDT(NEL),TAN_PHI(NEL),DIR1(NEL,2),DIR2(NEL,2)
50 my_real, DIMENSION(NEL), INTENT(IN) :: E1X,E2X,E3X,E1Y,E2Y,E3Y,E1Z,E2Z,E3Z,
51 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I
56 my_real
57 . R,S,D1,D2,D11,D12,D21,D22,U1X,U1Y,U2X,U2Y,DET,W1X,W2X,W1Y,W2Y,
58 . PHI,CSP,SNP,TANA,R1,R2,S1,S2,G0,AA,BB,SUMA,V1,V2,V3,WR,WS
59 my_real , DIMENSION(NEL) :: e11,e12,e13,e21,e22,e23
60C======================================================================|
61C--- isoparametric (material) axes
62 IF (ity == 3) THEN
63C--- shell 4N
64 DO i=1,nel
65 e11(i)= x2(i)+x3(i)-x1(i)-x4(i)
66 e12(i)= y2(i)+y3(i)-y1(i)-y4(i)
67 e13(i)= z2(i)+z3(i)-z1(i)-z4(i)
68 e21(i)= x3(i)+x4(i)-x1(i)-x2(i)
69 e22(i)= y3(i)+y4(i)-y1(i)-y2(i)
70 e23(i)= z3(i)+z4(i)-z1(i)-z2(i)
71 ENDDO
72 ELSEIF (ity == 7) THEN
73C--- shell 3N
74 DO i=1,nel
75 e11(i)= x2(i)-x1(i)
76 e12(i)= y2(i)-y1(i)
77 e13(i)= z2(i)-z1(i)
78 e21(i)= x3(i)-x1(i)
79 e22(i)= y3(i)-y1(i)
80 e23(i)= z3(i)-z1(i)
81 ENDDO
82 ENDIF
83C------ Initialise UVAR
84 g0 = uparam(13)
85 DO i=1,nel
86 aa = dir1(i,1)
87 bb = dir1(i,2)
88 v1 = aa*e11(i) + bb*e21(i)
89 v2 = aa*e12(i) + bb*e22(i)
90 v3 = aa*e13(i) + bb*e23(i)
91 wr = v1*e1x(i)+ v2*e1y(i) + v3*e1z(i)
92 ws = v1*e2x(i)+ v2*e2y(i) + v3*e2z(i)
93 suma = max( sqrt(wr*wr + ws*ws), em20)
94 r1 = wr/suma
95 s1 = ws/suma
96 aa = dir2(i,1)
97 bb = dir2(i,2)
98 v1 = aa*e11(i) + bb*e21(i)
99 v2 = aa*e12(i) + bb*e22(i)
100 v3 = aa*e13(i) + bb*e23(i)
101 wr = v1*e1x(i)+ v2*e1y(i) + v3*e1z(i)
102 ws = v1*e2x(i)+ v2*e2y(i) + v3*e2z(i)
103 suma = max( sqrt(wr*wr + ws*ws), em20)
104 r2 = wr/suma
105 s2 = ws/suma
106 tana = (r1*r2 + s1*s2) / (r1*s2 - r2*s1) ! Tan(alpha_totale)
107c
108 uvar(i,1:nuvar) = zero
109 uvar(i,6) = tana
110 tan_phi(i) = tana
111 uvar(i,10) = tana*g0
112 uvar(i,14) = aldt(i)
113 uvar(i,40) = one
114 ENDDO
115C----
116 RETURN
117 END
subroutine cm58in3(irep, dir1, dir2, uparam, uvar, aldt, nel, nuvar, tan_phi, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition cm58in3.F:35
#define max(a, b)
Definition macros.h:21
program starter
Definition starter.F:39