OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dsdim.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!|| dsdim0 ../starter/source/implicit/dsolve/dsdim.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE dsdim0(NDOF ,IXS , IXQ , IXC , IXT ,
30 2 IXP ,IXR , IXTG , KXX ,
31 3 IXX ,GEO )
32 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg,nixtg
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "com04_c.inc"
41#include "param_c.inc"
42#include "scr23_c.inc"
43#include "sms_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER NDOF(*), IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*),
48 . IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*),
49 . ixtg(nixtg,*), kxx(nixx,*), ixx(*)
50 my_real
51 . geo(npropg,*)
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I, IEL, J, N, IGTYP, NN
56 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG8
57
58 ALLOCATE(tag8(numnod))
59C
60C Filling of ndof (see dim_glob_k in engine)
61C
62 DO i=1,numnod
63 ndof(i)=0
64 ENDDO
65C
66 IF(isms==0)THEN
67C---- IMPLICIT
68 DO iel=1,numels
69 DO j=1,8
70 n=ixs(j+1,iel)
71 IF(n/=0)ndof(n)=3
72 ENDDO
73 ENDDO
74 DO iel=1,numelt
75 DO j=1,2
76 n=ixt(j+1,iel)
77 IF(n/=0)ndof(n)=3
78 ENDDO
79 ENDDO
80 DO iel=1,numelc
81 DO j=1,4
82 n=ixc(j+1,iel)
83 IF(n/=0)ndof(n)=6
84 ENDDO
85 ENDDO
86 DO iel=1,numeltg
87 DO j=1,3
88 n=ixtg(j+1,iel)
89 IF(n/=0)ndof(n)=6
90 ENDDO
91 ENDDO
92 DO iel=1,numelp
93 DO j=1,2
94 n=ixp(j+1,iel)
95 IF(n/=0)ndof(n)=6
96 ENDDO
97 ENDDO
98 DO iel=1,numelr
99 igtyp= nint(geo(12,ixr(1,iel)))
100 IF (igtyp==8.OR.igtyp==13 .OR. igtyp == 23) THEN
101 DO j=1,2
102 n=ixr(j+1,iel)
103 IF(n/=0)ndof(n)=6
104 ENDDO
105 ELSEIF (igtyp==4) THEN
106 DO j=1,2
107 n=ixr(j+1,iel)
108 IF(n/=0)ndof(n)=max(ndof(n),3)
109 ENDDO
110 ENDIF
111 ENDDO
112C
113C DO I=1,NRBYKIN
114C N=NPBY(1,I)
115C IF(N/=0)NDOF(N)=6
116C ENDDO
117C
118 ELSE
119C---- AMS
120 DO iel=1,numels
121 DO j=1,8
122 n = ixs(j+1,iel)
123 IF(n/=0)tag8(n)=0
124 ENDDO
125 nn=0
126 DO j=1,8
127 n = ixs(j+1,iel)
128 IF(n/=0)THEN
129 IF(tag8(n)==0)THEN
130 nn=nn+1
131 tag8(n)=1
132 END IF
133 END IF
134 ENDDO
135 DO j=1,8
136 n = ixs(j+1,iel)
137 IF(n/=0)tag8(n)=0
138 ENDDO
139 DO j=1,8
140 n = ixs(j+1,iel)
141 IF(n/=0)THEN
142 IF(tag8(n)==0)THEN
143 ndof(n)=nn-1
144 tag8(n)=1
145 END IF
146 END IF
147 ENDDO
148 ENDDO
149 DO iel=1,numelt
150 DO j=1,2
151 n=ixt(j+1,iel)
152 IF(n/=0)ndof(n)=1
153 ENDDO
154 ENDDO
155 DO iel=1,numelc
156 DO j=1,4
157 n=ixc(j+1,iel)
158 IF(n/=0)ndof(n)=3
159 ENDDO
160 ENDDO
161 DO iel=1,numeltg
162 DO j=1,3
163 n=ixtg(j+1,iel)
164 IF(n/=0)ndof(n)=2
165 ENDDO
166 ENDDO
167 DO iel=1,numelp
168 DO j=1,2
169 n=ixp(j+1,iel)
170 IF(n/=0)ndof(n)=1
171 ENDDO
172 ENDDO
173 DO iel=1,numelr
174 igtyp= nint(geo(12,ixr(1,iel)))
175 IF (igtyp==8.OR.igtyp==13 .OR. igtyp == 23) THEN
176 DO j=1,2
177 n=ixr(j+1,iel)
178 IF(n/=0)ndof(n)=1
179 ENDDO
180 ELSEIF (igtyp==4) THEN
181 DO j=1,2
182 n=ixr(j+1,iel)
183 IF(n/=0)ndof(n)=1
184 ENDDO
185 ENDIF
186 ENDDO
187 END IF
188 DEALLOCATE(tag8)
189 RETURN
190 END
191
my_real
#define my_real
Definition cppsort.cpp:32
dsdim0
subroutine dsdim0(ndof, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, kxx, ixx, geo)
Definition dsdim.F:32
max
#define max(a, b)
Definition macros.h:21