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_routtines.c
31!||--- uses -----------------------------------------------------
32!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
33!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
34!||====================================================================
35 SUBROUTINE parsor_crk(IPARG ,IXC ,IXTG ,EL2FA,IDCRK ,
36 . IAD_CRK,IAD_CRKG,NBF_L ,NBF ,IEL_CRK ,
37 . NODGLOBXFE,INDX_CRK,ITAB )
38C-----------------------------------------------
39 USE crackxfem_mod
40 USE my_alloc_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "com04_c.inc"
50#include "com_xfem1.inc"
51#include "param_c.inc"
52#include "task_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),IPARG(NPARG,NGROUP),IEL_CRK(*),
57 . EL2FA(*),IDCRK,IAD_CRK(*),IAD_CRKG(NSPMD,*),INDX_CRK(*),
58 . nbf_l,nbf,nodglobxfe(*),itab(*)
59C-----------------------------------------------
60C REAL
61 my_real off
62 INTEGER IE,NG,ITY,LFT,LLT,N,I,J,NEL,NFT,JJ,K,BUF,IXFEM,
63 . ipt,elc,crks,icrk,ie_el2fa,nel_crk,empl,nlevxf
64 INTEGER II(4)
65 INTEGER,DIMENSION(:),ALLOCATABLE::NP
66C=======================================================================
67C CRK ELEMS INIT
68C-----------------------------------------------
69 CALL my_alloc(np, nbf_l*4)
70 nel_crk = 0
71 jj = 0
72 ie = 0
73C-----------------------------------------------
74 DO crks = 1,ncrkpart
75 icrk = indx_crk(crks)
76 ie_el2fa = 0
77C
78C en spmd il faut envoyer l'info meme qd on a 0 elem local
79C
80 DO ng=1,ngroup
81 nel =iparg(2,ng)
82 nft =iparg(3,ng)
83 ity =iparg(5,ng)
84 ixfem =iparg(54,ng)
85 lft=1
86 llt=nel
87 nlevxf = iparg(65,ng)
88C-----------------------------------------------
89C COQUES
90C-----------------------------------------------
91 IF (ixfem > 0) THEN
92 IF(ixfem == 2 .AND. icrk > nlevxf) cycle
93 IF (ity == 3) THEN
94 DO i=lft,llt
95 n = i + nft
96 IF (iel_crk(n) == 0) cycle
97 ie = ie + 1
98 ie_el2fa = ie_el2fa + 1
99 ii(1) = crkshell(icrk)%XNODEL(1,ie_el2fa)
100 ii(2) = crkshell(icrk)%XNODEL(2,ie_el2fa)
101 ii(3) = crkshell(icrk)%XNODEL(3,ie_el2fa)
102 ii(4) = crkshell(icrk)%XNODEL(4,ie_el2fa)
103c print*,'ICRK,ID=',ICRK,CRKSHELL(ICRK)%CRKSHELLID(IE_EL2FA)
104c print*,' NODES=',ITAB(II(1)),ITAB(II(2)),ITAB(II(3)),ITAB(II(4))
105 IF (nspmd == 1) THEN
106 ii(1) = ii(1)-1+idcrk
107 ii(2) = ii(2)-1+idcrk
108 ii(3) = ii(3)-1+idcrk
109 ii(4) = ii(4)-1+idcrk
110 CALL write_i_c(ii,4)
111 ELSE
112 np(jj+1) = nodglobxfe(ii(1))-1+idcrk
113 np(jj+2) = nodglobxfe(ii(2))-1+idcrk
114 np(jj+3) = nodglobxfe(ii(3))-1+idcrk
115 np(jj+4) = nodglobxfe(ii(4))-1+idcrk
116 ENDIF
117 el2fa(nel_crk+ie_el2fa) = ie
118 jj = jj + 4
119 ENDDO
120C-----------------------------------------------
121C COQUES 3 NOEUDS
122C-----------------------------------------------
123 ELSEIF (ity == 7) THEN
124 DO i=lft,llt
125 n = i + nft
126 IF (iel_crk(n+numelc) == 0) cycle
127 ie = ie + 1
128 ie_el2fa = ie_el2fa + 1
129 ii(1) = crkshell(icrk)%XNODEL(1,ie_el2fa)
130 ii(2) = crkshell(icrk)%XNODEL(2,ie_el2fa)
131 ii(3) = crkshell(icrk)%XNODEL(3,ie_el2fa)
132 ii(4) = crkshell(icrk)%XNODEL(3,ie_el2fa)
133c II(4) = CRKSHELL(ICRK)%XNODEL(4,IE_EL2FA)
134 IF(nspmd == 1)THEN
135 ii(1) = ii(1)-1+idcrk
136 ii(2) = ii(2)-1+idcrk
137 ii(3) = ii(3)-1+idcrk
138 ii(4) = ii(4)-1+idcrk
139 CALL write_i_c(ii,4)
140 ELSE
141 np(jj+1) = nodglobxfe(ii(1))-1+idcrk
142 np(jj+2) = nodglobxfe(ii(2))-1+idcrk
143 np(jj+3) = nodglobxfe(ii(3))-1+idcrk
144 np(jj+4) = nodglobxfe(ii(3))-1+idcrk
145c NP(JJ+4) = NODGLOBXFE(II(4))-1+IDCRK
146 ENDIF
147 el2fa(nel_crk+ie_el2fa) = ie
148 jj = jj + 4
149 ENDDO
150 ENDIF ! IF (ITY == 3)
151 ENDIF ! IF (IXFEM == 1 .OR. IXFEM == 2)
152 ENDDO ! DO NG=1,NGROUP
153C
154 iad_crk(icrk) = ie
155 nel_crk = nel_crk + crkshell(icrk)%CRKNUMSHELL
156 ENDDO ! DO CRKS = 1,NCRKPART
157c----------------------------------------
158 IF (nspmd > 1) THEN
159C construction tableau global des parts sur p0
160 IF(ispmd == 0)THEN
161 CALL spmd_iglob_partn(iad_crk,ncrkpart,iad_crkg,ncrkpart)
162 buf = 4 * nbf
163 CALL spmd_iget_partn(4,jj,np,ncrkpart,iad_crkg,buf,1)
164 ELSE
165 CALL spmd_iglob_partn(iad_crk,ncrkpart,iad_crkg,1)
166 buf=1
167 CALL spmd_iget_partn(4,jj,np,ncrkpart,iad_crkg,buf,1)
168 ENDIF
169C
170 ELSE ! remplissage IADG pour compatibilite mono/multi
171 DO i = 1, ncrkpart
172 iad_crkg(1,i) = iad_crk(i)
173 END DO
174 ENDIF
175C-----------
176 DEALLOCATE(np)
177 RETURN
178 END
my_real
#define my_real
Definition cppsort.cpp:32
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:38
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_routtines.c:645