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