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

Go to the source code of this file.

Functions/Subroutines

subroutine ini_ifront ()
subroutine realloc_ifront ()
subroutine plist_ifront (tab, n, cpt)
subroutine c_ifront (n, cpt)
integer function nlocal (n, p)
subroutine set_front8 (ipari, intercep, intbuf_tab, t8, nbt8, itab)
subroutine set_intercep (ipari, intercep, flag, intbuf_tab, itab, cep)
subroutine fill_intercep (ipari, intbuf_tab, intercep)
integer function intersurfl (n1, n2, n3, n4)
subroutine ini_iddconnect (nelem)
subroutine realloc_iddconnect (nelem)
subroutine c_iddconnect (n, cpt)
subroutine plist_iddconnect (adjncy, xadj, n)
subroutine plist_bfs (nelem, nconnx, colors, roots)

Function/Subroutine Documentation

◆ c_iddconnect()

subroutine c_iddconnect ( integer n,
integer cpt )

Definition at line 1207 of file ddtools.F.

1208C returns in CPT the number of connected nodes
1209C-----------------------------------------------
1210C M o d u l e s
1211C-----------------------------------------------
1212 USE front_mod
1213C-----------------------------------------------
1214C I m p l i c i t T y p e s
1215C-----------------------------------------------
1216#include "implicit_f.inc"
1217C-----------------------------------------------
1218C D u m m y A r g u m e n t s
1219C-----------------------------------------------
1220 INTEGER N,CPT
1221C-----------------------------------------------
1222C L o c a l V a r i a b l e s
1223C-----------------------------------------------
1224 INTEGER IAD
1225C-----------------------------------------------
1226C S o u r c e L i n e s
1227C-----------------------------------------------
1228 cpt=0
1229 iad=iddconnect%IENTRYDOM(1,n)
1230! if no connected node
1231! nothing to do as init has been done to -1
1232 IF(iad==-1)THEN
1233 cpt = 0
1234 RETURN
1235 ENDIF
1236
1237 IF(iddconnect%PDOM(2,iad)==0)THEN
1238! only one connected node
1239 cpt = cpt+1
1240 ELSE
1241! list of connected nodes for node N
1242 DO WHILE(iad/=0)
1243 cpt=cpt+1
1244 iad=iddconnect%PDOM(2,iad)
1245 ENDDO
1246 ENDIF
1247
1248 RETURN
front_mod
Definition front_mod.F:84
front_mod::iddconnect
type(my_connectdom) iddconnect
Definition front_mod.F:101

◆ c_ifront()

subroutine c_ifront ( integer n,
integer cpt )

Definition at line 204 of file ddtools.F.

205c returns in CPT the number of procs on which node N is sticked
206C-----------------------------------------------
207C M o d u l e s
208C-----------------------------------------------
209 USE front_mod
210C-----------------------------------------------
211C I m p l i c i t T y p e s
212C-----------------------------------------------
213#include "implicit_f.inc"
214C-----------------------------------------------
215C D u m m y A r g u m e n t s
216C-----------------------------------------------
217 INTEGER N,CPT
218C-----------------------------------------------
219C L o c a l V a r i a b l e s
220C-----------------------------------------------
221 INTEGER IAD
222C-----------------------------------------------
223C S o u r c e L i n e s
224C-----------------------------------------------
225 cpt=0
226 iad=ifront%IENTRY(n)
227c no proc set for this node
228c nothing to do as init has been done to -1
229 IF(iad==-1)THEN
230 cpt = 0
231 RETURN
232 ENDIF
233
234 IF(ifront%P(2,iad)==0)THEN
235c only one proc
236 cpt = cpt+1
237 ELSE
238c list of procs for node N
239 DO WHILE(iad/=0)
240 cpt=cpt+1
241 iad=ifront%P(2,iad)
242 ENDDO
243 ENDIF
244
245 RETURN
front_mod::ifront
type(my_front) ifront
Definition front_mod.F:93

◆ fill_intercep()

subroutine fill_intercep ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
type(intersurfp), dimension(3,ninter) intercep )

Definition at line 972 of file ddtools.F.

973C new routine called right after domdec1 to be used by interface sorting
974C-----------------------------------------------
975C M o d u l e s
976C-----------------------------------------------
977 USE message_mod
978 USE front_mod
979 USE intbufdef_mod
980C-----------------------------------------------
981C I m p l i c i t T y p e s
982C-----------------------------------------------
983#include "implicit_f.inc"
984C-----------------------------------------------
985C G l o b a l P a r a m e t e r s
986C-----------------------------------------------
987#include "param_c.inc"
988C-----------------------------------------------
989C C o m m o n B l o c k s
990C-----------------------------------------------
991#include "com04_c.inc"
992C-----------------------------------------------
993C D u m m y A r g u m e n t s
994C-----------------------------------------------
995 INTEGER IPARI(NPARI,*)
996 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
997 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
998C-----------------------------------------------
999C E x t e r n a l F u n c t i o n s
1000C-----------------------------------------------
1001 INTEGER INTERSURFL
1002 EXTERNAL intersurfl
1003C-----------------------------------------------
1004C L o c a l V a r i a b l e s
1005C-----------------------------------------------
1006 INTEGER ITY,NRTM,N,N1,N2,N3,N4,NSN,
1007 . NRTS,N1L,N2L,N3L,N4L,NLINM,NLINS
1008 INTEGER NI,K,I,PROC
1009C--------------------------------------------------------------
1010 DO ni=1,ninter
1011
1012 !get generic values
1013 ity = ipari(7,ni)
1014
1015 IF (ity==7)THEN
1016
1017 nrtm = ipari(4,ni)
1018C Allocate CEP INTERFACE
1019 IF (.NOT.(ASSOCIATED(intercep(1,ni)%P)))THEN
1020 ALLOCATE(intercep(1,ni)%P(nrtm))
1021 ENDIF
1022 intercep(1,ni)%P(1:nrtm)=0
1023
1024 DO k=1,nrtm
1025 n1=intbuf_tab(ni)%IRECTM(4*(k-1)+1)
1026 n2=intbuf_tab(ni)%IRECTM(4*(k-1)+2)
1027 n3=intbuf_tab(ni)%IRECTM(4*(k-1)+3)
1028 n4=intbuf_tab(ni)%IRECTM(4*(k-1)+4)
1029 !find first SPMD domain on which the 4 nodes of the surface are
1030 IF(n1>numnod.OR.n2>numnod.OR.
1031 . n3>numnod.OR.n4>numnod) THEN
1032 intercep(1,ni)%P(k) = 1
1033 ELSE
1034 proc = intersurfl(n1,n2,n3,n4)
1035 intercep(1,ni)%P(k) = proc
1036 ENDIF
1037 ENDDO
1038
1039 ENDIF
1040
1041 ENDDO !ENDDO 1,NINTER
1042
intersurfl
integer function intersurfl(n1, n2, n3, n4)
Definition ddtools.F:1055
message_mod
Definition message_mod.F:1257

