OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pcoori.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!|| pcoori ../starter/source/elements/beam/pcoori.F
25!||--- called by ------------------------------------------------------
26!|| inivoid ../starter/source/elements/initia/inivoid.F
27!|| pinit3 ../starter/source/elements/beam/pinit3.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE pcoori(X,NCP,
34 . MXT,MXG,NC1,NC2,NC3,DELTAX,
35 . X1,X2,X3, Y1,Y2,Y3, Z1,Z2,Z3,
36 . IBEAM_VECTOR,RBEAM_VECTOR,IVECT,VECT)
37C-----------------------------------------------
38 USE message_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER NCP(NIXP,*),NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ),
51 . MXT(MVSIZ), MXG(MVSIZ)
52 INTEGER , INTENT (IN) :: IBEAM_VECTOR(MVSIZ)
53 INTEGER , INTENT (OUT) :: IVECT(MVSIZ)
54 my_real X1(MVSIZ), X2(MVSIZ), X3(MVSIZ),
55 . y1(mvsiz), y2(mvsiz), y3(mvsiz),
56 . z1(mvsiz), z2(mvsiz), z3(mvsiz),x(3,*),deltax(mvsiz)
57 my_real , INTENT (IN) :: rbeam_vector(3,mvsiz)
58 my_real , INTENT (OUT) :: vect(3,mvsiz)
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "vect01_c.inc"
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I
67 my_real XP1, XP2, XP3, XNOR1, XP4, XP5, XP6,
68 . XNOR2, XNORM, DET1, DET2, DET3, DET, XX,YY,ZZ,TOL
69C=======================================================================
70C CONNECTIVITES ET MATERIEL |
71C--------------------------------------------------
72 tol=two*em06
73 DO i=lft,llt
74 mxt(i)=ncp(1,i)
75 nc1(i)=ncp(2,i)
76 nc2(i)=ncp(3,i)
77 nc3(i)=ncp(4,i)
78 mxg(i)=ncp(5,i)
79 ivect(i)=ibeam_vector(i)
80 vect(1:3,i)=rbeam_vector(1:3,i)
81 END DO
82C
83C----------------------------
84C COORDINATES |
85C----------------------------
86 DO i=lft,llt
87 x1(i)=x(1,nc1(i))
88 y1(i)=x(2,nc1(i))
89 z1(i)=x(3,nc1(i))
90 x2(i)=x(1,nc2(i))
91 y2(i)=x(2,nc2(i))
92 z2(i)=x(3,nc2(i))
93 x3(i)=x(1,nc3(i))
94 y3(i)=x(2,nc3(i))
95 z3(i)=x(3,nc3(i))
96 ENDDO
97c
98 DO i=lft,llt
99 xx = (x1(i)-x2(i))*(x1(i)-x2(i))
100 yy = (y1(i)-y2(i))*(y1(i)-y2(i))
101 zz = (z1(i)-z2(i))*(z1(i)-z2(i))
102 deltax(i) = sqrt(xx+yy+zz)
103 ENDDO
104C------------------------------
105C CONSISTENCY
106C------------------------------
107 DO i=lft,llt
108 xp1=x2(i)-x1(i)
109 xp2=y2(i)-y1(i)
110 xp3=z2(i)-z1(i)
111 xnor1=sqrt(xp1*xp1+xp2*xp2+xp3*xp3)
112 IF(xnor1<=em20) THEN
113 CALL ancmsg(msgid=222,
114 . msgtype=msgerror,
115 . anmode=aninfo,
116 . i1=ncp(6,i))
117 ENDIF
118C
119 IF (ivect(i)>0) THEN
120C DIRECTION DEFINED BY VECTOR : CHECK THAT VECTOR NOT COLINEAR WITH N1N2
121 xp4=vect(1,i)
122 xp5=vect(2,i)
123 xp6=vect(3,i)
124 det1=xp1*xp5-xp2*xp4
125 det2=xp2*xp6-xp3*xp5
126 det3=xp3*xp4-xp1*xp6
127 det= sqrt(det1**2+det2**2+det3**2)
128 IF (det<tol) THEN
129C IVECT swithed to -1 - Y or Z global axis will be used instead of the vector
130 ivect(i) = -1
131 CALL ancmsg(msgid=3090,
132 . msgtype=msgwarning,
133 . anmode=aninfo_blind_1,
134 . i1=ncp(6,i),
135 . prmod=msg_cumu)
136 ENDIF
137 ELSE
138C DIRECTION DEFINED WITH N3 : CHECK THAT N1N2 and N1N3 ARE NOT COLINEAR
139 IF (nc3(i)==nc2(i)) cycle
140 xp4=x3(i)-x1(i)
141 xp5=y3(i)-y1(i)
142 xp6=z3(i)-z1(i)
143 xnor2=sqrt(xp4*xp4+xp5*xp5+xp6*xp6)
144 IF(xnor2<em20) THEN
145 CALL ancmsg(msgid=223,
146 . msgtype=msgerror,
147 . anmode=aninfo_blind_1,
148 . i1=ncp(6,i))
149 ELSE
150 det1=xp1*xp5-xp2*xp4
151 det2=xp2*xp6-xp3*xp5
152 det3=xp3*xp4-xp1*xp6
153 det= sqrt(det1**2+det2**2+det3**2)
154 IF (det<tol) THEN
155 CALL ancmsg(msgid=3051,
156 . msgtype=msgwarning,
157 . anmode=aninfo_blind_1,
158 . i1=ncp(6,i),
159 . prmod=msg_cumu)
160 nc3(i)=nc2(i)
161 ENDIF
162 ENDIF
163 ENDIF
164 ENDDO
165 CALL ancmsg(msgid=3051,
166 . msgtype=msgwarning,
167 . anmode=aninfo_blind_1,
168 . prmod=msg_print)
169 CALL ancmsg(msgid=3090,
170 . msgtype=msgwarning,
171 . anmode=aninfo_blind_1,
172 . prmod=msg_print)
173c-----------
174 RETURN
175 END
message_mod
Definition message_mod.F:1249
pcoori
subroutine pcoori(x, ncp, mxt, mxg, nc1, nc2, nc3, deltax, x1, x2, x3, y1, y2, y3, z1, z2, z3, ibeam_vector, rbeam_vector, ivect, vect)
Definition pcoori.F:37
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