OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parsor_crk.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!|| parsor_crk ../engine/source/output/anim/generate/parsor_crk.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| spmd_iget_partn ../engine/source/mpi/anim/spmd_iget_partn.F
29!|| spmd_iglob_partn ../engine/source/mpi/anim/spmd_iglob_partn.F
30!|| write_i_c ../common_source/tools/input_output/write_routines.c
31!||--- uses -----------------------------------------------------
32!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
35!||====================================================================
36 SUBROUTINE parsor_crk(IPARG ,IXC ,IXTG ,EL2FA,IDCRK ,
37 . IAD_CRK,IAD_CRKG,NBF_L ,NBF ,IEL_CRK ,
38 . NODGLOBXFE,INDX_CRK,ITAB )
39C-----------------------------------------------
40 USE crackxfem_mod
41 USE my_alloc_mod
42 use element_mod , only : nixc,nixtg
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "com_xfem1.inc"
53#include "param_c.inc"
54#include "task_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),IPARG(NPARG,NGROUP),IEL_CRK(*),
59 . EL2FA(*),IDCRK,IAD_CRK(*),IAD_CRKG(NSPMD,*),INDX_CRK(*),
60 . nbf_l,nbf,nodglobxfe(*),itab(*)
61C-----------------------------------------------
62C REAL
63 INTEGER IE, NG, ITY, LFT, LLT, N, I, NEL, NFT, JJ, BUF, IXFEM,
64 . CRKS,ICRK,IE_EL2FA,NEL_CRK,NLEVXF
65 INTEGER II(4)
66 INTEGER,DIMENSION(:),ALLOCATABLE::NP
67C=======================================================================
68C CRK ELEMS INIT
69C-----------------------------------------------
70 CALL my_alloc(np, nbf_l*4)
71 nel_crk = 0
72 jj = 0
73 ie = 0
74C-----------------------------------------------
75 DO crks = 1,ncrkpart
76 icrk = indx_crk(crks)
77 ie_el2fa = 0
78C
79C In SPMD you must send the info even qd we have 0 local elem
80C
81 DO ng=1,ngroup
82 nel =iparg(2,ng)
83 nft =iparg(3,ng)
84 ity =iparg(5,ng)
85 ixfem =iparg(54,ng)
86 lft=1
87 llt=nel
88 nlevxf = iparg(65,ng)
89C-----------------------------------------------
90C COQUES
91C-----------------------------------------------
92 IF (ixfem > 0) THEN
93 IF(ixfem == 2 .AND. icrk > nlevxf) cycle
94 IF (ity == 3) THEN
95 DO i=lft,llt
96 n = i + nft
97 IF (iel_crk(n) == 0) cycle
98 ie = ie + 1
99 ie_el2fa = ie_el2fa + 1
100 ii(1) = crkshell(icrk)%XNODEL(1,ie_el2fa)
101 ii(2) = crkshell(icrk)%XNODEL(2,ie_el2fa)
102 ii(3) = crkshell(icrk)%XNODEL(3,ie_el2fa)
103 ii(4) = crkshell(icrk)%XNODEL(4,ie_el2fa)
104c print*,'ICRK,ID=',ICRK,CRKSHELL(ICRK)%CRKSHELLID(IE_EL2FA)
105c print*,' NODES=',ITAB(II(1)),ITAB(II(2)),ITAB(II(3)),ITAB(II(4))
106 IF (nspmd == 1) THEN
107 ii(1) = ii(1)-1+idcrk
108 ii(2) = ii(2)-1+idcrk
109 ii(3) = ii(3)-1+idcrk
110 ii(4) = ii(4)-1+idcrk
111 CALL write_i_c(ii,4)
112 ELSE
113 np(jj+1) = nodglobxfe(ii(1))-1+idcrk
114 np(jj+2) = nodglobxfe(ii(2))-1+idcrk
115 np(jj+3) = nodglobxfe(ii(3))-1+idcrk
116 np(jj+4) = nodglobxfe(ii(4))-1+idcrk
117 ENDIF
118 el2fa(nel_crk+ie_el2fa) = ie
119 jj = jj + 4
120 ENDDO
121C-----------------------------------------------
122C COQUES 3 NOEUDS
123C-----------------------------------------------
124 ELSEIF (ity == 7) THEN
125 DO i=lft,llt
126 n = i + nft
127 IF (iel_crk(n+numelc) == 0) cycle
128 ie = ie + 1
129 ie_el2fa = ie_el2fa + 1
130 ii(1) = crkshell(icrk)%XNODEL(1,ie_el2fa)
131 ii(2) = crkshell(icrk)%XNODEL(2,ie_el2fa)
132 ii(3) = crkshell(icrk)%XNODEL(3,ie_el2fa)
133 ii(4) = crkshell(icrk)%XNODEL(3,ie_el2fa)
134c II(4) = CRKSHELL(ICRK)%XNODEL(4,IE_EL2FA)
135 IF(nspmd == 1)THEN
136 ii(1) = ii(1)-1+idcrk
137 ii(2) = ii(2)-1+idcrk
138 ii(3) = ii(3)-1+idcrk
139 ii(4) = ii(4)-1+idcrk
140 CALL write_i_c(ii,4)
141 ELSE
142 np(jj+1) = nodglobxfe(ii(1))-1+idcrk
143 np(jj+2) = nodglobxfe(ii(2))-1+idcrk
144 np(jj+3) = nodglobxfe(ii(3))-1+idcrk
145 np(jj+4) = nodglobxfe(ii(3))-1+idcrk
146c NP(JJ+4) = NODGLOBXFE(II(4))-1+IDCRK
147 ENDIF
148 el2fa(nel_crk+ie_el2fa) = ie
149 jj = jj + 4
150 ENDDO
151 ENDIF ! IF (ITY == 3)
152 ENDIF ! IF (IXFEM == 1 .OR. IXFEM == 2)
153 ENDDO ! DO NG=1,NGROUP
154C
155 iad_crk(icrk) = ie
156 nel_crk = nel_crk + crkshell(icrk)%CRKNUMSHELL
157 ENDDO ! DO CRKS = 1,NCRKPART
158c----------------------------------------
159 IF (nspmd > 1) THEN
160C build global part array on proc 0
161 IF(ispmd == 0)THEN
162 CALL spmd_iglob_partn(iad_crk,ncrkpart,iad_crkg,ncrkpart)
163 buf = 4 * nbf
164 CALL spmd_iget_partn(4,jj,np,ncrkpart,iad_crkg,buf,1)
165 ELSE
166 CALL spmd_iglob_partn(iad_crk,ncrkpart,iad_crkg,1)
167 buf=1
168 CALL spmd_iget_partn(4,jj,np,ncrkpart,iad_crkg,buf,1)
169 ENDIF
170C
171 ELSE ! IADG filling for mono/multi compatibility
172 DO i = 1, ncrkpart
173 iad_crkg(1,i) = iad_crk(i)
174 END DO
175 ENDIF
176C-----------
177 DEALLOCATE(np)
178 RETURN
179 END
crackxfem_mod
Definition crackxfem_mod.F:121
crackxfem_mod::crkshell
type(xfem_shell_), dimension(:), allocatable crkshell
Definition crackxfem_mod.F:190
parsor_crk
subroutine parsor_crk(iparg, ixc, ixtg, el2fa, idcrk, iad_crk, iad_crkg, nbf_l, nbf, iel_crk, nodglobxfe, indx_crk, itab)
Definition parsor_crk.F:39
spmd_iget_partn
subroutine spmd_iget_partn(size, nbf_l, np, nbpart, iadg, srbuf, iflag)
Definition spmd_iget_partn.F:50
spmd_iglob_partn
subroutine spmd_iglob_partn(iad, nbpart, iadg, sbuf)
Definition spmd_iglob_partn.F:39
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645