OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_rwar.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
24!||====================================================================
25!|| w_rwar ../starter/source/restart/ddsplit/w_rwar.F
26!||--- called by ------------------------------------------------------
27!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
28!||--- calls -----------------------------------------------------
29!|| nlocal ../starter/source/spmd/node/ddtools.F
30!||====================================================================
31 SUBROUTINE w_rwar(NPRW ,LPRW ,RWL, RWSAV,
32 + LWSAV_L ,LRW_PEN_L,NRW_PEN_L,RWSTIF_PEN,
33 + SLN_PEN , CEP ,PROC,LEN_AM)
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com04_c.inc"
46#include "param_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER PROC, LEN_AM, LWSAV_L, LPRW(*), NPRW(*),
51 . CEP(*)
52 INTEGER, INTENT(IN ) :: LRW_PEN_L, NRW_PEN_L, SLN_PEN
53 my_real
54 . rwl(nrwlp,*), rwsav(*)
55 my_real, DIMENSION(SLN_PEN), INTENT(IN ) :: rwstif_pen
56C-----------------------------------------------
57C F u n c t i o n
58C-----------------------------------------------
59 INTEGER NLOCAL
60 EXTERNAL NLOCAL
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER J, K, KK, N, NN, IE, NE, IFQ, N4,
65 . ILP, NSL, NSL_L, KSAV, KSAV_L,N_P,IPEN,LSPEN
66 my_real , DIMENSION(:),ALLOCATABLE :: rwsav_l
67 my_real , DIMENSION(:,:),ALLOCATABLE :: rwl_l
68 my_real , DIMENSION(:),ALLOCATABLE :: rwpen1_l,rw_pen_l
69C
70 IF(nrwall>0) THEN
71 ALLOCATE(rwl_l(nrwlp,nrwall))
72 IF(lwsav_l>0) ALLOCATE(rwsav_l(3*lwsav_l))
73 IF(lrw_pen_l>0) THEN
74 ALLOCATE(rwpen1_l(nrw_pen_l))
75 ALLOCATE(rw_pen_l(4*lrw_pen_l))
76 ENDIF
77 k = 0
78 ksav = 0
79 ksav_l = 0
80 DO n = 1, nrwall
81 DO j = 1, nrwlp
82 rwl_l(j,n) = rwl(j,n)
83 ENDDO
84C
85 nsl = nprw(n)
86C
87 ifq = nint(rwl(15,n))
88 IF(ifq>0) THEN
89 nsl_l = 0
90 DO kk = 1, nsl
91 nn = lprw(k+kk)
92 IF(nlocal(nn,proc+1)==1)THEN
93 rwsav_l(ksav_l+3*nsl_l+1) = rwsav(ksav+3*(kk-1)+1)
94 rwsav_l(ksav_l+3*nsl_l+2) = rwsav(ksav+3*(kk-1)+2)
95 rwsav_l(ksav_l+3*nsl_l+3) = rwsav(ksav+3*(kk-1)+3)
96 nsl_l = nsl_l + 1
97 ENDIF
98 ENDDO
99 ksav = ksav + 3*nsl
100 ksav_l = ksav_l + 3*nsl_l
101 ENDIF
102C
103 k = k + nsl
104C
105 n4 = n + 3*nrwall
106 IF(nprw(n4)==-1) THEN
107C RW ALE TH
108 ne = nint(rwl(8,n))
109 IF(ne>0)THEN
110 ilp = 0
111 DO j = 1, ne
112 ie = lprw(k+j)/10
113 IF(cep(ie)==proc) THEN
114 ilp = ilp + 1
115 ENDIF
116 ENDDO
117 rwl_l(8,n) = ilp
118 k = k + ne
119 ENDIF
120 ENDIF
121 ENDDO
122C
123 CALL write_db(rwl_l,nrwlp*nrwall)
124 len_am = len_am + nrwlp*nrwall
125 DEALLOCATE(rwl_l)
126 IF(lwsav_l>0) THEN
127 CALL write_db(rwsav_l,lwsav_l*3)
128 len_am = len_am + lwsav_l*3
129 DEALLOCATE(rwsav_l)
130 ENDIF
131 IF(lrw_pen_l>0) THEN
132 rw_pen_l = zero
133 n_p = 0
134 nsl_l = 0
135 k = 0
136 DO n = 1, nrwall
137 nsl = nprw(n)
138 ipen = nprw(n+8*nrwall)
139 IF (ipen>0) THEN
140 DO j = 1, nsl
141 nn = lprw(k+j)
142 IF(nlocal(nn,proc+1)==1)THEN
143 nsl_l = nsl_l + 1
144 rw_pen_l(nsl_l) = rwstif_pen(n_p+j)
145 ENDIF
146 END DO
147 n_p = n_p + nsl
148 END IF
149 k = k + nsl
150 END DO
151 lspen = n_p
152 rwpen1_l = zero
153 n_p = 0
154 k = 0
155 DO n = 1, nrwall
156 nsl = nprw(n)
157 ipen = nprw(n+8*nrwall)
158 IF (ipen>0) THEN
159 nsl_l = 0
160 DO j = 1, nsl
161 nn = lprw(k+j)
162 IF(nlocal(nn,proc+1)==1) nsl_l = nsl_l + 1
163 END DO
164 IF (nsl_l>0) THEN
165 n_p = n_p + 1
166 rwpen1_l(n_p) = rwstif_pen(n_p+lspen)
167 END IF
168 END IF
169 k = k + nsl
170 END DO
171 CALL write_db(rwpen1_l,nrw_pen_l)
172 CALL write_db(rw_pen_l,lrw_pen_l*4)
173 len_am = len_am + nrw_pen_l + lrw_pen_l*4
174 DEALLOCATE(rw_pen_l)
175 DEALLOCATE(rwpen1_l)
176 END IF
177 ENDIF
178C
179 RETURN
180 END
w_rwar
subroutine w_rwar(nprw, lprw, rwl, rwsav, lwsav_l, lrw_pen_l, nrw_pen_l, rwstif_pen, sln_pen, cep, proc, len_am)
Definition w_rwar.F:34
write_db
subroutine write_db(a, n)
Definition write_db.F:142