◆ ini_iddconnect()

subroutine ini_iddconnect ( integer nelem)

Definition at line 1114 of file ddtools.F.

1115C-----------------------------------------------
1116C M o d u l e s
1117C-----------------------------------------------
1118 USE front_mod
1119C-----------------------------------------------
1120C I m p l i c i t T y p e s
1121C-----------------------------------------------
1122#include "implicit_f.inc"
1123C-----------------------------------------------
1124C D u m m y A r g u m e n t s
1125C-----------------------------------------------
1126 INTEGER NELEM
1127C-----------------------------------------------
1128C L o c a l V a r i a b l e s
1129C-----------------------------------------------
1130 INTEGER I
1131
1132 DO i=1,nelem
1133 iddconnect%IENTRYDOM(1,i) = -1
1134 iddconnect%IENTRYDOM(2,i) = 0
1135 ENDDO
1136
1137 DO i=1, siddconnect
1138 iddconnect%PDOM(1,i) = -1
1139 iddconnect%PDOM(2,i) = -1
1140 END DO
1141
1142 iddconnect_end = nelem
1143C
1144 RETURN
front_mod::iddconnect_end
integer iddconnect_end
Definition front_mod.F:102
front_mod::siddconnect
integer siddconnect
Definition front_mod.F:102

◆ ini_ifront()

subroutine ini_ifront

Definition at line 30 of file ddtools.F.

31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34 USE front_mod
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39#include "com04_c.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43
44C-----------------------------------------------
45C L o c a l V a r i a b l e s
46C-----------------------------------------------
47 INTEGER I
48
49 DO i=1,numnod
50 ifront%IENTRY(i) = -1
51 ENDDO
52
53 DO i=1, sifront
54 ifront%P(1,i) = -1
55 ifront%P(2,i) = -1
56 END DO
57
58 ifront_end = numnod
59C
60 RETURN
front_mod::sifront
integer sifront
Definition front_mod.F:107
front_mod::ifront_end
integer ifront_end
Definition front_mod.F:107

◆ intersurfl()

integer function intersurfl ( integer n1,
integer n2,
integer n3,
integer n4 )

Definition at line 1054 of file ddtools.F.

1055C-----------------------------------------------
1056C M o d u l e s
1057C-----------------------------------------------
1058 USE front_mod
1059C-----------------------------------------------
1060C C o m m o n B l o c k s
1061C-----------------------------------------------
1062#include "implicit_f.inc"
1063C-----------------------------------------------
1064C D u m m y A r g u m e n t s
1065C-----------------------------------------------
1066 INTEGER N1,N2,N3,N4
1067C-----------------------------------------------
1068C L o c a l V a r i a b l e s
1069C-----------------------------------------------
1070 INTEGER IAD1,IAD2,IAD3,IAD4,
1071 . P1,P2,P3,P4,PMAX
1072 INTEGER TAB(4),NN
1073 LOGICAL SEARCH
1074C-----------------------------------------------
1075C S o u r c e L i n e s
1076C-----------------------------------------------
1077 intersurfl = -1
1078 search = .true.
1079
1080 iad1 = ifront%IENTRY(n1)
1081 iad2 = ifront%IENTRY(n2)
1082 iad3 = ifront%IENTRY(n3)
1083 iad4 = ifront%IENTRY(n4)
1084
1085 DO WHILE(search)
1086 p1 = ifront%P(1,iad1)
1087 p2 = ifront%P(1,iad2)
1088 p3 = ifront%P(1,iad3)
1089 p4 = ifront%P(1,iad4)
1090 IF(p1==p2.AND.p2==p3.AND.p3==p4)THEN
1091 intersurfl = p1
1092 search = .false.
1093 ELSE
1094 pmax = max(p1,p2,p3,p4)
1095 IF(p1<pmax) iad1 = ifront%P(2,iad1)
1096 IF(p2<pmax) iad2 = ifront%P(2,iad2)
1097 IF(p3<pmax) iad3 = ifront%P(2,iad3)
1098 IF(p4<pmax) iad4 = ifront%P(2,iad4)
1099 ENDIF
1100 ENDDO
1101! IF(INTERSURFL > 4) THEN
1102! WRITE(6,*) __FILE__,__LINE__,IAD1,IAD2,IAD3,IAD4
1103! ENDIF
1104
1105 RETURN
max
#define max(a, b)
Definition macros.h:21

◆ nlocal()

integer function nlocal ( integer n,
integer p )

Definition at line 349 of file ddtools.F.

350C returns 1 if node N is sticked on SPMD domain P, else returns 0
351C-----------------------------------------------
352C M o d u l e s
353C-----------------------------------------------
354 USE front_mod
355C-----------------------------------------------
356C C o m m o n B l o c k s
357C-----------------------------------------------
358#include "implicit_f.inc"
359C-----------------------------------------------
360C L o c a l V a r i a b l e s
361C-----------------------------------------------
362 INTEGER N,P,IAD
363 LOGICAL PSEARCH
364C-----------------------------------------------
365C S o u r c e L i n e s
366C-----------------------------------------------
367 psearch = .true.
368 iad = ifront%IENTRY(n)
369 nlocal = 0
370
371 ! no SPMD domain attributed for this node
372 IF(iad==-1)THEN
373 nlocal = 0
374 RETURN
375 ENDIF
376
377 !test if first proc is tested one (most frequent case)
378 IF(ifront%P(1,iad)==p)THEN
379 nlocal = 1
380 RETURN
381 ENDIF
382
383 iad = ifront%P(2,iad)
384 IF (iad==0)RETURN
385
386 DO WHILE(psearch)
387 IF(ifront%P(1,iad)==p) THEN
388 nlocal = 1
389 psearch = .false.
390 ENDIF
391 IF(ifront%P(1,iad)>p) psearch = .false.
392 IF(ifront%P(2,iad)==0) psearch = .false.
393 iad = ifront%P(2,iad)
394 ENDDO
395
396 RETURN
nlocal
integer function nlocal(n, p)
Definition ddtools.F:350

