OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24_prepare.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!|| spmd_i24_prepare ../engine/source/interfaces/int24/i24_prepare.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- uses -----------------------------------------------------
28!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
29!|| message_mod ../engine/share/message_module/message_mod.F
30!|| tri7box ../engine/share/modules/tri7box.F
31!||====================================================================
32 SUBROUTINE spmd_i24_prepare(MODE,IPARI, INTBUF_TAB,
33 * IAD_ELEM, FR_ELEM,INTLIST,NBINTC,
34 * IAD_I24 , SFR_I24, FR_I24,I24MAXNSNE)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE tri7box
39 USE message_mod
40 USE intbufdef_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45#include "spmd_c.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "param_c.inc"
50#include "com04_c.inc"
51#include "com01_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER MODE
56 INTEGER IPARI(NPARI,*),IAD_ELEM(2,*),FR_ELEM(*),
57 * intlist(*),nbintc,iad_i24(nbintc+1,nspmd), sfr_i24,
58 * fr_i24(*),i24maxnsne
59 TYPE(intbuf_struct_) INTBUF_TAB(*)
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER ITAG(NUMNOD),SZFRI24,IAFR24
64 INTEGER P,I,J,NI,NIN,NOD,NTY,NSN,SN,NSNE
65C-----------------------------------------------
66C Partie 1, calcul des tailles de FR_I24
67C-----------------------------------------------
68 itag(1:numnod)=0
69 IF (mode==1)THEN
70
71 szfri24 = 0
72
73 DO p = 1, nspmd
74 IF(iad_elem(1,p+1)-iad_elem(1,p)>0) THEN
75 DO j=iad_elem(1,p),iad_elem(1,p+1)-1
76 nod = fr_elem(j)
77 itag(nod)=1
78 ENDDO
79 DO ni=1,nbintc
80 nin = intlist(ni)
81 nty = ipari(7,nin)
82 nsn = ipari(5,nin)
83
84 IF(nty==24) THEN
85 DO i=1,nsn
86 sn = intbuf_tab(nin)%NSV(i)
87C Fictives T24 E2E Nodes hav NSV over Numnod
88 IF(sn<=numnod)THEN
89 IF(itag(sn)==1)THEN
90 szfri24 = szfri24+1
91 ENDIF
92 ENDIF
93 ENDDO
94 ENDIF
95 ENDDO
96C Flush ITAG to zero again for next CPU
97 DO j=iad_elem(1,p),iad_elem(1,p+1)-1
98 nod = fr_elem(j)
99 itag(nod)=0
100 ENDDO
101 ENDIF
102 ENDDO
103 sfr_i24=szfri24
104C-----------------------------------------------
105C Partie 2, on remplis FR_I24 et IAD_I24
106C-----------------------------------------------
107 ELSEIF(mode==2)THEN
108 iad_i24(1,1)=1
109 iafr24=0
110 DO p = 1, nspmd
111 IF(iad_elem(1,p+1)-iad_elem(1,p)>0) THEN
112 DO j=iad_elem(1,p),iad_elem(1,p+1)-1
113 nod = fr_elem(j)
114 itag(nod)=1
115 ENDDO
116
117 DO ni=1,nbintc
118 iad_i24(ni+1,p)=iad_i24(ni,p)
119 nin = intlist(ni)
120 nty = ipari(7,nin)
121 nsn = ipari(5,nin)
122
123 IF(nty==24) THEN
124 DO i=1,nsn
125 sn = intbuf_tab(nin)%NSV(i)
126C Fictives T24 E2E Nodes hav NSV over Numnod
127 IF(sn<=numnod)THEN
128 IF(itag(sn)==1)THEN
129 iad_i24(ni+1,p)=iad_i24(ni+1,p)+1
130 iafr24 = iafr24 + 1
131 fr_i24(iafr24)=i
132 ENDIF
133 ENDIF
134 ENDDO
135 ENDIF
136 ENDDO
137C Flush ITAG to zero again for next CPU
138 DO j=iad_elem(1,p),iad_elem(1,p+1)-1
139 nod = fr_elem(j)
140 itag(nod)=0
141 ENDDO
142 ELSE
143 DO i=2,nbintc+1
144 iad_i24(i,p)=iad_i24(1,p)
145 ENDDO
146 ENDIF ! IF(IAD_ELEM(1,P+1)-IAD_ELEM(1,P)>0)
147 IF(p<nspmd)iad_i24(1,p+1)=iad_i24(nbintc+1,p)
148 ENDDO
149 ENDIF
150
151C E2E SPMD
152C Compute Max. number of Fictive E2E Nodes in Type24
153C This is needed for Tags over nodes
154C
155 IF(mode==2)THEN
156 i24maxnsne=0
157 DO ni=1,nbintc
158 nin = intlist(ni)
159 nty = ipari(7,nin)
160 IF(nty==24)THEN
161 nsne=ipari(55,nin)
162 i24maxnsne=max(i24maxnsne,nsne)
163 ENDIF
164 ENDDO
165 ENDIF
166
167 i24com3 = 0
168 i24com4 = 0
169C-----------------------------------------------
170 END
171
spmd_i24_prepare
subroutine spmd_i24_prepare(mode, ipari, intbuf_tab, iad_elem, fr_elem, intlist, nbintc, iad_i24, sfr_i24, fr_i24, i24maxnsne)
Definition i24_prepare.F:35
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249