OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
write_nloc_struct.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine write_nloc_struct (nloc_dmg, numnod_l, nodglob, nodloc, cel, cep, proc, ixs, ixc, ixtg, numels_l, numelc_l, numeltg_l)

Function/Subroutine Documentation

◆ write_nloc_struct()

subroutine write_nloc_struct ( type (nlocal_str_) nloc_dmg,
integer, intent(in) numnod_l,
integer, dimension(numnod_l), intent(in) nodglob,
integer, dimension(numnod), intent(in) nodloc,
integer, dimension(*), intent(in) cel,
integer, dimension(*), intent(in) cep,
integer, intent(in) proc,
integer, dimension(nixs,*), intent(in) ixs,
integer, dimension(nixc,*), intent(in) ixc,
integer, dimension(nixtg,*), intent(in) ixtg,
integer, intent(in) numels_l,
integer, intent(in) numelc_l,
integer, intent(in) numeltg_l )

Definition at line 31 of file write_nloc_struct.F.

35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE nlocal_reg_mod
39 USE my_alloc_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44#include "com01_c.inc"
45#include "com04_c.inc"
46#include "r2r_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER , INTENT(IN) :: NUMNOD_L, CEL(*), CEP(*),
51 . IXS(NIXS,*),PROC,IXC(NIXC,*),
52 . IXTG(NIXTG,*),NUMELS_L,NUMELC_L,
53 . NUMELTG_L
54 INTEGER , DIMENSION(NUMNOD_L) , INTENT(IN) :: NODGLOB
55 INTEGER , DIMENSION(NUMNOD) , INTENT(IN) :: NODLOC
56 TYPE (NLOCAL_STR_) :: NLOC_DMG
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I,ILOC,NNOD,NNOD_L,NG,NL,NN, LNLOC_L,ND,NP,NM,N1,
61 . N2,NNO,CC,CC_L,NUMG,NUML,PROC_L,K,SHFT,TESTVAL,
62 . L_NLOC,NDDMAX_L,OFF,LENBIS,LCNENL_L,MATSIZE
63 INTEGER, DIMENSION(:),ALLOCATABLE :: INDX_L, NDDL, IDXI_L
64 INTEGER, DIMENSION(:),ALLOCATABLE :: POSI
65 my_real, DIMENSION(NLOC_DMG%L_NLOC) :: mass,unl,mass0
66 my_real, DIMENSION(:), ALLOCATABLE :: zero_vec
67 INTEGER, DIMENSION(8) :: HEAD
68 INTEGER, DIMENSION(:), ALLOCATABLE :: ADDCNE_L,SOLTAG,SHTAG,TGTAG,
69 . PROCNE_L
70 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IADS,IADC,IADTG
71C=======================================================================
72 CALL my_alloc(indx_l,numnod_l)
73 CALL my_alloc(nddl,numnod_l)
74 CALL my_alloc(idxi_l,numnod_l)
75 CALL my_alloc(posi,numnod_l+1)
76
77 ! Flag for non-local computation
78 lcnenl_l = 0
79 iloc = nloc_dmg%IMOD
80c
81 ! Flag = 0, no non-local computation
82 IF (iloc == 0) THEN
83 head(1:8) = 0
84 CALL write_i_c(head,8)
85c
86 ! Else, non-local computation
87 ELSE
88c
89 ! Non-local global variables
90 nnod = nloc_dmg%NNOD
91 l_nloc = nloc_dmg%L_NLOC
92c
93 nnod_l = 0 ! Initialization of the number of non-local nodes (local)
94 lnloc_l = 0 ! Local length of non-local vectors
95c
96 indx_l(1:numnod_l) = 0
97 idxi_l(1:numnod_l) = 0
98 nddl(1:numnod_l) = 0
99 posi(1:numnod_l+1) = 0
100 mass(1:nloc_dmg%L_NLOC) = zero
101 mass0(1:nloc_dmg%L_NLOC) = zero
102 unl(1:nloc_dmg%L_NLOC) = zero
103c
104 ! Loop over local number of nodes
105 DO nl = 1,numnod_l
106 ng = nodglob(nl) ! Corresponding global node
107 nn = nloc_dmg%IDXI(ng) ! Corresponding number of the non-local node
108 IF (nn > 0) THEN ! If the node is non-local
109 np = nloc_dmg%POSI(nn) ! Position of the first d.o.f of the node
110 nd = nloc_dmg%POSI(nn+1) - np ! Number of additional d.o.fs
111 nnod_l = nnod_l + 1 ! Counter of local non-local nodes
112 indx_l(nnod_l) = nl ! Local table INDX
113 idxi_l(nl) = nnod_l ! Local table INDXI
114 nddl(nnod_l) = nd ! Local table NDDL
115 posi(nnod_l) = lnloc_l + 1 ! Local table POSI
116 mass(lnloc_l+1:lnloc_l+nd) = nloc_dmg%MASS(np:np+nd-1) ! Local table MASS
117 mass0(lnloc_l+1:lnloc_l+nd) = nloc_dmg%MASS0(np:np+nd-1) ! Local table initial MASS0
118 unl(lnloc_l+1:lnloc_l+nd) = nloc_dmg%UNL(np:np+nd-1) ! Local table UNL
119 lnloc_l = lnloc_l + nd ! Local size of the non-locals vectors (UNL,VNL,FNL...)
120 ENDIF
121 ENDDO
122 posi(nnod_l + 1) = lnloc_l + 1
123c
124 nddmax_l = maxval(nddl(1:nnod_l))
125c
126 ! PARITH/ON
127 IF (ipari0 == 1) THEN
128c
129 ! Length of the PROCNE_L table
130 lcnenl_l = 0
131 DO i = 1, nnod_l
132 nl = indx_l(i) ! Number of the local node in the domain (all node NUMNOD_L)
133 ng = nodglob(nl) ! Number of the corresponding global node
134 nn = nloc_dmg%IDXI(ng) ! Number of the corresponding non-local nodes
135 n1 = nloc_dmg%ADDCNE(nn) ! Number of the position in the FSKY vector
136 n2 = nloc_dmg%ADDCNE(nn+1) ! Number of the following position in the FSKY vector
137 lcnenl_l = lcnenl_l + n2-n1
138 ENDDO
139c
140 ! Allocation of the local ADDCNE_L table
141 ALLOCATE(addcne_l(nnod_l + 1))
142 addcne_l(1:nnod_l + 1) = 0
143 ALLOCATE(procne_l(lcnenl_l))
144 procne_l(1:lcnenl_l) = 0
145 ALLOCATE(iads(8,numels_l))
146 iads(1:8,1:numels_l) = 0
147 ALLOCATE(iadc(4,numelc_l))
148 iadc(1:4,1:numelc_l) = 0
149 ALLOCATE(iadtg(3,numeltg_l))
150 iadtg(1:3,1:numeltg_l) = 0
151 ALLOCATE(soltag(numels))
152 soltag(1:numels) = 0
153 ALLOCATE(shtag(numelc))
154 shtag(1:numelc) = 0
155 ALLOCATE(tgtag(numeltg))
156 tgtag(1:numeltg) = 0
157c
158 ! Filling the ADDCNE_L table
159 addcne_l(1) = 1
160 cc_l = 0 ! Counter of local element
161c
162 ! Loop over non-local local nodes
163 DO i = 1, nnod_l
164 nl = indx_l(i) ! Number of the local node in the domain (all node NUMNOD_L)
165 ng = nodglob(nl) ! Number of the corresponding global node
166 nn = nloc_dmg%IDXI(ng) ! Number of the corresponding non-local nodes
167 n1 = nloc_dmg%ADDCNE(nn) ! Number of the position in the FSKY vector
168 n2 = nloc_dmg%ADDCNE(nn+1) ! Number of the following position in the FSKY vector
169 addcne_l(i+1) = addcne_l(i) + n2-n1 ! Filling the corresponding case of ADDCNE_L
170 DO cc = n1,n2-1 ! Loop over attached element
171 numg = nloc_dmg%CNE(cc) ! Corresponding global number of the element
172 numl = cel(numg) ! Local number of the element
173 proc_l = cep(numg)+1 ! Processor of the element
174 cc_l = cc_l + 1 ! Local element counter
175 procne_l(cc_l) = proc_l ! Processor on which the element is located
176 IF (proc==proc_l) THEN ! If the current proc equals the processor of the element, filling the IADX table
177 IF (numg<=numels) THEN ! If the element is solid
178 DO k = 1,8 ! Loop over the nodes of the brick
179 shft = ishft(1,k-1) ! Shift
180 testval = iand(soltag(numg),shft) ! Testval
181 IF (ixs(k+1,numg)==ng.AND.testval==0) THEN ! Filling IADS
182 iads(k,numl) = cc_l
183 soltag(numg) = soltag(numg)+shft
184 ENDIF
185 ENDDO
186 ELSEIF (numg<=numels+numelq) THEN
187 ! This case should not occur
188 WRITE(*,*) "Error in non-local decomp"
189 WRITE(*,*) "Quad element error"
190 stop
191 ELSEIF (numg<=numels+numelq+numelc) THEN ! If the element is a shell
192 numg = numg - (numels+numelq) ! Offset on NUMG
193 DO k=1,4 ! Loop over the nodes of the shell
194 shft = ishft(1,k-1) ! Shift
195 testval = iand(shtag(numg),shft) ! Testval
196 ! Filling IADC
197 IF (ixc(k+1,numg)==ng.AND.testval==0) THEN
198 iadc(k,numl) = cc_l
199 shtag(numg) = shtag(numg)+shft
200 ENDIF
201 ENDDO
202 ELSEIF (numg<=numels+numelq+numelc+numelt) THEN
203 ! This case should not occur
204 WRITE(*,*) "Error in non-local decomp"
205 WRITE(*,*) "Truss element error"
206 stop
207 ELSEIF (numg<=numels+numelq+numelc+numelt+numelp) THEN
208 ! This case should not occur
209 WRITE(*,*) "Error in non-local decomp"
210 WRITE(*,*) "Poutre element error"
211 stop
212 ELSEIF (numg<=numels+numelq+numelc+numelt+numelp+numelr) THEN
213 ! This case should not occur
214 WRITE(*,*) "Error in non-local decomp"
215 WRITE(*,*) "Ressort element error"
216 stop
217 ELSEIF (numg<=numels+numelq+numelc+numelt+numelp+ ! If the element is a triangle shell
218 . numelr+numeltg) THEN
219 numg = numg - (numels+numelq+numelc+numelt+numelp+numelr) ! Offset on NUMG
220 DO k=1,3 ! Loop over the nodes of the shell
221 shft = ishft(1,k-1) ! Shift
222 testval = iand(tgtag(numg),shft) ! Testval
223 IF (ixtg(k+1,numg)==ng.AND.testval==0) THEN ! Filling IADTG
224 iadtg(k,numl) = cc_l
225 tgtag(numg) = tgtag(numg)+shft
226 ENDIF
227 ENDDO
228 ELSE
229 ! This case should not occur
230 WRITE(*,*) "Error in non-local decomp"
231 stop
232 ENDIF
233 ENDIF
234 ENDDO
235 ENDDO
236 ENDIF
237c
238 head(1) = iloc
239 head(2) = nnod_l
240 head(3) = lnloc_l
241 head(4) = numels_l
242 head(5) = numelc_l
243 head(6) = numeltg_l
244 head(7) = nddmax_l
245 head(8) = lcnenl_l
246C
247 IF (nsubdom > 0) THEN
248C-- multidomains - original nummat is used
249 matsize = nummat0
250 ELSE
251 matsize = nummat
252 ENDIF
253C
254 CALL write_i_c(head,8)
255c
256 CALL write_db(nloc_dmg%DENS,matsize) ! DENS
257c
258 CALL write_db(nloc_dmg%DAMP,matsize) ! DAMP
259c
260 CALL write_db(nloc_dmg%LEN,matsize) ! LEN
261c
262 CALL write_db(nloc_dmg%LE_MAX,matsize) ! LEN
263c
264 CALL write_db(nloc_dmg%SSPNL,matsize) ! SSPNL
265c
266 CALL write_i_c(indx_l,nnod_l) ! indx_l(nnod_l)
267c
268 CALL write_i_c(posi,nnod_l+1) ! POSI(NNOD_L+1)
269c
270 CALL write_i_c(idxi_l,numnod_l) ! IDXI_L(NUMNOD_L)
271c
272 ! If PARITH/ON
273 IF (ipari0 == 1) THEN
274c
275 CALL write_i_c(addcne_l,nnod_l+1) ! ADDCNE_L(NNOD_L+1)
276c
277 CALL write_i_c(procne_l,lcnenl_l) ! PROCNE_L(LCNENL_L)
278c
279 CALL write_i_c(iads,8*numels_l) ! IADS(8,NUMELS_L)
280c
281 CALL write_i_c(iadc,4*numelc_l) ! IADC(4,NUMELC_L)
282c
283 CALL write_i_c(iadtg,3*numeltg_l) ! IADTG(3,NUMELTG_L)
284c
285 ENDIF
286c
287 CALL write_db(mass,lnloc_l) ! MASS
288c
289 CALL write_db(mass0,lnloc_l) ! MASS0
290c
291 IF (.NOT.ALLOCATED(zero_vec)) ALLOCATE(zero_vec(4*lnloc_l))
292 zero_vec(1:4*lnloc_l) = zero
293 CALL write_db(zero_vec,4*lnloc_l) ! FNL (ZERO), VNL (ZERO), VNL_OLD (ZERO), DNL (ZERO)
294c
295 CALL write_db(unl,lnloc_l) ! UNL
296c
297 ! Deallocation of tables
298 IF (ALLOCATED(soltag)) DEALLOCATE(soltag)
299 IF (ALLOCATED(shtag)) DEALLOCATE(shtag)
300 IF (ALLOCATED(tgtag)) DEALLOCATE(tgtag)
301 IF (ALLOCATED(addcne_l)) DEALLOCATE(addcne_l)
302 IF (ALLOCATED(procne_l)) DEALLOCATE(procne_l)
303 IF (ALLOCATED(iads)) DEALLOCATE(iads)
304 IF (ALLOCATED(iadc)) DEALLOCATE(iadc)
305 IF (ALLOCATED(iadtg)) DEALLOCATE(iadtg)
306 IF (ALLOCATED(zero_vec)) DEALLOCATE(zero_vec)
307c
308 DEALLOCATE(indx_l)
309 DEALLOCATE(nddl)
310 DEALLOCATE(idxi_l)
311 DEALLOCATE(posi)
312 ENDIF
313c--------------------------------
314 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
nl
character *2 function nl()
Definition message.F:2354
write_db
subroutine write_db(a, n)
Definition write_db.F:140
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645