◆ plist_bfs()

subroutine plist_bfs ( integer nelem,
integer nconnx,
integer, dimension(nelem) colors,
integer, dimension(nelem) roots )

Definition at line 1310 of file ddtools.F.

1311C-----------------------------------------------
1312C MODULES
1313C-----------------------------------------------
1314 USE front_mod
1315C-----------------------------------------------
1316C I m p l i c i t T y p e s
1317C-----------------------------------------------
1318#include "implicit_f.inc"
1319C-----------------------------------------------
1320C D u m m y A r g u m e n t s
1321C-----------------------------------------------
1322 INTEGER NELEM, NCONNX,
1323 . COLORS(NELEM), ROOTS(NELEM)
1324C-----------------------------------------------
1325C L o c a l V a r i a b l e s
1326C-----------------------------------------------
1327 INTEGER NVISIT, N, I
1328 INTEGER, DIMENSION(:), ALLOCATABLE :: FILE_V
1329 INTEGER, DIMENSION(:), ALLOCATABLE :: XADJ
1330 INTEGER :: FILE_NEXT, ROOT, CURRENT, LEN
1331 INTEGER :: CPT,IAD
1332C-----------------------------------------------
1333
1334 ALLOCATE(file_v(nelem))
1335 ALLOCATE(xadj(nelem+1))
1336 xadj(1:nelem+1)=0
1337 xadj(1) = 1
1338 DO i=1,nelem
1339 CALL c_iddconnect(i,len)
1340 xadj(i+1) = xadj(i) + len
1341 ENDDO
1342
1343 DO n = 1, nelem
1344 colors(n)=0
1345 END DO
1346 nvisit=0
1347 root=1 ! first element of the graph == first vertex available
1348 nconnx=0
1349
1350 DO WHILE (nvisit < nelem) ! loop until all vertices are visited
1351 nconnx = nconnx+1
1352 DO WHILE ((root <= nelem) .AND. (colors(root) /= 0))
1353 root = root + 1
1354 END DO
1355 roots(nconnx)=root ! record roots for fatest treatments
1356 file_v(1)=root
1357 file_next=2 ! new file initialized with root
1358 colors(root)=nconnx ! root marked
1359 nvisit=nvisit+1
1360 DO WHILE (file_next > 1) ! test file not nill
1361 current = file_v(file_next-1)
1362 file_next = file_next-1
1363
1364 cpt=xadj(current)-1
1365 iad=iddconnect%IENTRYDOM(1,current)
1366
1367 DO n = xadj(current), xadj(current+1)-1
1368C I = ADJNCY(N)
1369 cpt = cpt+1
1370 i=iddconnect%PDOM(1,iad)
1371 iad=iddconnect%PDOM(2,iad)
1372C
1373
1374 IF(colors(i) == 0) THEN ! vertex not treated before
1375 file_v(file_next)=i
1376 file_next = file_next+1
1377 colors(i) = nconnx
1378 nvisit=nvisit+1
1379 END IF
1380 END DO
1381 END DO
1382 END DO
1383
1384 DEALLOCATE(file_v)
1385 RETURN
c_iddconnect
subroutine c_iddconnect(n, cpt)
Definition ddtools.F:1208

◆ plist_iddconnect()

subroutine plist_iddconnect ( integer, dimension(*) adjncy,
integer, dimension(*) xadj,
integer n )

Definition at line 1257 of file ddtools.F.

1258C returns in "ADJNCY" nodes connected to node N
1259C CPT is the number of nodes
1260C-----------------------------------------------
1261C M o d u l e s
1262C-----------------------------------------------
1263 USE front_mod
1264C-----------------------------------------------
1265C I m p l i c i t T y p e s
1266C-----------------------------------------------
1267#include "implicit_f.inc"
1268C-----------------------------------------------
1269C D u m m y A r g u m e n t s
1270C-----------------------------------------------
1271 INTEGER TAILLE
1272 INTEGER N,ADJNCY(*),XADJ(*)
1273C-----------------------------------------------
1274C L o c a l V a r i a b l e s
1275C-----------------------------------------------
1276 INTEGER CPT,IAD
1277C-----------------------------------------------
1278C S o u r c e L i n e s
1279C-----------------------------------------------
1280 cpt=xadj(n)-1
1281 iad=iddconnect%IENTRYDOM(1,n)
1282
1283! if no connected node
1284! nothing to do as init has been done to -1
1285
1286! only one connected node
1287 IF(iddconnect%PDOM(2,iad)==0)THEN
1288 cpt = cpt+1
1289 adjncy(cpt)=iddconnect%PDOM(1,iad)
1290 ELSE
1291! list of connected nodes for node N
1292 DO WHILE(iad/=0)
1293 cpt=cpt+1
1294 adjncy(cpt)=iddconnect%PDOM(1,iad)
1295 iad=iddconnect%PDOM(2,iad)
1296 ENDDO
1297 ENDIF
1298
1299 RETURN

◆ plist_ifront()

subroutine plist_ifront ( integer, dimension(nspmd) tab,
integer n,
integer cpt )

Definition at line 152 of file ddtools.F.

153C returns in "TAB" list of SPMD domains on which node N is sticked
154C CPT is the number of SPMD domains on which node N is sticked
155C-----------------------------------------------
156C M o d u l e s
157C-----------------------------------------------
158 USE front_mod
159C-----------------------------------------------
160C I m p l i c i t T y p e s
161C-----------------------------------------------
162#include "implicit_f.inc"
163#include "com01_c.inc"
164C-----------------------------------------------
165C D u m m y A r g u m e n t s
166C-----------------------------------------------
167 INTEGER N,CPT,TAB(NSPMD)
168C-----------------------------------------------
169C L o c a l V a r i a b l e s
170C-----------------------------------------------
171 INTEGER IAD
172C-----------------------------------------------
173C S o u r c e L i n e s
174C-----------------------------------------------
175 tab(1:nspmd) = -1
176 cpt=0
177 iad=ifront%IENTRY(n)
178 IF(iad==-1) RETURN
179c if no proc set for this node
180c nothing to do as init has been done to -1
181
182c only one proc
183 IF(ifront%P(2,iad)==0)THEN
184 cpt = cpt+1
185 tab(cpt)=ifront%P(1,iad)
186 ELSE
187c list of procs for node N
188 DO WHILE(iad/=0)
189 cpt=cpt+1
190 tab(cpt)=ifront%P(1,iad)
191 iad=ifront%P(2,iad)
192 ENDDO
193 ENDIF
194
195 RETURN

