OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25main_slid.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!|| i25main_slid ../engine/source/interfaces/int25/i25main_slid.F
25!||--- called by ------------------------------------------------------
26!|| inttri ../engine/source/interfaces/intsort/inttri.F
27!||--- calls -----------------------------------------------------
28!|| allocate_comm_struct ../engine/share/modules/mpi_comm_mod.F
29!|| ancmsg ../engine/source/output/message/message.F
30!|| arret ../engine/source/system/arret.F
31!|| deallocate_comm_struct ../engine/share/modules/mpi_comm_mod.F
32!|| i25comp_1 ../engine/source/interfaces/int25/i25comp_1.F
33!|| i25prep_add ../engine/source/interfaces/int25/i25slid.F
34!|| i25prep_nindex ../engine/source/interfaces/int25/i25slid.f
35!|| i25prep_send ../engine/source/interfaces/int25/i25slid.F
36!|| i25prep_sizbufs ../engine/source/interfaces/int25/i25slid.F
37!|| i25prep_slid_2 ../engine/source/interfaces/int25/i25slid.F
38!|| my_barrier ../engine/source/system/machine.F
39!|| spmd_i25_slide_exch ../engine/source/mpi/interfaces/spmd_i25slide.F
40!|| spmd_i25_slide_gat ../engine/source/mpi/interfaces/spmd_i25slide.F
41!|| upgrade_cand_opt ../common_source/interf/upgrade_multimp.F
42!||--- uses -----------------------------------------------------
43!|| h3d_mod ../engine/share/modules/h3d_mod.F
44!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
45!|| message_mod ../engine/share/message_module/message_mod.F
46!|| mpi_commod ../engine/share/modules/mpi_comm_mod.F
47!|| parameters_mod ../common_source/modules/interfaces/parameters_mod.F
48!|| sensor_mod ../common_source/modules/sensor_mod.F90
49!|| tri7box ../engine/share/modules/tri7box.F
50!||====================================================================
51 SUBROUTINE i25main_slid(
52 1 IPARI ,IAD_ELEM ,FR_ELEM ,ITAB ,SENSOR_TAB,
53 2 NSENSOR ,INTLIST25,INTBUF_TAB ,IAD_FRNOR,FR_NOR ,
54 3 X ,V ,MS ,TEMP ,KINET ,
55 4 NODNX_SMS,JTASK ,NB_DST2, MAIN_PROC,
56 5 NEWFRONT ,ISENDTO ,IRCVFROM ,NBINTC,
57 6 INTLIST ,ISLEN7 ,IRLEN7 ,IRLEN7T ,ISLEN7T,
58 7 NB_DST1 ,H3D_DATA, ICODT, ISKEW,PARAMETERS,NODADT_THERM)
59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE message_mod
63 USE tri7box
64 USE intbufdef_mod
65 USE mpi_commod
66 USE h3d_mod
67 USE sensor_mod
68 USE parameters_mod
69C-----------------------------------------------
70C I m p l i c i t T y p e s
71C-----------------------------------------------
72#include "implicit_f.inc"
73#include "comlock.inc"
74C-----------------------------------------------
75C C o m m o n B l o c k s
76C-----------------------------------------------
77#include "com01_c.inc"
78#include "com04_c.inc"
79#include "param_c.inc"
80#include "spmd_c.inc"
81#include "task_c.inc"
82#include "warn_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER ,INTENT(IN) :: NSENSOR
87 INTEGER ,INTENT(IN) :: NODADT_THERM
88 INTEGER IPARI(NPARI,*), ITAB(*), INTLIST25(*), JTASK,
89 . IAD_ELEM(2,*) ,FR_ELEM(*), IAD_FRNOR(NINTER25,NSPMD+1), FR_NOR(*),
90 . KINET(*), NODNX_SMS(*), NB_DST1(PARASIZ), NB_DST2(PARASIZ)
91 INTEGER, INTENT(IN) :: ICODT(*),ISKEW(*)
92 my_real :: X(3,*), V(3,*), MS(*), TEMP(*)
93 TYPE(intbuf_struct_),DIMENSION(NINTER) :: INTBUF_TAB
94 INTEGER MAIN_PROC(NUMNOD)
95 INTEGER NBINTC,ISLEN7,IRLEN7,
96 . IRLEN7T,ISLEN7T,
97 . NEWFRONT(*), INTLIST(*),
98 . isendto(ninter+1,*) ,ircvfrom(ninter+1,*)
99 TYPE(h3d_database) :: H3D_DATA
100 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
101 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
102C-----------------------------------------------
103C L o c a l V a r i a b l e s
104C-----------------------------------------------
105 INTEGER NIN, NI25, LENT25, IERROR, ITYP,
106 . ifq, igap, intth, ilev, ivis2,
107 . i_stok_glo, i,j, nsnr, inacti, nadmsr,
108 . n_old_impact,
109 . p, rsiz(ninter25), isiz(ninter25), sizbufs(nspmd),
110 . nadmax, ladmax, nslidmx, nsendtot, nsnf, nsnl, nsnrf, nsnrl,intfric ,
111 . flagremn, lremnormax, istif_msdt, ifsub_carea
112 INTEGER SIZOPT, K_STOK, I_OPT_STOK
113 INTEGER, DIMENSION(:), ALLOCATABLE :: NADD, KADD,
114 . NSLIDE, FR_SLIDE, INDXTOSEND
115C
116 TYPE(real_pointer), DIMENSION(NSPMD,NINTER25) :: RBUFS,RBUFR
117 TYPE(int_pointer) , DIMENSION(NSPMD,NINTER25) :: IBUFS,IBUFR
118
119C Gather the three structures + comm_pattern
120 TYPE(mpi_comm_struct) :: COMM_INT
121 TYPE(MPI_COMM_STRUCT) :: COMM_REAL
122 TYPE(MPI_COMM_STRUCT) :: COMM_SIZ
123
124 INTEGER COMM_PATTERN(NSPMD,NINTER25) !COMM_PATTERN(K,NIN) = 1 <=> ISPMD and K have to communicate
125 INTEGER SIZBUFS_GLOB(NSPMD,NINTER25) !number of nodes to send per proc per interf
126 INTEGER SIZBUFR_GLOB(NSPMD,NINTER25) !number of nodes to recv per proc per interf
127 INTEGER NB_TOT
128 INTEGER :: NRTM, NSN
129C-----------------------------------------------
130
131
132
133
134 DO ni25=1,ninter25
135C
136 nin = intlist25(ni25)
137 nsn =ipari(5,nin)
138C
139C Initialisation
140 nsnf = nsn*(jtask-1) / nthread
141 nsnl = nsn*jtask / nthread
142C
143 intbuf_tab(nin)%ISLIDE(4*nsnf+1:4*nsnl)=0
144
145 END DO
146C
147 IF(nspmd > 1)THEN
148 DO ni25=1,ninter25
149 nin = intlist25(ni25)
150 nsnr =ipari(24,nin)
151 nsnrf = 1 + nsnr*(jtask-1) / nthread
152 nsnrl = nsnr*jtask / nthread
153 islide_fi(nin)%P(1:4,nsnrf:nsnrl)=0
154 END DO
155 END IF
156C
157 CALL my_barrier
158C
159C-----------------------------------------------------------------------
160C Second node leaving its previous impacted segment ...
161C-----------------------------------------------------------------------
162!$OMP SINGLE
163 DO ni25=1,ninter25
164 nin = intlist25(ni25)
165 ipari(29,nin) = 0
166 END DO
167!$OMP END SINGLE
168
169 DO ni25=1,ninter25
170 nin = intlist25(ni25)
171 CALL i25comp_1(
172 1 ipari ,intbuf_tab(nin),x ,itab ,nin ,
173 2 kinet ,jtask ,nb_dst1(jtask),v ,nsensor ,
174 3 sensor_tab)
175 ENDDO
176C
177 CALL my_barrier
178C
179C-----------------------------------------------------------------------
180!$OMP SINGLE
181 CALL allocate_comm_struct(comm_int,nspmd,ninter25)
182 CALL allocate_comm_struct(comm_real,nspmd,ninter25)
183 CALL allocate_comm_struct(comm_siz,nspmd,ninter25)
184
185C
186 nslidmx=0
187 nadmax =0
188
189 sizbufr_glob(1:nspmd,1:ninter25) = 0
190 sizbufs_glob(1:nspmd,1:ninter25) = 0
191 isiz(1:ninter25) = 0
192 rsiz(1:ninter25) = 0
193
194
195! : fill comm_pattern such that comm_pattern(p, nin) = 1 => comm between ispmd and p
196! For the NIN interface (necessary symmetry between processors)
197 comm_pattern(1:nspmd,1:ninter25) = 0
198 DO ni25=1,ninter25
199C
200 nin = intlist25(ni25)
201C
202 ipari(29,nin) = 0
203C
204 DO p = 1,nspmd
205 lent25 = iad_frnor(ni25,p+1)-iad_frnor(ni25,p)
206 IF(p /= ispmd +1 .AND. lent25 /= 0) THEN
207 comm_pattern(p,ni25) = 1
208 ENDIF
209 ENDDO
210 ENDDO
211
212 DO ni25=1,ninter25
213 sizbufs(1:nspmd) = 0
214C
215 nin = intlist25(ni25)
216C
217 ipari(29,nin) = 0
218C
219C STARTT=INTBUF_TAB(NIN)%VARIABLES(3)
220C STOPT =INTBUF_TAB(NIN)%VARIABLES(11)
221C IF(STARTT>TT) CYCLE
222C IF(TT>STOPT) CYCLE
223C
224C Look if interface is activated
225C ISENS = IPARI(64,NIN)
226C IF(ISENS/=0) THEN ! Interface activated by sensor
227C TS = SENSOR_TAB(ISENS)%TSTART
228C ELSE
229C TS = TT
230C ENDIF
231C IF(TT<TS) CYCLE
232C
233C precalculer LENS
234 lent25 = iad_frnor(ni25,nspmd+1)-iad_frnor(ni25,1)
235
236 nsn =ipari(5,nin)
237 nsnr =ipari(24,nin)
238 nadmsr=ipari(67,nin)
239
240 nslidmx =max(nslidmx,nsn+nsnr)
241 nadmax =max(nadmax ,nadmsr)
242
243 END DO
244
245 lent25 = lent25 + nsnt25
246! ALLOCATE(BUFR(LENT25),STAT=IERROR)
247
248C-----------------------------------------------------------------------
249 IF(nspmd == 1) THEN
250
251 ALLOCATE(nadd(1),kadd(1))
252 ALLOCATE(nslide(1),fr_slide(1),indxtosend(1))
253
254 ELSE
255C-----------------------------------------------------------------------
256C spmd only <=> sending secondary nodes that slide on a boundary vertex
257C-----------------------------------------------------------------------
258C
259 ALLOCATE(nadd(nadmax+1),stat=ierror)
260 IF(ierror/=0) THEN
261 CALL ancmsg(msgid=20,anmode=aninfo)
262 CALL arret(2)
263 ENDIF
264C
265 ladmax = 4*nslidmx
266 ALLOCATE(kadd(ladmax),stat=ierror)
267 IF(ierror/=0) THEN
268 CALL ancmsg(msgid=20,anmode=aninfo)
269 CALL arret(2)
270 ENDIF
271C
272 DO ni25=1,ninter25
273C
274 nin = intlist25(ni25)
275
276 ipari(29,nin) = 0
277C
278C ==========================================================================
279C Post Asynchronous reception of the sizes
280 CALL spmd_i25_slide_exch(ibufr ,rbufr ,isiz(ni25) ,rsiz(ni25)
281 . ,sizbufr_glob,comm_int,comm_real,comm_siz
282 . ,2 ,ni25, comm_pattern)
283
284C ==========================================================================
285
286C
287 nsn =ipari(5,nin)
288 nsnr =ipari(24,nin)
289 inacti=ipari(22,nin)
290 nadmsr=ipari(67,nin)
291 ilev =ipari(20,nin)
292 igap =ipari(21,nin)
293 ifq =ipari(31,nin)
294 intth =ipari(47,nin)
295 intfric =ipari(72,nin)
296 ivis2 =ipari(14,nin)
297 istif_msdt = ipari(97,nin)
298 ifsub_carea =0
299 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA > 0) ifsub_carea = 1
300 ityp = 25
301C
302C Nadd (1: Nadmsr+1), Kadd <=> Sky Line list of the send nodes concerns / All the Sommets Frontiers
303 nadd(1:nadmsr+1)=0
304 CALL i25prep_add(
305 1 nin ,ni25 ,nsn ,nsnr ,itab ,
306 2 nadmsr ,intbuf_tab(nin)%ADMSR ,iad_frnor ,fr_nor ,nadd ,
307 3 kadd ,intbuf_tab(nin)%ISLIDE)
308C
309C compute size of buffer for send
310 CALL i25prep_nindex(
311 1 nin ,ni25 ,nsn ,nsnr ,
312 3 itab ,intbuf_tab(nin)%NSV,iad_frnor,fr_nor ,nadd ,
313 4 kadd ,sizbufs,nsendtot)
314C
315 ALLOCATE(fr_slide(4*nsendtot),indxtosend(nsendtot),stat=ierror)
316 IF(ierror/=0) THEN
317 CALL ancmsg(msgid=20,anmode=aninfo)
318 CALL arret(2)
319 ENDIF
320 fr_slide(1:4*nsendtot)=0
321C
322C compute index of nodes to send to the all domains
323 CALL i25prep_sizbufs(
324 1 nin ,ni25 ,nsn ,nsnr ,ityp ,
325 2 ifq ,inacti ,igap ,intth ,ilev ,
326 3 itab ,intbuf_tab(nin)%NSV,iad_frnor,fr_nor ,nadd ,
327 4 kadd ,rsiz(ni25) ,isiz(ni25),sizbufs,fr_slide ,
328 5 indxtosend,intfric , ivis2 ,istif_msdt,ifsub_carea)
329C
330 DO p=1,nspmd
331 NULLIFY(rbufs(p,ni25)%P)
332 NULLIFY(ibufs(p,ni25)%P)
333 IF(sizbufs(p) > 0) THEN
334 ALLOCATE(rbufs(p,ni25)%P(rsiz(ni25)*sizbufs(p)),stat=ierror)
335 ALLOCATE(ibufs(p,ni25)%P(isiz(ni25)*sizbufs(p)),stat=ierror)
336 ibufs(p,ni25)%P(1:isiz(ni25)*sizbufs(p)) = -1
337 rbufs(p,ni25)%P(1:rsiz(ni25)*sizbufs(p)) = -1
338 ENDIF
339 sizbufs_glob(p,ni25)=sizbufs(p)
340 IF(ierror/=0) THEN
341 CALL ancmsg(msgid=20,anmode=aninfo)
342 CALL arret(2)
343 ENDIF
344 END DO
345
346C ==========================================================================
347C Send sizes
348 CALL spmd_i25_slide_exch(ibufs ,rbufs ,isiz(ni25) ,rsiz(ni25)
349 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
350 . ,0 ,ni25, comm_pattern)
351
352C ==========================================================================
353
354 CALL i25prep_send(
355 1 nin ,ni25 ,nsn ,nsnr ,ityp ,
356 2 ifq ,inacti ,igap ,intth ,ilev ,
357 3 itab ,iad_frnor,fr_nor ,
358 4 lent25 ,nadd ,kadd ,kinet ,
359 5 nodnx_sms ,x ,v ,ms ,temp ,
360 . intbuf_tab(nin) ,rbufs, ibufs,
361 6 rsiz(ni25), isiz(ni25), sizbufs, fr_slide,indxtosend,
362 7 main_proc,intfric ,ivis2 , icodt ,iskew ,
363 8 istif_msdt,ifsub_carea,parameters%INTAREAN)
364
365
366C ==========================================================================
367C Send buffers
368 CALL spmd_i25_slide_exch(ibufs ,rbufs ,isiz(ni25) ,rsiz(ni25)
369 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
370 . ,1 ,ni25, comm_pattern)
371C ==========================================================================
372
373 DEALLOCATE(fr_slide)
374 DEALLOCATE(indxtosend)
375
376
377 END DO ! NI25 = 1:NINTER25
378
379 END IF ! IF(NSPMD > 1)THEN
380C-----------------------------------------------------------------------
381C
382C Decompactage
383 DO ni25=1,ninter25
384C
385 nin = intlist25(ni25)
386
387 ipari(29,nin) = 0
388C
389C Receive buffer ( + wait for sizes)
390 IF(nspmd > 1) THEN
391 CALL spmd_i25_slide_exch(ibufr ,rbufr ,isiz(ni25) ,rsiz(ni25)
392 . ,sizbufr_glob ,comm_int,comm_real,comm_siz
393 . ,3 ,ni25, comm_pattern)
394 ENDIF
395C
396 nrtm =ipari(4,nin)
397 nsn =ipari(5,nin)
398 ivis2 =ipari(14,nin)
399 nsnr =ipari(24,nin)
400 inacti=ipari(22,nin)
401 nadmsr=ipari(67,nin)
402 ilev =ipari(20,nin)
403 igap =ipari(21,nin)
404 ifq =ipari(31,nin)
405 intth =ipari(47,nin)
406 intfric =ipari(72,nin)
407 flagremn =ipari(63,nin)
408 lremnormax =ipari(82,nin)
409 istif_msdt = ipari(97,nin)
410 ifsub_carea =0
411 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA > 0) ifsub_carea = 1
412 ityp = 25
413
414C filter => keep only old impacts + candidates for sliding
415 IF(nspmd > 1) THEN
416C output: for this interface, list of nodes to add to nsnfi
417
418
419C ============================================================================
420C Two possible approaches:
421C 1 2
422C wait for all procs (sync) | wait on a size
423C allocation of xrem/irem | reception in rbufr/ibufr
424C reception in xrem/irem | copy from *bufr to *rem
425C
426C Ici on teste (2)
427 nb_tot = 0
428 DO p =1,nspmd
429 sizbufs(p) = sizbufr_glob(p,ni25)
430 nb_tot = nb_tot +sizbufs(p)
431 ENDDO
432 IF(ALLOCATED(xrem)) DEALLOCATE(xrem)
433 IF(ALLOCATED(irem)) DEALLOCATE(irem)
434 ALLOCATE(xrem(rsiz(ni25),nb_tot))
435 ALLOCATE(irem(isiz(ni25),nb_tot))
436
437
438 nb_tot = 0
439 DO p = 1,nspmd
440 DO i = 1,sizbufs(p)
441 ! IF(IREM(3,NB_TOT+1) == ISPMD + 1) THEN
442 ! ! If PMAIN is the current processor: adding to local structures
443 ! ! If current proc is PMAIN, then local number is in IREM
444 ! ! i.e. no search necessary
445
446 ! ELSE
447 nb_tot = nb_tot + 1
448 DO j =1,rsiz(ni25)
449 xrem(j,nb_tot) = rbufr(p,ni25)%P((i-1)*rsiz(ni25)+j)
450 ENDDO
451 DO j =1,isiz(ni25)
452 irem(j,nb_tot) = ibufr(p,ni25)%P((i-1)*isiz(ni25)+j)
453 ENDDO
454 ! ENDIF
455 ENDDO
456 ENDDO
457C================================================================================
458
459
460 i_stok_glo = intbuf_tab(nin)%I_STOK(2)
461
462 IF(nspmd > 1) THEN
463C : we do not change nsnr in iPari since SPMD_I25_Slide_gat, so nsnr is no longer the size
464C of fi structures
465C
466 CALL spmd_i25_slide_gat(nsn ,nin, ni25,
467 2 igap ,nsnr ,intth ,ilev, intbuf_tab(nin),
468 3 fr_nor,iad_frnor, sizbufs, itab, h3d_data ,
469 4 intfric,flagremn,lremnormax,nrtm,ivis2 ,
470 5 istif_msdt,ifsub_carea,nodadt_therm)
471 ! Passer intbuftab(nin)
472C nodes that slide from p0 to p1 and are local to p1 are found when
473C even in the boundary structure *fi(nin)%p at the position of proc p1
474C either - fill the local structures instead of the *fi structures directly in spmd_i25_slide_gat
475C - fill the local structures in a routine from *fi(nin)%p([p0 ; p1 ; p2 ... ... ])
476C - remove these ns from xrem and irem when copying from [ir]bufr to [ix]rem
477
478 ipari(24,nin) = nsnr
479 ENDIF
480
481
482
483 END IF
484C
485C add new candidates wrt sliding to CAND_OPT_N, CAND_OPT_E
486 50 CONTINUE
487
488 sizopt = intbuf_tab(nin)%S_CAND_OPT_N
489 i_opt_stok = intbuf_tab(nin)%I_STOK(2)
490 CALL i25prep_slid_2(
491 1 intbuf_tab(nin)%CAND_OPT_N,intbuf_tab(nin)%CAND_OPT_E,nin ,ni25 ,nsn ,
492 2 nsnr ,nrtm ,sizopt ,k_stok ,intbuf_tab(nin)%MSEGLO,
493 3 intbuf_tab(nin)%MSEGTYP24,i_opt_stok ,itab ,intbuf_tab(nin)%IRECTM,nadmsr ,
494 4 intbuf_tab(nin)%ADMSR,intbuf_tab(nin)%ISLIDE,intbuf_tab(nin)%NSV,
495 . intbuf_tab(nin)%KNOR2MSR,intbuf_tab(nin)%NOR2MSR,
496 5 intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%STFM,flagremn,intbuf_tab(nin)%KREMNOR,
497 . intbuf_tab(nin)%REMNOR)
498C
499C Merge NSNFI, etc
500C
501C Upgrade SIZE of CAND_OPT_N, CAND_OPT_E, ...
502C Warning : Arrays are reallocated in UPGRADE_CAND_OPT routine !!!!
503 IF(intbuf_tab(nin)%I_STOK(2)+k_stok > sizopt)THEN
504 CALL upgrade_cand_opt(nin,k_stok,intbuf_tab(nin))
505 GOTO 50
506 END IF
507C
508 intbuf_tab(nin)%I_STOK(2)=i_opt_stok ! == INTBUF_TAB(NIN)%I_STOK(2)+K_STOK
509 IF (debug(3)>=1) THEN
510 nb_dst1(jtask) = nb_dst1(jtask) + k_stok
511 nb_dst2(jtask) = nb_dst2(jtask) - k_stok
512 ENDIF
513
514! !deallocate reception buffer
515 IF(nspmd > 1) THEN
516 CALL spmd_i25_slide_exch(ibufr ,rbufr ,isiz(ni25) ,rsiz(ni25)
517 . ,sizbufr_glob ,comm_int ,comm_real,comm_siz
518 . ,4 ,ni25 ,comm_pattern)
519 END IF
520C
521 ENDDO !Loop on NI
522C-----------------------------------------------------------------------
523 IF(nspmd > 1) THEN
524 DO ni25=1,ninter25
525 nin = intlist25(ni25)
526C
527 ! Wait and deallocate Send buffers
528 CALL spmd_i25_slide_exch(ibufs ,rbufs ,isiz(ni25) ,rsiz(ni25)
529 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
530 . ,5 ,ni25, comm_pattern)
531
532 ENDDO
533 ENDIF
534! DEALLOCATE(BUFR)
535 DEALLOCATE(nadd)
536 DEALLOCATE(kadd)
537
538C
539C-----------------------------------------------------------------------
540 CALL deallocate_comm_struct(comm_int,nspmd,ninter25)
541 CALL deallocate_comm_struct(comm_real,nspmd,ninter25)
542 CALL deallocate_comm_struct(comm_siz,nspmd,ninter25)
543
544
545!$OMP END SINGLE
546
547
548C-----------------------------------------------------------------------
549 RETURN
550 END
551C
i25comp_1
subroutine i25comp_1(ipari, intbuf_tab, x, itab, nin, kinet, jtask, nb_dst1, v, nsensor, sensor_tab)
Definition i25comp_1.F:41
i25main_slid
subroutine i25main_slid(ipari, iad_elem, fr_elem, itab, sensor_tab, nsensor, intlist25, intbuf_tab, iad_frnor, fr_nor, x, v, ms, temp, kinet, nodnx_sms, jtask, nb_dst2, main_proc, newfront, isendto, ircvfrom, nbintc, intlist, islen7, irlen7, irlen7t, islen7t, nb_dst1, h3d_data, icodt, iskew, parameters, nodadt_therm)
Definition i25main_slid.F:59
i25prep_add
subroutine i25prep_add(nin, ni25, nsn, nsnr, itab, nadmsr, admsr, iad_frnor, fr_nor, nadd, kadd, islide)
Definition i25slid.F:34
i25prep_nindex
subroutine i25prep_nindex(nin, ni25, nsn, nsnr, itab, nsv, iad_frnor, fr_nor, nadd, kadd, sizbufs, nsendtot)
Definition i25slid.F:720
i25prep_slid_2
subroutine i25prep_slid_2(cand_n, cand_e, nin, ni25, nsn, nsnr, nrtm, sizopt, k_stok, mseglo, msegtyp, i_stok_opt, itab, irect, nadmsr, admsr, islide, nsv, knor2msr, nor2msr, irtlm, stfm, flagremn, kremnor, remnor)
Definition i25slid.F:391
i25prep_send
subroutine i25prep_send(nin, ni25, nsn, nsnr, ityp, ifq, inacti, igap, intth, ilev, itab, iad_frnor, fr_nor, lens, nadd, kadd, kinet, nodnx_sms, x, v, ms, temp, intbuf_tab, rbuf, ibuf, rsiz, isiz, sizbufs, fr_slide, index, main_proc, intfric, ivis2, icodt, iskew, istif_msdt, ifsub_carea, intarean)
Definition i25slid.F:960
i25prep_sizbufs
subroutine i25prep_sizbufs(nin, ni25, nsn, nsnr, ityp, ifq, inacti, igap, intth, ilev, itab, nsv, iad_frnor, fr_nor, nadd, kadd, rsiz, isiz, sizbufs, fr_slide, index, intfric, ivis2, istif_msdt, ifsub_carea)
Definition i25slid.F:803
max
#define max(a, b)
Definition macros.h:21
allocate_comm_struct
subroutine allocate_comm_struct(object, s1, s2)
Definition mpi_comm_mod.F:63
deallocate_comm_struct
subroutine deallocate_comm_struct(object, s1, s2)
Definition mpi_comm_mod.F:84
h3d_mod
Definition h3d_mod.F:311
message_mod
Definition message_mod.F:1257
mpi_commod
Definition mpi_comm_mod.F:37
parameters_mod
Definition parameters_mod.F:49
tri7box::islide_fi
type(int_pointer2), dimension(:), allocatable islide_fi
Definition tri7box.F:547
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
spmd_i25_slide_exch
subroutine spmd_i25_slide_exch(ibuf, rbuf, isiz, rsiz, nb, comm_int, comm_real, comm_siz, mode, nin, comm_pattern)
Definition spmd_i25slide.F:37
spmd_i25_slide_gat
subroutine spmd_i25_slide_gat(nsn, nin, ni25, igap, nsnr, intth, ilev, intbuf_tab, fr_nor, iad_frnor, nb_slid, itab, h3d_data, intfric, flagremn, lremnormax, nrtm, ivis2, istif_msdt, ifsub_carea, nodadt_therm)
Definition spmd_i25slide.F:252
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
arret
subroutine arret(nn)
Definition arret.F:86
my_barrier
subroutine my_barrier
Definition machine.F:31
h3d_mod::h3d_database
Definition h3d_mod.F:438
mpi_commod::mpi_comm_struct
Definition mpi_comm_mod.F:38
upgrade_cand_opt
subroutine upgrade_cand_opt(ni, k_stok, intbuf_tab)
Definition upgrade_multimp.F:1124