OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
thnod_count.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!|| thnod_count ../engine/source/output/th/thnod_count.F
25!||--- called by ------------------------------------------------------
26!|| init_th ../engine/source/output/th/init_th.F
27!||--- uses -----------------------------------------------------
28!|| plyxfem_mod ../engine/share/modules/plyxfem_mod.F
29!||====================================================================
30 SUBROUTINE thnod_count(ITHGRP, NTHGRP2, WA_SIZE, INDEX_WA_NOD, ITHBUF, WEIGHT,SITHBUF)
31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34 USE plyxfem_mod
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 "com01_c.inc"
43#include "com04_c.inc"
44#include "param_c.inc"
45#include "submodel.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER,INTENT(IN) :: SITHBUF
50 INTEGER ITHBUF(*),WEIGHT(NUMNOD)
51 INTEGER, INTENT(inout) :: WA_SIZE,NTHGRP2
52 INTEGER, DIMENSION(2*NTHGRP2+1), INTENT(inout) :: INDEX_WA_NOD
53 INTEGER, DIMENSION(NITHGR,*), INTENT(in) :: ITHGRP
54
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 LOGICAL :: BOOL,CONDITION
59 INTEGER :: N, I, J, ISK, II, IUN
60 INTEGER :: NN, IAD, IADV, NVAR, ITYP, J_FIRST
61 INTEGER, DIMENSION(NTHGRP2) :: INDEX_NOD
62 DATA iun/1/
63C-------------------------
64C NODES
65C DEPLACEMENT, VELOCITY, ACCELERATION,
66C VELOCITY ANGULAIRE, ACCELERATION ANGULAIRE,
67C & POSITION
68C-------------------------
69 wa_size = 0
70 index_nod(1:nthgrp2) = 0
71
72 DO n=1,nthgrp2
73 ityp=ithgrp(2,n)
74 nn =ithgrp(4,n)
75 iad =ithgrp(5,n)
76 nvar=ithgrp(6,n)
77 iadv=ithgrp(7,n)
78 IF(ityp==0)THEN
79 IF(iroddl/=0)THEN
80 ii=0
81 DO j=iad,iad+nn-1
82 i=ithbuf(j)
83 isk = 1 + ithbuf(j+nn)
84 condition = (i <= 0)
85 IF(.NOT. condition) condition = (weight(i) == 0)
86 IF (condition) THEN
87 ! not for me!
88 ELSEIF(isk==1)THEN
89C---------
90C output with respect to the global SKEW.
91 wa_size = wa_size + nvar + 1
92 ELSEIF(isk<=numskw+1+nsubmod)THEN
93! output with respect to a (non global) SKEW.
94 wa_size = wa_size + nvar + 1
95 ELSE ! ISK==
96C---------
97C output with respect to a REFERENCE FRAME.
98 wa_size = wa_size + nvar + 1
99 ENDIF ! ISK==
100 ENDDO ! J=IAD,IAD+NN-1
101 ELSE ! IRODDL/=0
102C
103 ii=0
104 DO j=iad,iad+nn-1
105 i=ithbuf(j)
106 isk = 1 + ithbuf(j+nn)
107 condition = (i <= 0)
108 IF(.NOT. condition) condition = (weight(i) == 0)
109 IF (condition) THEN
110 ! not for me!
111 ELSEIF(isk==1)THEN
112C output with respect to the global SKEW.
113 wa_size = wa_size + nvar + 1
114 ELSEIF(isk<=numskw+1+nsubmod)THEN
115C---------
116C output with respect to a (non global) SKEW.
117 wa_size = wa_size + nvar + 1
118 ELSE
119C---------
120C output with respect to a REFERENCE FRAME.
121 wa_size = wa_size + nvar + 1
122 ENDIF
123 ENDDO
124 ENDIF
125 index_nod(n) = wa_size
126 ENDIF
127 ENDDO
128
129 j_first = 0
130 bool = .true.
131 DO i=1,nthgrp2
132 IF(bool.EQV..true.) THEN
133 IF( index_nod(i)/=0 ) THEN
134 bool = .false.
135 j_first = i
136 ENDIF
137 ENDIF
138 ENDDO
139
140 j = 0
141 IF(j_first>0) THEN
142 j=j+1
143 index_wa_nod(j) = index_nod(j_first)
144 j=j+1
145 index_wa_nod(j) = j_first
146 DO i=j_first+1,nthgrp2
147 IF( index_nod(i)-index_nod(i-1)>0 ) THEN
148 j=j+1
149 index_wa_nod(j) = index_nod(i)
150 j=j+1
151 index_wa_nod(j) = i
152 ENDIF
153 ENDDO
154 ENDIF
155 index_wa_nod(2*nthgrp2+1) = j ! number of non-zero index
156C-----------
157
158
159 RETURN
160 END SUBROUTINE thnod_count
plyxfem_mod
Definition plyxfem_mod.F:31
thnod_count
subroutine thnod_count(ithgrp, nthgrp2, wa_size, index_wa_nod, ithbuf, weight, sithbuf)
Definition thnod_count.F:31