◆ realloc_iddconnect()

subroutine realloc_iddconnect ( integer nelem)

Definition at line 1156 of file ddtools.F.

1157C-----------------------------------------------
1158C M o d u l e s
1159C-----------------------------------------------
1160 USE message_mod
1161 USE front_mod
1162C-----------------------------------------------
1163C I m p l i c i t T y p e s
1164C-----------------------------------------------
1165#include "implicit_f.inc"
1166C-----------------------------------------------
1167C D u m m y A r g u m e n t s
1168C-----------------------------------------------
1169 INTEGER NELEM
1170C-----------------------------------------------
1171C L o c a l V a r i a b l e s
1172C-----------------------------------------------
1173 INTEGER,DIMENSION(:,:),ALLOCATABLE :: IDDCONNECT_SAVE
1174 INTEGER I, STAT
1175C-----------------------------------------------
1176C S o u r c e L i n e s
1177C-----------------------------------------------
1178 stat = 0
1179 ALLOCATE(iddconnect_save(2,siddconnect+nelem),stat=stat)
1180 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1181 . msgtype=msgerror,
1182 . c1='iddconnect_save')
1183
1184! save IDDCONNECT in IFRONT_SAVEDOM
1185 DO I=1,SIDDCONNECT
1186 IDDCONNECT_SAVE(1,I) = IDDCONNECT%PDOM(1,I)
1187 IDDCONNECT_SAVE(2,I) = IDDCONNECT%PDOM(2,I)
1188 ENDDO
1189 DO I=SIDDCONNECT+1,SIDDCONNECT+NELEM
1190 IDDCONNECT_SAVE(1,I) = -1
1191 IDDCONNECT_SAVE(2,I) = -1
1192 ENDDO
1193
1194 CALL MOVE_ALLOC(IDDCONNECT_SAVE, IDDCONNECT%PDOM)
1195 SIDDCONNECT = SIDDCONNECT+NELEM
1196
1197 RETURN
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895

◆ realloc_ifront()

subroutine realloc_ifront

Definition at line 72 of file ddtools.F.

73C-----------------------------------------------
74C M o d u l e s
75C-----------------------------------------------
76 USE message_mod
77 USE front_mod
78C-----------------------------------------------
79C I m p l i c i t T y p e s
80C-----------------------------------------------
81#include "implicit_f.inc"
82#include "com04_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 TYPE(my_front) :: IFRONT_SAVE
91 INTEGER I, STAT
92C-----------------------------------------------
93C S o u r c e L i n e s
94C-----------------------------------------------
95 ALLOCATE(ifront_save%P(2,sifront),stat=stat)
96 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
97 . msgtype=msgerror,
98 . c1='IFRONT_SAVE')
99
100c save IFRONT in IFRONT_SAVE
101 DO i=1,sifront
102 ifront_save%P(1,i) = ifront%P(1,i)
103 ifront_save%P(2,i) = ifront%P(2,i)
104 ENDDO
105
106c dealloc and realloc with bigger size (SIFRONT+NUMNOD)
107 DEALLOCATE(ifront%P)
108 ALLOCATE(ifront%P(2,sifront+numnod),stat=stat)
109 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
110 . msgtype=msgerror,
111 . c1='IFRONT REALLOC')
112
113 DO i=1,sifront
114 ifront%P(1,i) = ifront_save%P(1,i)
115 ifront%P(2,i) = ifront_save%P(2,i)
116 ENDDO
117 DO i=sifront+1,sifront+numnod
118 ifront%P(1,i) = -1
119 ifront%P(2,i) = -1
120 ENDDO
121
122 DEALLOCATE(ifront_save%P)
123
124c set new size of SIFRONT
125 sifront = sifront+numnod
126
127 RETURN

◆ set_front8()

subroutine set_front8 ( integer, dimension(npari,*) ipari,
type(intersurfp), dimension(3,ninter) intercep,
type(intbuf_struct_), dimension(*) intbuf_tab,
type(int8_struct_), dimension(nspmd,nbt8) t8,
integer nbt8,
integer, dimension(*) itab )

Definition at line 406 of file ddtools.F.

