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