OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i12s2m.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!|| i12s2m ../engine/source/interfaces/interf/i12s2m.F
25!||--- called by ------------------------------------------------------
26!|| intti12a ../engine/source/interfaces/interf/intti12.F
27!||--- uses -----------------------------------------------------
28!|| ale_mod ../common_source/modules/ale/ale_mod.F
29!|| segvar_mod ../engine/share/modules/segvar_mod.F
30!||====================================================================
31 SUBROUTINE i12s2m(NSN,IRTL,NRTM,JCODV,NODVARS,MCOUNT,
32 + NMN,NODVARM,IRECTM,NCOUNT,MSR,
33 + SEGVAR,ISEGM,NOINT)
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE segvar_mod
38 USE ale_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER NSN, NRTM,IRTL(*),JCODV(*),ISEGM(*),IRECTM(4,*),NMN,MSR(*),NOINT
47 my_real MCOUNT(*),NODVARS(*),NODVARM(*),NCOUNT(*)
48 TYPE(t_segvar),TARGET :: SEGVAR
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER NIR, I, J, II, L, JJ,KVAR,SEGAD,ADS,ADM,PB,TEST
57 my_real,DIMENSION(:),POINTER :: ptr
58C-----------------------------------------------
59 test=0
60 nir=2
61 IF(n2d==0)nir=4
62
63 DO kvar=1,ale%GLOBAL%NVCONV
64
65 SELECT CASE(kvar)
66 CASE(1)
67 ptr(1:) => segvar%RHO(1:)
68 CASE(2)
69 ptr(1:) => segvar%EINT(1:)
70 CASE(3)
71 ptr(1:) => segvar%RK(1:)
72 CASE(4)
73 ptr(1:) => segvar%RE(1:)
74 CASE(5)
75 ptr(1:) => segvar%UVAR(1:)
76 END SELECT
77
78 DO i=1,nrtm
79 ptr(isegm(i))=zero
80 ENDDO
81
82 ENDDO
83
84 DO i=1,nrtm
85 mcount(i)=zero
86 ENDDO
87
88 DO ii=1,nsn
89 l=irtl(ii)
90 mcount(l)=mcount(l)+one
91 ENDDO
92
93 DO kvar=1,ale%GLOBAL%NVCONV
94
95 SELECT CASE(kvar)
96 CASE(1)
97 ptr(1:) => segvar%RHO(1:)
98 CASE(2)
99 ptr(1:) => segvar%EINT(1:)
100 CASE(3)
101 ptr(1:) => segvar%RK(1:)
102 CASE(4)
103 ptr(1:) => segvar%RE(1:)
104 CASE(5)
105 ptr(1:) => segvar%UVAR(1:)
106 END SELECT
107
108 DO ii=1,nsn
109 l=irtl(ii)
110 ads=ale%GLOBAL%NVCONV*(ii-1)+kvar
111 ptr(isegm(l))=ptr(isegm(l))+nodvars(ads)
112 ENDDO
113
114 ENDDO
115
116 !CALCUL PARTICULIER SI IL EXISTE ONE SEGMENT SANS NOEUD SECOND. DETECTE
117 pb=0
118 DO i=1,nrtm
119 IF(mcount(i)==zero)pb=1
120 ENDDO
121 IF(pb==1)THEN
122 DO i=1,nmn
123
124 ncount(i)=zero
125 ENDDO
126 DO ii=1,nsn
127 l=irtl(ii)
128 DO jj=1,nir
129 ncount(irectm(jj,l))= ncount(irectm(jj,l))+1
130 ENDDO
131 ENDDO
132 DO kvar=1,ale%GLOBAL%NVCONV
133 DO i=1,nmn
134 adm=ale%GLOBAL%NVCONV*(i-1)+kvar
135 nodvarm(adm)=zero
136 ENDDO
137 DO ii=1,nsn
138 l=irtl(ii)
139 ads=ale%GLOBAL%NVCONV*(ii-1)+kvar
140 DO jj=1,nir
141 adm=ale%GLOBAL%NVCONV*(irectm(jj,l)-1)+kvar
142 nodvarm(adm)=nodvarm(adm)+nodvars(ads)
143 ENDDO
144 ENDDO
145 ENDDO
146 DO kvar=1,ale%GLOBAL%NVCONV
147 DO i=1,nmn
148 adm=ale%GLOBAL%NVCONV*(i-1)+kvar
149 IF(ncount(i)>zero)THEN
150 nodvarm(adm)=nodvarm(adm)/ncount(i)
151 ENDIF
152 ENDDO
153 ENDDO
154 ENDIF
155
156 DO kvar=1,ale%GLOBAL%NVCONV
157
158 SELECT CASE(kvar)
159 CASE(1)
160 ptr(1:) => segvar%RHO(1:)
161 CASE(2)
162 ptr(1:) => segvar%EINT(1:)
163 CASE(3)
164 ptr(1:) => segvar%RK(1:)
165 CASE(4)
166 ptr(1:) => segvar%RE(1:)
167 CASE(5)
168 ptr(1:) => segvar%UVAR(1:)
169 END SELECT
170
171 DO i=1,nrtm
172 segad=ale%GLOBAL%NVCONV*(isegm(i)-1)+kvar
173 IF(mcount(i)>zero)THEN
174 ptr(isegm(i))=ptr(isegm(i))/mcount(i)
175 ELSE
176 ptr(isegm(i))=zero
177 l=0
178 DO jj=1,nir
179 ii=irectm(jj,i)
180 adm=ale%GLOBAL%NVCONV*(ii-1)+kvar
181 IF(ncount(ii)>zero)THEN
182 ptr(isegm(i))=ptr(isegm(i))+nodvarm(adm)
183 l=l+1
184 ENDIF
185 ENDDO
186 IF(l>0)THEN
187 ptr(isegm(i))=ptr(isegm(i))/float(l)
188 ELSE
189
190 test=test+1
191 ! WRITE(IOUT,'(A,I8,A,I8,A)')
192 !+ '*** WARNING INTERF #',NOINT,'MAIN SEGMENT #',I,
193 !+ ' WITHOUT SECONDARY NODE'
194 ENDIF
195 ENDIF
196
197 ENDDO
198 ENDDO
199 ! IF(TEST >0)WRITE(ISTDO,'(A,I8,I8,A)')
200 !+ '*** WARNING INTERF #',NOINT,
201 !+ TEST,' MAIN SEGMENTS WITHOUT SECONDARY NODE'
202
203 RETURN
204 END
205
i12s2m
subroutine i12s2m(nsn, irtl, nrtm, jcodv, nodvars, mcount, nmn, nodvarm, irectm, ncount, msr, segvar, isegm, noint)
Definition i12s2m.F:34
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
segvar_mod
Definition segvar_mod.F:61
segvar_mod::t_segvar
Definition segvar_mod.F:69