407C-----------------------------------------------
408C M o d u l e s
409C-----------------------------------------------
410 USE front_mod
411 USE intbufdef_mod
412 USE int8_mod
413C-----------------------------------------------
414C I m p l i c i t T y p e s
415C-----------------------------------------------
416#include "implicit_f.inc"
417C-----------------------------------------------
418C G l o b a l P a r a m e t e r s
419C-----------------------------------------------
420#include "param_c.inc"
421C-----------------------------------------------
422C C o m m o n B l o c k s
423C-----------------------------------------------
424#include "com01_c.inc"
425#include "com04_c.inc"
426C-----------------------------------------------
427C D u m m y A r g u m e n t s
428C-----------------------------------------------
429 INTEGER IPARI(NPARI,*)
430 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
431 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
432 TYPE(INT8_STRUCT_) :: T8(NSPMD,NBT8)
433 INTEGER :: NBT8,ITAB(*)
434C-----------------------------------------------
435C L o c a l V a r i a b l e s
436C-----------------------------------------------
437 INTEGER NI,K,I,PROC,P,Q,NB
438 INTEGER N1,N2,N3,N4
439 INTEGER ITY,NMN,NRTM,NM_SHARED
440 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAG,INDEX_IN_COMM
441 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_IN_FRONT
442 INTEGER :: S_FRONT8(NSPMD,NSPMD),IDX(NSPMD)
443 INTEGER :: LOCAL_ID,II,JJ,KK,NSN
444C--------------------------------------------------------------
445
446
447 nbt8 = 1
448 DO ni=1,ninter
449 !get generic values
450 ity = ipari(7,ni)
451 nmn = ipari(6,ni)
452 nrtm = ipari(4,ni)
453 nsn = ipari(5,ni)
454
455 local_id = 0
456 IF(ity == 8) THEN
457 ALLOCATE(index_in_front(nmn))
458 index_in_front(1:nmn) = 0
459 ALLOCATE(tag(nspmd,nmn))
460 ALLOCATE(index_in_comm(nspmd,nmn))
461 tag(1:nspmd,1:nmn) = 0
462 DO k=1,nrtm
463 n1 = intbuf_tab(ni)%IRECTM(4*(k-1)+1)
464 n2 = intbuf_tab(ni)%IRECTM(4*(k-1)+2)
465 n3 = intbuf_tab(ni)%IRECTM(4*(k-1)+3)
466 n4 = intbuf_tab(ni)%IRECTM(4*(k-1)+4)
467 proc = intercep(1,ni)%P(k)
468 tag(proc,n1) = 1
469 tag(proc,n2) = 1
470 tag(proc,n3) = 1
471 tag(proc,n4) = 1
472 ENDDO
473
474 ! Compute the number of main nodes shared between
475 ! each possible couple of proc (i,j) => S_FRONT8(i,j)
476 s_front8 = 0
477 DO p = 1,nspmd
478 DO q = p+1,nspmd
479 DO k = 1,nmn
480 IF(tag(p,k) == 1 .AND. tag(q,k) == 1) THEN
481 !The main is shared between procs P and Q
482 local_id = local_id + 1
483 s_front8(p,q) = s_front8(p,q) + 1
484 s_front8(q,p) = s_front8(q,p) + 1
485 ! the kth main node will have to be communucated
486 IF( index_in_front(k) == 0) THEN
487 index_in_front(k) = local_id
488 ENDIF
489 ENDIF
490 ENDDO
491 ENDDO
492 ENDDO
493 idx(1:nspmd) = 0
494 index_in_comm(1:nspmd,1:nmn) = 0
495 !INDEX_IN_COMM give an index to the communication structures
496 ! of each main node (or 0 if the main node is not shared)
497
498 DO k = 1,nmn
499 q = 0
500 DO p = 1,nspmd
501 q = q + tag(p,k)
502 ENDDO
503 IF(q > 1) THEN
504 DO p = 1,nspmd
505 IF(tag(p,k) /= 0) THEN
506 idx(p) = idx(p) + 1
507 index_in_comm(p,k)=idx(p)
508 ENDIF
509 ENDDO
510 ENDIF
511 ENDDO
512 ! symmetric allocation of arrays of size *nb main nodes in common*
513 ! between proc P and proc Q
514 DO p = 1,nspmd
515 DO q = p+1,nspmd
516 nm_shared = s_front8(p,q)
517 t8(p,nbt8)%BUFFER(q)%NBMAIN = 0! NM_SHARED
518 ALLOCATE(t8(p,nbt8)%BUFFER(q)%MAIN_ID(nm_shared))
519 ALLOCATE(t8(p,nbt8)%BUFFER(q)%MAIN_UID(nm_shared))
520 ALLOCATE(t8(p,nbt8)%BUFFER(q)%NBSECND(nm_shared))
521 t8(p,nbt8)%BUFFER(q)%NBSECND(1:nm_shared) = 0
522 t8(q,nbt8)%BUFFER(p)%NBMAIN = 0 !NM_SHARED
523 ALLOCATE(t8(q,nbt8)%BUFFER(p)%MAIN_ID(nm_shared))
524 ALLOCATE(t8(q,nbt8)%BUFFER(p)%MAIN_UID(nm_shared))
525 ALLOCATE(t8(q,nbt8)%BUFFER(p)%NBSECND(nm_shared))
526 t8(q,nbt8)%BUFFER(p)%NBSECND(1:nm_shared) = 0
527 ENDDO
528 ENDDO
529
530
531 !Compute the total number of main nodes to exchange per
532 ! proc P
533 DO p = 1,nspmd
534 k = idx(p)
535 t8(p,nbt8)%S_COMM = k
536 ALLOCATE(t8(p,nbt8)%SPMD_COMM_PATTERN(k))
537 DO q = 1,k
538 t8(p,nbt8)%SPMD_COMM_PATTERN(q)%NUMLOC = 0
539 t8(p,nbt8)%SPMD_COMM_PATTERN(q)%NBCOM = 0
540 ALLOCATE(t8(p,nbt8)%SPMD_COMM_PATTERN(q)%PROCLIST(nspmd))
541 t8(p,nbt8)%SPMD_COMM_PATTERN(q)%PROCLIST(1:nspmd) = 0
542 ALLOCATE(t8(p,nbt8)%SPMD_COMM_PATTERN(q)%BUF_INDEX(nspmd))
543 t8(p,nbt8)%SPMD_COMM_PATTERN(q)%BUF_INDEX(1:nspmd) = 0
544 ENDDO
545 ENDDO
546
547
548
549 ! Fill the part of the structure that depends only
550 ! on main nodes
551
552 ! To optimize the communication pattern in the engine,
553 ! The data dependencies are build in a symmetric fashion:
554 ! If procs P and Q share main K main nodes, then
555 ! T8(Q,NBT8)%BUFFER(P)%MAIN_UID(1:K) =
556 ! T8(P,NBT8)%BUFFER(Q)%MAIN_UID(1:K)
557 idx(1:nspmd) = 1
558 s_front8(1:nspmd,1:nspmd) = 0
559 DO p = 1,nspmd
560 DO k = 1,nmn
561 !If the node is has to be communicated by P
562 IF(index_in_comm(p,k) > 0) THEN
563 DO q = p+1,nspmd
564 IF(index_in_comm(q,k)/=0) THEN
565! Put the main node in the boundary of P with Q
566 local_id = index_in_comm(p,k)
567 nb = t8(p,nbt8)%SPMD_COMM_PATTERN(local_id)%NBCOM +1
568 t8(p,nbt8)%SPMD_COMM_PATTERN(local_id)%PROCLIST(nb) = q
569 ii = s_front8(p,q) + 1
570 t8(p,nbt8)%SPMD_COMM_PATTERN(local_id)%BUF_INDEX(nb) = ii
571 jj = t8(p,nbt8)%BUFFER(q)%NBMAIN+1
572 t8(p,nbt8)%BUFFER(q)%MAIN_ID(ii) = k
573 t8(p,nbt8)%BUFFER(q)%MAIN_UID(ii) =
574 . itab(intbuf_tab(ni)%MSR(k))
575
576 s_front8(p,q) = ii
577 t8(p,nbt8)%BUFFER(q)%NBMAIN = jj
578 t8(p,nbt8)%SPMD_COMM_PATTERN(local_id)%NBCOM=nb
579 t8(p,nbt8)%SPMD_COMM_PATTERN(local_id)%NUMLOC = k
580
581 ! SYMMETRIC : put the node in the boundary of Q with P
582 local_id = index_in_comm(q,k)
583 nb = t8(q,nbt8)%SPMD_COMM_PATTERN(local_id)%NBCOM +1
584 t8(q,nbt8)%SPMD_COMM_PATTERN(local_id)%PROCLIST(nb) = p
585 ii = s_front8(q,p) + 1
586 t8(q,nbt8)%SPMD_COMM_PATTERN(local_id)%BUF_INDEX(nb) = ii
587 jj = t8(q,nbt8)%BUFFER(p)%NBMAIN+1
588 t8(q,nbt8)%BUFFER(p)%MAIN_ID(ii) = k
589 t8(q,nbt8)%BUFFER(p)%MAIN_UID(ii) =
590 . itab(intbuf_tab(ni)%MSR(k))
591 s_front8(q,p) = ii
592 t8(q,nbt8)%BUFFER(p)%NBMAIN = jj
593 t8(q,nbt8)%SPMD_COMM_PATTERN(local_id)%NBCOM=nb
594 t8(q,nbt8)%SPMD_COMM_PATTERN(local_id)%NUMLOC = k
595 ENDIF
596 ENDDO
597 ENDIF
598 ENDDO
599 ENDDO ! NSPMD
600
601
602 DO p =1,nspmd
603 ! Count the number of actual secnds that have a main
604 ! shared between multiples procs
605 DO i = 1,nsn
606 IF(index_in_comm(p,intbuf_tab(ni)%ILOCS(i)) > 0) THEN
607 local_id = index_in_comm(p,intbuf_tab(ni)%ILOCS(i))
608 nb = t8(p,nbt8)%SPMD_COMM_PATTERN(local_id)%NBCOM
609 DO k =1,nb
610 ii = t8(p,nbt8)%SPMD_COMM_PATTERN(local_id)%BUF_INDEX(k)
611 q = t8(p,nbt8)%SPMD_COMM_PATTERN(local_id)%PROCLIST(k)
612 t8(p,nbt8)%BUFFER(q)%NBSECND(ii) =
613 . t8(p,nbt8)%BUFFER(q)%NBSECND(ii) + 1
614 t8(p,nbt8)%BUFFER(q)%NBSECND_TOT =
615 . t8(p,nbt8)%BUFFER(q)%NBSECND_TOT + 1
616 ENDDO
617 ENDIF
618 ENDDO !NSN
619 !DO Q = 1,NSPMD
620 ! IF(Q/=P) THEN
621 ! ! Total number of secnd node that have main nodes on processor
622 ! ! P shared with processor Q
623 ! II = T8(P,NBT8)%BUFFER(Q)%NBSECND_TOT
624 ! ALLOCATE(T8(P,NBT8)%BUFFER(Q)%SECND_ID(II))
625 ! ALLOCATE(T8(P,NBT8)%BUFFER(Q)%SECND_UID(II))
626 ! T8(P,NBT8)%BUFFER(Q)%SECND_ID(1:II) = 0
627 ! T8(P,NBT8)%BUFFER(Q)%SECND_UID(1:II) = 0
628 ! NB = T8(P,NBT8)%BUFFER(Q)%NBMAIN
629 ! IF(NB > 0) THEN
630 ! ! This array will keep pointers to secnd_id per main
631 ! ALLOCATE(T8(P,NBT8)%BUFFER(Q)%BUFI(NB))
632 ! T8(P,NBT8)%BUFFER(Q)%BUFI(1) = 1
633 ! DO i = 2,nb
634 ! T8(P,NBT8)%BUFFER(Q)%BUFI(I) =
635 . ! T8(P,NBT8)%BUFFER(Q)%BUFI(I-1) +
636 . ! T8(P,NBT8)%BUFFER(Q)%NBSECND(I-1)
637 ! ENDDO
638 ! ENDIF
639 ! ENDIF
640 !ENDDO !Q = 1,NSPMD
641 !DO I = 1,NSN
642 ! IF(INTBUF_TAB(NI)%ILOCS(I) > 0 ) THEN
643 ! ! If this secnd has a main shared by multiple proc
644 ! IF(INDEX_IN_COMM(P,INTBUF_TAB(NI)%ILOCS(I)) > 0) THEN
645 ! LOCAL_ID = INDEX_IN_COMM(P,INTBUF_TAB(NI)%ILOCS(I))
646 ! NB = T8(P,NBT8)%SPMD_COMM_PATTERN(LOCAL_ID)%NBCOM
647 ! DO K =1,NB
648 ! II = T8(P,NBT8)%SPMD_COMM_PATTERN(LOCAL_ID)%BUF_INDEX(K)
649 ! Q = T8(P,NBT8)%SPMD_COMM_PATTERN(LOCAL_ID)%PROCLIST(K)
650 ! JJ = T8(P,NBT8)%BUFFER(Q)%BUFI(II)
651 ! t8(p,nbt8)%BUFFER(q)%SECND_ID(jj) = i
652 ! T8(P,NBT8)%BUFFER(Q)%SECND_UID(JJ)= ITAB(INTBUF_TAB(NI)%NSV(I))
653 ! T8(P,NBT8)%BUFFER(Q)%BUFI(II) = JJ + 1
654 ! ENDDO
655 ! ENDIF
656 ! ENDIF
657 !ENDDO !I=1,NSN
658 ENDDO
659
660! USEFUL DEBUG PRINT
661! DO P = 1,NSPMD
662! WRITE(6,*) '============== Proc',P,'===',T8(P,NBT8)%S_COMM
663! DO LOCAL_ID=1,T8(P,NBT8)%S_COMM
664! NB = T8(P,NBT8)%SPMD_COMM_PATTERN(LOCAL_ID)%NBCOM
665! WRITE(6,*) 'NLOC=',T8(P,NBT8)%SPMD_COMM_PATTERN(LOCAL_ID)%NUMLOC,'NB=',NB
666! DO K =1,NB
667! II = T8(P,NBT8)%SPMD_COMM_PATTERN(LOCAL_ID)%BUF_INDEX(K)
668! Q = T8(P,NBT8)%SPMD_COMM_PATTERN(LOCAL_ID)%PROCLIST(K)
669! WRITE(6,*) 'Q=',Q,T8(P,NBT8)%BUFFER(Q)%MAIN_UID(II)
670! ENDDO
671! ENDDO
672! ENDDO
673! DO P = 1,NSPMD
674! DO Q = 1,NSPMD
675! IF(P /= Q) THEN
676! DO II = 1,T8(P,NBT8)%BUFFER(Q)%NBMAIN
677! WRITE(6,*) "EXCH",p,q,ii,t8(p,nbt8)%BUFFER(q)%MAIN_UID(ii)
678! ENDDO
679! ENDIF
680! ENDDO
681! ENDDO
682! DO P = 1, NSPMD
683! DO K = 1,T8(P,NBT8)%S_COMM
684! WRITE(6,*) P,ITAB(
685! . INTBUF_TAB(NI)%MSR(T8(P,NBT8)%SPMD_COMM_PATTERN(K)%NUMLOC))
686! ENDDO
687! ENDDO
688
689
690
691 DEALLOCATE(tag)
692 DEALLOCATE(index_in_comm)
693 DEALLOCATE(index_in_front)
694 nbt8 = nbt8 + 1
695 ENDIF !ITY == 8
696 ENDDO
697
698
699

