OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_mad.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/.
23C
24c SUBROUTINE W_RRIVET(IXRI,FRONT,PROC,NRIVET_L,RIVET,LEN_AM)
25C-----------------------------------------------
26C I m p l i c i t T y p e s
27C-----------------------------------------------
28c#include "implicit_f.inc"
29C-----------------------------------------------
30C D u m m y A r g u m e n t s
31C-----------------------------------------------
32c INTEGER PROC, NRIVET_L, LEN_AM,
33c . IXRI(4,*), FRONT(NUMNOD,*)
34c my_real
35c . RIVET(NRIVF,*)
36C-----------------------------------------------
37C L o c a l V a r i a b l e s
38C-----------------------------------------------
39c INTEGER N_L, N, N1, N2, J
40c my_real
41c . RIVET_L(NRIVF,NRIVET_L)
42C
43c N_L = 0
44c DO N = 1, NRIVET
45c N1=IXRI(2,N)
46c N2=IXRI(3,N)
47c IF(MOD(FRONT(N1,PROC+1),10)==1.AND.
48c + MOD(FRONT(N2,PROC+1),10)==1)THEN
49c N_L = N_L + 1
50c DO J = 1, NRIVF
51c RIVET_L(J,N_L) = RIVET(J,N)
52c END DO
53c ENDIF
54c ENDDO
55C
56c CALL WRITE_DB(RIVET_L,NRIVET_L*NRIVF)
57c LEN_AM = LEN_AM + NRIVET_L*NRIVF
58C
59c RETURN
60c END
61C
62!||====================================================================
63!|| w_mad ../starter/source/restart/ddsplit/w_mad.F
64!||--- called by ------------------------------------------------------
65!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
66!||--- calls -----------------------------------------------------
67!|| nlocal ../starter/source/spmd/node/ddtools.F
68!||====================================================================
69 SUBROUTINE w_mad(IEXMAD ,NMADSH4_L,NMADSH3_L,NMADSOL_L,NMADNOD_L,
70 + MADCL_NMADNOD_L,CEP,PROC,NODLOCAL ,CEL ,
71 + NUMELS_L,NUMELC_L ,NUMELTG_L,LEN_IA )
72C-----------------------------------------------
73C M o d u l e s
74C-----------------------------------------------
75
76C-----------------------------------------------
77C I m p l i c i t T y p e s
78C-----------------------------------------------
79#include "implicit_f.inc"
80C-----------------------------------------------
81C C o m m o n B l o c k s
82C-----------------------------------------------
83#include "com04_c.inc"
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87 INTEGER PROC, NMADSH4_L, NMADSH3_L, NMADSOL_L, NMADNOD_L,
88 . LEN_IA, NUMELS_L, NUMELC_L, NUMELTG_L,MADCL_NMADNOD_L,
89 . iexmad(*), cep(*), nodlocal(*),cel(*)
90C-----------------------------------------------
91C F u n c t i o n
92C-----------------------------------------------
93 INTEGER NLOCAL
94 EXTERNAL NLOCAL
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 INTEGER I, IDEB, K, ESHIFT, NMAD_L, P
99 INTEGER, DIMENSION(:),ALLOCATABLE :: MADCL_TMPNOD,TMPSH3,TMPSH4,TMPSOL,
100 . tmpnod,failsh4,failsh3,failsol,iconx_l
101C-----------------------------------------------
102! allocate 1d arrays
103 ALLOCATE(madcl_tmpnod(madcl_nmadnod_l))
104 ALLOCATE( tmpsh3(nmadsh3_l),tmpsh4(nmadsh4_l) )
105 ALLOCATE( tmpsol(nmadsol_l),tmpnod(nmadnod_l) )
106 ALLOCATE( iconx_l(7*nconx) )
107! -------------------------------
108C
109C Couplage etendu
110C
111 IF(nexmad/=0) THEN
112C
113C ELEM shell4
114C
115 ideb = 1 + 7*nconx + nmadprt
116 eshift = numels+numelq
117 nmad_l = 0
118 DO i = 1, nmadsh4
119 k = iexmad(ideb+i-1)
120 IF(cep(k+eshift)==proc) THEN
121 nmad_l = nmad_l+1
122 tmpsh4(nmad_l) = cel(k+eshift)
123 END IF
124 END DO
125C
126C Elem shell3
127C
128 ideb = ideb + nmadsh4
129 eshift = numels+numelq+numelc+numelt+numelp+numelr
130 nmad_l = 0
131 DO i = 1, nmadsh3
132 k = iexmad(ideb+i-1)
133 IF(cep(k+eshift)==proc) THEN
134 nmad_l = nmad_l+1
135 tmpsh3(nmad_l) = cel(k+eshift)
136 END IF
137 END DO
138C
139C Elem solides
140C
141 ideb = ideb + nmadsh3
142 eshift = 0
143 nmad_l = 0
144 DO i = 1, nmadsol
145 k = iexmad(ideb+i-1)
146 IF(cep(k+eshift)==proc) THEN
147 nmad_l = nmad_l+1
148 tmpsol(nmad_l) = cel(k+eshift)
149 END IF
150 END DO
151C
152C Noeuds
153C
154 ideb = ideb + nmadsol
155 nmad_l = 0
156 DO i = 1, nmadnod
157 k = iexmad(ideb+i-1)
158 IF(nlocal(k,proc+1)==1) THEN
159 DO p = 1, proc
160 IF(nlocal(k,p)==1) GOTO 100
161 END DO
162 nmad_l = nmad_l+1
163 tmpnod(nmad_l) = nodlocal(k)
164 END IF
165 100 CONTINUE
166 END DO
167C
168C Noeuds MADCL
169C
170 nmad_l = 0
171 DO i = 1, nmadnod
172 k = iexmad(ideb+i-1)
173 IF(nlocal(k,proc+1)==1) THEN
174 nmad_l = nmad_l+1
175 madcl_tmpnod(nmad_l) = nodlocal(k)
176 END IF
177 END DO
178C
179 END IF
180C
181 IF(proc==0) THEN
182 DO i=1,7*nconx
183 iconx_l(i) = iexmad(i)
184 END DO
185 DO i=1,nconx
186 iconx_l(7*(i-1)+4) = nodlocal(iexmad(7*(i-1)+4))
187 END DO
188 CALL write_i_c(iconx_l,7*nconx)
189 len_ia = len_ia + 7*nconx
190 END IF
191 IF(nexmad/=0) THEN
192 IF(proc==0) THEN
193 CALL write_i_c(iexmad(7*nconx+1),nmadprt)
194 len_ia = len_ia + nmadprt
195 END IF
196 CALL write_i_c(tmpsh4,nmadsh4_l)
197 len_ia = len_ia + nmadsh4_l
198 CALL write_i_c(tmpsh3,nmadsh3_l)
199 len_ia = len_ia + nmadsh3_l
200 CALL write_i_c(tmpsol,nmadsol_l)
201 len_ia = len_ia + nmadsol_l
202 CALL write_i_c(tmpnod,nmadnod_l)
203 len_ia = len_ia + nmadnod_l
204 CALL write_i_c(madcl_tmpnod,madcl_nmadnod_l)
205 len_ia = len_ia + madcl_nmadnod_l
206 IF(proc==0)THEN
207 ideb = 7*nconx+nmadprt+nmadsh4+nmadsh3+nmadsol+nmadnod
208 + + numelc+numeltg+numels + 1
209 CALL write_i_c(iexmad(ideb),2*nmadnod+nmadsh4+nmadsh3+nmadsol)
210 len_ia = len_ia + 2*nmadnod+nmadsh4+nmadsh3+nmadsol
211 END IF
212 END IF
213C
214! -------------------------------
215! deallocate 1d arrays
216 DEALLOCATE(madcl_tmpnod)
217 DEALLOCATE( tmpsh3,tmpsh4 )
218 DEALLOCATE( tmpsol,tmpnod )
219 DEALLOCATE( iconx_l )
220! -------------------------------
221 RETURN
222 END
w_mad
subroutine w_mad(iexmad, nmadsh4_l, nmadsh3_l, nmadsol_l, nmadnod_l, madcl_nmadnod_l, cep, proc, nodlocal, cel, numels_l, numelc_l, numeltg_l, len_ia)
Definition w_mad.F:72
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645