◆ set_intercep()

subroutine set_intercep ( integer, dimension(npari,*) ipari,
type(intersurfp), dimension(3,ninter) intercep,
integer flag,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) itab,
integer, dimension(*) cep )

Definition at line 712 of file ddtools.F.

713C-----------------------------------------------
714C M o d u l e s
715C-----------------------------------------------
716 USE message_mod
717 USE front_mod
718 USE intbufdef_mod
719C-----------------------------------------------
720C I m p l i c i t T y p e s
721C-----------------------------------------------
722#include "implicit_f.inc"
723C-----------------------------------------------
724C G l o b a l P a r a m e t e r s
725C-----------------------------------------------
726#include "param_c.inc"
727C-----------------------------------------------
728C C o m m o n B l o c k s
729C-----------------------------------------------
730#include "com04_c.inc"
731C-----------------------------------------------
732C D u m m y A r g u m e n t s
733C-----------------------------------------------
734 INTEGER IPARI(NPARI,*),FLAG,ITAB(*),CEP(*)
735 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
736 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
737C-----------------------------------------------
738C E x t e r n a l F u n c t i o n s
739C-----------------------------------------------
740 INTEGER INTERSURFL
741 EXTERNAL intersurfl
742C-----------------------------------------------
743C L o c a l V a r i a b l e s
744C-----------------------------------------------
745 INTEGER ITY,NRTM,N,N1,N2,N3,N4,NSN,
746 . NRTS,N1L,N2L,N3L,N4L,NLINM,NLINS
747 INTEGER NI,K,I,PROC,IE
748C--------------------------------------------------------------
749 DO ni=1,ninter
750
751 !get generic values
752 ity = ipari(7,ni)
753
754 IF ((flag==0.AND.(ity==24.OR.(ity==25.AND.ipari(100,ni) == 0))).OR.
755 . (flag==1.AND.(ity==7.OR.ity==10.OR.
756 . ity==22.OR.ity==23)) )THEN
757
758 nrtm = ipari(4,ni)
759
760C Allocate CEP INTERFACE
761 IF (.NOT.(ASSOCIATED(intercep(1,ni)%P)))THEN
762 ALLOCATE(intercep(1,ni)%P(nrtm))
763 IF(ity==25) ALLOCATE(intercep(2,ni)%P(nrtm))
764 ENDIF
765 intercep(1,ni)%P(1:nrtm)=0
766 IF(ity==25) THEN
767 IF (.NOT.(ASSOCIATED(intercep(2,ni)%P)))THEN
768 ALLOCATE(intercep(2,ni)%P(nrtm))
769 ENDIF
770 intercep(2,ni)%P(1:nrtm) = 0
771 ENDIF
772
773 DO k=1,nrtm
774 n1=intbuf_tab(ni)%IRECTM(4*(k-1)+1)
775 n2=intbuf_tab(ni)%IRECTM(4*(k-1)+2)
776 n3=intbuf_tab(ni)%IRECTM(4*(k-1)+3)
777 n4=intbuf_tab(ni)%IRECTM(4*(k-1)+4)
778 IF(n1>numnod.OR.n2>numnod.OR.
779 . n3>numnod.OR.n4>numnod) THEN
780 intercep(1,ni)%P(k) = 1
781 ELSE
782 !find first SPMD domain on which the 4 nodes of the surface are
783 proc = intersurfl(n1,n2,n3,n4)
784 intercep(1,ni)%P(k) = proc
785 ENDIF
786 ENDDO
787 ELSEIF (flag==0.AND.ity==25.AND.ipari(100,ni) > 0)THEN ! in case of solid erosion : split interface according to element proc
788 nrtm = ipari(4,ni)
789C Allocate CEP INTERFACE
790 IF (.NOT.(ASSOCIATED(intercep(1,ni)%P)))THEN
791 ALLOCATE(intercep(1,ni)%P(nrtm))
792 ENDIF
793 intercep(1,ni)%P(1:nrtm)=0
794 DO k=1,nrtm
795 ie = intbuf_tab(ni)%IELEM_M(2*(k-1)+1)
796 IF(ie > 0) THEN
797 intercep(1,ni)%P(k) = cep(ie) + 1
798 ENDIF
799 ENDDO
800 ELSEIF(ity==24.AND.flag==1.AND.ipari(86,ni) > 0) THEN
801
802C Allocate CEP INTERFACE
803 nrts = ipari(3,ni)
804
805 IF (.NOT.(ASSOCIATED(intercep(3,ni)%P)))THEN
806 ALLOCATE(intercep(3,ni)%P(nrts))
807 ENDIF
808 intercep(3,ni)%P(1:nrts)=0
809
810 DO k=1,nrts
811 ! SECND SEGMENT AND ELEMENT HAVE TO ON THE SAME MPI DOMAIN (only solids/ if other CEP(OFF+IE))
812 ie = intbuf_tab(ni)%IELNRTS(k)
813 IF(ie > 0) THEN
814 proc = cep(ie)
815 intercep(3,ni)%P(k) = proc + 1
816 ENDIF
817 ENDDO
818
819 !ENDIF INTER TYPE 7, 10, 22, 23, 24, 25
820 ELSEIF (ity==8) THEN
821 nrtm = ipari(4,ni)
822
823C Allocate CEP INTERFACE
824 IF (.NOT.(ASSOCIATED(intercep(1,ni)%P)))THEN
825 ALLOCATE(intercep(1,ni)%P(nrtm))
826 ENDIF
827 intercep(1,ni)%P(1:nrtm)=0
828
829 DO k=1,nrtm
830 n1=intbuf_tab(ni)%IRECTM(4*(k-1)+1)
831 n2=intbuf_tab(ni)%IRECTM(4*(k-1)+2)
832 n3=intbuf_tab(ni)%IRECTM(4*(k-1)+3)
833 n4=intbuf_tab(ni)%IRECTM(4*(k-1)+4)
834 n1=intbuf_tab(ni)%MSR(n1)
835 n2=intbuf_tab(ni)%MSR(n2)
836 n3=intbuf_tab(ni)%MSR(n3)
837 n4=intbuf_tab(ni)%MSR(n4)
838
839 !find first SPMD domain on which the 4 nodes of the surface are
840 proc = intersurfl(n1,n2,n3,n4)
841 intercep(1,ni)%P(k) = proc
842 ENDDO
843
844 ELSEIF (ity==11) THEN
845
846 nrts = ipari(3,ni)
847 nrtm = ipari(4,ni)
848
849C Allocate CEP INTERFACE
850 IF (.NOT.(ASSOCIATED(intercep(1,ni)%P)))THEN
851 ALLOCATE(intercep(1,ni)%P(nrtm))
852 ENDIF
853 IF (.NOT.(ASSOCIATED(intercep(2,ni)%P)))THEN
854 ALLOCATE(intercep(2,ni)%P(nrts))
855 ENDIF
856 intercep(1,ni)%P(1:nrtm)=0
857 intercep(2,ni)%P(1:nrts)=0
858
859 DO k=1,nrtm
860 n1 = intbuf_tab(ni)%IRECTM(2*(k-1)+1)
861 n2 = intbuf_tab(ni)%IRECTM(2*(k-1)+2)
862 !find first SPMD domain on which the 2 nodes of the surface are
863 !use same generic routine with N1=N2 and N3=N4
864 proc = intersurfl(n1,n1,n2,n2)
865 intercep(1,ni)%P(k) = proc
866 ENDDO
867
868 DO k=1,nrts
869 n1 = intbuf_tab(ni)%IRECTS(2*(k-1)+1)
870 n2 = intbuf_tab(ni)%IRECTS(2*(k-1)+2)
871 !find first SPMD domain on which the 2 nodes of the surface are
872 !use same generic routine with N1=N2 and N3=N4
873 proc = intersurfl(n1,n1,n2,n2)
874 intercep(2,ni)%P(k) = proc
875 ENDDO
876
877 !ENDIF INTER TYPE 11
878 ELSEIF (ity==20) THEN
879
880 nrtm = ipari(4,ni)
881 nlins = ipari(51,ni)
882 nlinm = ipari(52,ni)
883
884C Allocate CEP INTERFACE
885 IF (.NOT.(ASSOCIATED(intercep(1,ni)%P)))THEN
886 ALLOCATE(intercep(1,ni)%P(nrtm))
887 ENDIF
888 IF (.NOT.(ASSOCIATED(intercep(2,ni)%P)))THEN
889 ALLOCATE(intercep(2,ni)%P(nlinm))
890 ENDIF
891 IF (.NOT.(ASSOCIATED(intercep(3,ni)%P)))THEN
892 ALLOCATE(intercep(3,ni)%P(nlins))
893 ENDIF
894 intercep(1,ni)%P(1:nrtm) =0
895 intercep(2,ni)%P(1:nlinm)=0
896 intercep(3,ni)%P(1:nlins)=0
897
898 DO k=1,nrtm
899 n1l = intbuf_tab(ni)%IRECTM(4*(k-1)+1)
900 n2l = intbuf_tab(ni)%IRECTM(4*(k-1)+2)
901 n3l = intbuf_tab(ni)%IRECTM(4*(k-1)+3)
902 n4l = intbuf_tab(ni)%IRECTM(4*(k-1)+4)
903 n1 = intbuf_tab(ni)%NLG(n1l)
904 n2 = intbuf_tab(ni)%NLG(n2l)
905 n3 = intbuf_tab(ni)%NLG(n3l)
906 n4 = intbuf_tab(ni)%NLG(n4l)
907 !find first SPMD domain on which the 4 nodes of the surface are
908 proc = intersurfl(n1,n2,n3,n4)
909 intercep(1,ni)%P(k) = proc
910 ENDDO
911
912 DO k=1,nlinm
913 n1l = intbuf_tab(ni)%IXLINM(2*(k-1)+1)
914 n2l = intbuf_tab(ni)%IXLINM(2*(k-1)+2)
915 n1 = intbuf_tab(ni)%NLG(n1l)
916 n2 = intbuf_tab(ni)%NLG(n2l)
917 !find first SPMD domain on which the 2 nodes of the surface are
918 !use same generic routine with N1=N2 and N3=N4
919 proc = intersurfl(n1,n1,n2,n2)
920 intercep(2,ni)%P(k) = proc
921 ENDDO
922
923 DO k=1,nlins
924 n1l = intbuf_tab(ni)%IXLINS(2*(k-1)+1)
925 n2l = intbuf_tab(ni)%IXLINS(2*(k-1)+2)
926 n1 = intbuf_tab(ni)%NLG(n1l)
927 n2 = intbuf_tab(ni)%NLG(n2l)
928 !find first SPMD domain on which the 2 nodes of the surface are
929 !use same generic routine with N1=N2 and N3=N4
930 proc = intersurfl(n1,n1,n2,n2)
931 intercep(3,ni)%P(k) = proc
932 ENDDO
933
934 !ENDIF INTER TYPE 11
935 ELSEIF (ity==21) THEN
936
937 nrts = ipari(3,ni)
938
939C Allocate CEP INTERFACE
940 IF (.NOT.(ASSOCIATED(intercep(1,ni)%P)))THEN
941 ALLOCATE(intercep(1,ni)%P(nrts))
942 ENDIF
943 intercep(1,ni)%P(1:nrts) =0
944
945 DO k=1,nrts
946 n1 = intbuf_tab(ni)%IRECTS(4*(k-1)+1)
947 n2 = intbuf_tab(ni)%IRECTS(4*(k-1)+2)
948 n3 = intbuf_tab(ni)%IRECTS(4*(k-1)+3)
949 n4 = intbuf_tab(ni)%IRECTS(4*(k-1)+4)
950 !find first SPMD domain on which the 4 nodes of the surface are
951 proc = intersurfl(n1,n2,n3,n4)
952 intercep(1,ni)%P(k) = proc
953 ENDDO
954
955 ENDIF !ENDIF INTER TYPE 21
956
957
958 ENDDO !ENDDO 1,NINTER
959