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 KK, NIN, NI25, ISENS, LENT25, IERROR, ITYP,
106 . ifq, igap, intth, ilev, ivis2,
107 . i_stok_glo, i_stok, i,j, lindmax, nsnr, inacti, nadmsr,
108 . lenadd, mg, l, n, n_old_impact,
109 . p, rsiz(ninter25), isiz(ninter25), sizbufs(nspmd), iadbufr(nspmd+1),
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 my_real
114 . TS, STARTT, STOPT
115 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX2, BUFR, NADD, KADD,
116 . NSLIDE, FR_SLIDE, INDXTOSEND
117C
118 TYPE(real_pointer), DIMENSION(NSPMD,NINTER25) :: RBUFS,RBUFR
119 TYPE(int_pointer) , DIMENSION(NSPMD,NINTER25) :: IBUFS,IBUFR
120
121C rassembler les trois structures + COMM_PATTERN
122 TYPE(mpi_comm_struct) :: COMM_INT
123 TYPE(MPI_COMM_STRUCT) :: COMM_REAL
124 TYPE(MPI_COMM_STRUCT) :: COMM_SIZ
125
126 INTEGER COMM_PATTERN(NSPMD,NINTER25) !COMM_PATTERN(K,NIN) = 1 <=> ISPMD and K have to communicate
127 INTEGER SIZBUFS_GLOB(NSPMD,NINTER25) !number of nodes to send per proc per interf
128 INTEGER SIZBUFR_GLOB(NSPMD,NINTER25) !number of nodes to recv per proc per interf
129 INTEGER NB_TOT
130 INTEGER :: NRTM, NSN
131C-----------------------------------------------
132
133
134
135
136 DO ni25=1,ninter25
137C
138 nin = intlist25(ni25)
139 nsn =ipari(5,nin)
140C
141C Initialisation
142 nsnf = nsn*(jtask-1) / nthread
143 nsnl = nsn*jtask / nthread
144C
145 intbuf_tab(nin)%ISLIDE(4*nsnf+1:4*nsnl)=0
146
147 END DO
148C
149 IF(nspmd > 1)THEN
150 DO ni25=1,ninter25
151 nin = intlist25(ni25)
152 nsnr =ipari(24,nin)
153 nsnrf = 1 + nsnr*(jtask-1) / nthread
154 nsnrl = nsnr*jtask / nthread
155 islide_fi(nin)%P(1:4,nsnrf:nsnrl)=0
156 END DO
157 END IF
158C
159 CALL my_barrier
160C
161C-----------------------------------------------------------------------
162C Secnd node leaving its previous impacted segment ...
163C-----------------------------------------------------------------------
164!$OMP SINGLE
165 DO ni25=1,ninter25
166 nin = intlist25(ni25)
167 ipari(29,nin) = 0
168 END DO
169!$OMP END SINGLE
170
171 DO ni25=1,ninter25
172 nin = intlist25(ni25)
173 CALL i25comp_1(
174 1 ipari ,intbuf_tab(nin),x ,itab ,nin ,
175 2 kinet ,jtask ,nb_dst1(jtask),v ,nsensor ,
176 3 sensor_tab)
177 ENDDO
178C
179 CALL my_barrier
180C
181C-----------------------------------------------------------------------
182!$OMP SINGLE
183 CALL allocate_comm_struct(comm_int,nspmd,ninter25)
184 CALL allocate_comm_struct(comm_real,nspmd,ninter25)
185 CALL allocate_comm_struct(comm_siz,nspmd,ninter25)
186
187C
188 nslidmx=0
189 nadmax =0
190
191 sizbufr_glob(1:nspmd,1:ninter25) = 0
192 sizbufs_glob(1:nspmd,1:ninter25) = 0
193 isiz(1:ninter25) = 0
194 rsiz(1:ninter25) = 0
195
196
197! : remplir COMM_PATTERN tel que COMM_PATTERN(P,NIN) = 1 => comm entre ISPMD et P
198! pour l interface NIN (symmetrie necessaire entre processeurs)
199 comm_pattern(1:nspmd,1:ninter25) = 0
200 DO ni25=1,ninter25
201C
202 nin = intlist25(ni25)
203C
204 ipari(29,nin) = 0
205C
206 DO p = 1,nspmd
207 lent25 = iad_frnor(ni25,p+1)-iad_frnor(ni25,p)
208 IF(p /= ispmd +1 .AND. lent25 /= 0) THEN
209 comm_pattern(p,ni25) = 1
210 ENDIF
211 ENDDO
212 ENDDO
213
214 DO ni25=1,ninter25
215 sizbufs(1:nspmd) = 0
216C
217 nin = intlist25(ni25)
218C
219 ipari(29,nin) = 0
220C
221C STARTT=INTBUF_TAB(NIN)%VARIABLES(3)
222C STOPT =INTBUF_TAB(NIN)%VARIABLES(11)
223C IF(STARTT>TT) CYCLE
224C IF(TT>STOPT) CYCLE
225C
226C Look if interface is activated
227C ISENS = IPARI(64,NIN)
228C IF(ISENS/=0) THEN ! Interface activated by sensor
229C TS = SENSOR_TAB(ISENS)%TSTART
230C ELSE
231C TS = TT
232C ENDIF
233C IF(TT<TS) CYCLE
234C
235C precalculer LENS
236 lent25 = iad_frnor(ni25,nspmd+1)-iad_frnor(ni25,1)
237
238 nsn =ipari(5,nin)
239 nsnr =ipari(24,nin)
240 nadmsr=ipari(67,nin)
241
242 nslidmx =max(nslidmx,nsn+nsnr)
243 nadmax =max(nadmax ,nadmsr)
244
245 END DO
246
247 lent25 = lent25 + nsnt25
248! ALLOCATE(BUFR(LENT25),STAT=IERROR)
249
250C-----------------------------------------------------------------------
251 IF(nspmd == 1) THEN
252
253 ALLOCATE(nadd(1),kadd(1))
254 ALLOCATE(nslide(1),fr_slide(1),indxtosend(1))
255
256 ELSE
257C-----------------------------------------------------------------------
258C SPMD only <=> envoi de nds secnds qui glissent sur un sommet frontire
259C-----------------------------------------------------------------------
260C
261 ALLOCATE(nadd(nadmax+1),stat=ierror)
262 IF(ierror/=0) THEN
263 CALL ancmsg(msgid=20,anmode=aninfo)
264 CALL arret(2)
265 ENDIF
266C
267 ladmax = 4*nslidmx
268 ALLOCATE(kadd(ladmax),stat=ierror)
269 IF(ierror/=0) THEN
270 CALL ancmsg(msgid=20,anmode=aninfo)
271 CALL arret(2)
272 ENDIF
273C
274 DO ni25=1,ninter25
275C
276 nin = intlist25(ni25)
277
278 ipari(29,nin) = 0
279C
280C ==========================================================================
281C Post Asynchronous reception of the sizes
282 CALL spmd_i25_slide_exch(ibufr ,rbufr ,isiz(ni25) ,rsiz(ni25)
283 . ,sizbufr_glob,comm_int,comm_real,comm_siz
284 . ,2 ,ni25, comm_pattern)
285
286C ==========================================================================
287
288C
289 nsn =ipari(5,nin)
290 nsnr =ipari(24,nin)
291 inacti=ipari(22,nin)
292 nadmsr=ipari(67,nin)
293 ilev =ipari(20,nin)
294 igap =ipari(21,nin)
295 ifq =ipari(31,nin)
296 intth =ipari(47,nin)
297 intfric =ipari(72,nin)
298 ivis2 =ipari(14,nin)
299 istif_msdt = ipari(97,nin)
300 ifsub_carea =0
301 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA > 0) ifsub_carea = 1
302 ityp = 25
303C
304C NADD(1:NADMSR+1), KADD <=> liste sky line des noeuds secnd concerns / tous les sommets frontires
305 nadd(1:nadmsr+1)=0
306 CALL i25prep_add(
307 1 nin ,ni25 ,nsn ,nsnr ,itab ,
308 2 nadmsr ,intbuf_tab(nin)%ADMSR ,iad_frnor ,fr_nor ,nadd ,
309 3 kadd ,intbuf_tab(nin)%ISLIDE)
310C
311C compute size of buffer for send
312 CALL i25prep_nindex(
313 1 nin ,ni25 ,nsn ,nsnr ,
314 3 itab ,intbuf_tab(nin)%NSV,iad_frnor,fr_nor ,nadd ,
315 4 kadd ,sizbufs,nsendtot)
316C
317 ALLOCATE(fr_slide(4*nsendtot),indxtosend(nsendtot),stat=ierror)
318 IF(ierror/=0) THEN
319 CALL ancmsg(msgid=20,anmode=aninfo)
320 CALL arret(2)
321 ENDIF
322 fr_slide(1:4*nsendtot)=0
323C
324C compute index of nodes to send to the all domains
325 CALL i25prep_sizbufs(
326 1 nin ,ni25 ,nsn ,nsnr ,ityp ,
327 2 ifq ,inacti ,igap ,intth ,ilev ,
328 3 itab ,intbuf_tab(nin)%NSV,iad_frnor,fr_nor ,nadd ,
329 4 kadd ,rsiz(ni25) ,isiz(ni25),sizbufs,fr_slide ,
330 5 indxtosend,intfric , ivis2 ,istif_msdt,ifsub_carea)
331C
332 DO p=1,nspmd
333 NULLIFY(rbufs(p,ni25)%P)
334 NULLIFY(ibufs(p,ni25)%P)
335 IF(sizbufs(p) > 0) THEN
336 ALLOCATE(rbufs(p,ni25)%P(rsiz(ni25)*sizbufs(p)),stat=ierror)
337 ALLOCATE(ibufs(p,ni25)%P(isiz(ni25)*sizbufs(p)),stat=ierror)
338 ibufs(p,ni25)%P(1:isiz(ni25)*sizbufs(p)) = -1
339 rbufs(p,ni25)%P(1:rsiz(ni25)*sizbufs(p)) = -1
340 ENDIF
341 sizbufs_glob(p,ni25)=sizbufs(p)
342 IF(ierror/=0) THEN
343 CALL ancmsg(msgid=20,anmode=aninfo)
344 CALL arret(2)
345 ENDIF
346 END DO
347
348C ==========================================================================
349C Send sizes
350 CALL spmd_i25_slide_exch(ibufs ,rbufs ,isiz(ni25) ,rsiz(ni25)
351 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
352 . ,0 ,ni25, comm_pattern)
353
354C ==========================================================================
355
356 CALL i25prep_send(
357 1 nin ,ni25 ,nsn ,nsnr ,ityp ,
358 2 ifq ,inacti ,igap ,intth ,ilev ,
359 3 itab ,iad_frnor,fr_nor ,
360 4 lent25 ,nadd ,kadd ,kinet ,
361 5 nodnx_sms ,x ,v ,ms ,temp ,
362 . intbuf_tab(nin) ,rbufs, ibufs,
363 6 rsiz(ni25), isiz(ni25), sizbufs, fr_slide,indxtosend,
364 7 main_proc,intfric ,ivis2 , icodt ,iskew ,
365 8 istif_msdt,ifsub_carea,parameters%INTAREAN)
366
367
368C ==========================================================================
369C Send buffers
370 CALL spmd_i25_slide_exch(ibufs ,rbufs ,isiz(ni25) ,rsiz(ni25)
371 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
372 . ,1 ,ni25, comm_pattern)
373C ==========================================================================
374
375 DEALLOCATE(fr_slide)
376 DEALLOCATE(indxtosend)
377
378
379 END DO ! NI25 = 1:NINTER25
380
381 END IF ! IF(NSPMD > 1)THEN
382C-----------------------------------------------------------------------
383C
384C Decompactage
385 DO ni25=1,ninter25
386C
387 nin = intlist25(ni25)
388
389 ipari(29,nin) = 0
390C
391C Receive buffer ( + wait for sizes)
392 IF(nspmd > 1) THEN
393 CALL spmd_i25_slide_exch(ibufr ,rbufr ,isiz(ni25) ,rsiz(ni25)
394 . ,sizbufr_glob ,comm_int,comm_real,comm_siz
395 . ,3 ,ni25, comm_pattern)
396 ENDIF
397C
398 nrtm =ipari(4,nin)
399 nsn =ipari(5,nin)
400 ivis2 =ipari(14,nin)
401 nsnr =ipari(24,nin)
402 inacti=ipari(22,nin)
403 nadmsr=ipari(67,nin)
404 ilev =ipari(20,nin)
405 igap =ipari(21,nin)
406 ifq =ipari(31,nin)
407 intth =ipari(47,nin)
408 intfric =ipari(72,nin)
409 flagremn =ipari(63,nin)
410 lremnormax =ipari(82,nin)
411 istif_msdt = ipari(97,nin)
412 ifsub_carea =0
413 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA > 0) ifsub_carea = 1
414 ityp = 25
415
416C filtrer => ne garder que les anciens impacts + les candidats au glissement
417 IF(nspmd > 1) THEN
418C Output : Pour cette interface , liste de nds a ajouter a NSNFI
419
420
421C ============================================================================
422C Deux approches possibles:
423C 1 2
424C -Wait toutes les procs (synchro) | - Wait sur une taille
425C -Allocation de XREM/IREM | - Reception dans dans RBUFR/IBUFR
426C -Reception dans XREM/IREM | - Copie de *BUFR -> *REM
427C
428C Ici on teste (2)
429 nb_tot = 0
430 DO p =1,nspmd
431 sizbufs(p) = sizbufr_glob(p,ni25)
432 nb_tot = nb_tot +sizbufs(p)
433 ENDDO
434 IF(ALLOCATED(xrem)) DEALLOCATE(xrem)
435 IF(ALLOCATED(irem)) DEALLOCATE(irem)
436 ALLOCATE(xrem(rsiz(ni25),nb_tot))
437 ALLOCATE(irem(isiz(ni25),nb_tot))
438
439
440 nb_tot = 0
441 DO p = 1,nspmd
442 DO i = 1,sizbufs(p)
443 ! IF(IREM(3,NB_TOT+1) == ISPMD + 1) THEN
444 ! ! If PMAIN is the current processor: adding to local structures
445 ! ! If current proc is PMAIN, then local number is in IREM
446 ! ! i.e. no search necessary
447
448 ! ELSE
449 nb_tot = nb_tot + 1
450 DO j =1,rsiz(ni25)
451 xrem(j,nb_tot) = rbufr(p,ni25)%P((i-1)*rsiz(ni25)+j)
452 ENDDO
453 DO j =1,isiz(ni25)
454 irem(j,nb_tot) = ibufr(p,ni25)%P((i-1)*isiz(ni25)+j)
455 ENDDO
456 ! ENDIF
457 ENDDO
458 ENDDO
459C================================================================================
460
461
462 i_stok_glo = intbuf_tab(nin)%I_STOK(2)
463
464 IF(nspmd > 1) THEN
465C : on ne change pas NSNR dans IPARI depuis SPMD_I25_SLIDE_GAT, donc NSNR n est plus la taille
466C : des structures FI
467C
468 CALL spmd_i25_slide_gat(nsn ,nin, ni25,
469 2 igap ,nsnr ,intth ,ilev, intbuf_tab(nin),
470 3 fr_nor,iad_frnor, sizbufs, itab, h3d_data ,
471 4 intfric,flagremn,lremnormax,nrtm,ivis2 ,
472 5 istif_msdt,ifsub_carea,nodadt_therm)
473 ! Passer intbuftab(nin)
474C : Les noeuds qui glissent de P0 vers P1 et qui sont locaux a P1 se trouvent quand
475C : meme dans la structure frontiere *FI(NIN)%P a la position du proc P1
476C : Soit - remplir les structures locales au lieu des structures *FI directement dans SPMD_I25_SLIDE_GAT
477C : - remplir les structures locales dans une routine a partir des *FI(NIN)%P([P0 ; P1 ; P2 ... ... ])
478C : - Retirer ces NS de XREM et IREM lors de la copie des [IR]BUFR vers [IX]REM
479
480 ipari(24,nin) = nsnr
481 ENDIF
482
483
484
485 END IF
486C
487C add new candidates wrt sliding to CAND_OPT_N, CAND_OPT_E
488 50 CONTINUE
489
490 sizopt = intbuf_tab(nin)%S_CAND_OPT_N
491 i_opt_stok = intbuf_tab(nin)%I_STOK(2)
492 CALL i25prep_slid_2(
493 1 intbuf_tab(nin)%CAND_OPT_N,intbuf_tab(nin)%CAND_OPT_E,nin ,ni25 ,nsn ,
494 2 nsnr ,nrtm ,sizopt ,k_stok ,intbuf_tab(nin)%MSEGLO,
495 3 intbuf_tab(nin)%MSEGTYP24,i_opt_stok ,itab ,intbuf_tab(nin)%IRECTM,nadmsr ,
496 4 intbuf_tab(nin)%ADMSR,intbuf_tab(nin)%ISLIDE,intbuf_tab(nin)%NSV,
497 . intbuf_tab(nin)%KNOR2MSR,intbuf_tab(nin)%NOR2MSR,
498 5 intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%STFM,flagremn,intbuf_tab(nin)%KREMNOR,
499 . intbuf_tab(nin)%REMNOR)
500C
501C Merge NSNFI, etc
502C
503C Upgrade SIZE of CAND_OPT_N, CAND_OPT_E, ...
504C Warning : Arrays are reallocated in UPGRADE_CAND_OPT routine !!!!
505 IF(intbuf_tab(nin)%I_STOK(2)+k_stok > sizopt)THEN
506 CALL upgrade_cand_opt(nin,k_stok,intbuf_tab(nin))
507 GOTO 50
508 END IF
509C
510 intbuf_tab(nin)%I_STOK(2)=i_opt_stok ! == INTBUF_TAB(NIN)%I_STOK(2)+K_STOK
511 IF (debug(3)>=1) THEN
512 nb_dst1(jtask) = nb_dst1(jtask) + k_stok
513 nb_dst2(jtask) = nb_dst2(jtask) - k_stok
514 ENDIF
515
516! !deallocate reception buffer
517 IF(nspmd > 1) THEN
518 CALL spmd_i25_slide_exch(ibufr ,rbufr ,isiz(ni25) ,rsiz(ni25)
519 . ,sizbufr_glob ,comm_int ,comm_real,comm_siz
520 . ,4 ,ni25 ,comm_pattern)
521 END IF
522C
523 ENDDO !Loop on NI
524C-----------------------------------------------------------------------
525 IF(nspmd > 1) THEN
526 DO ni25=1,ninter25
527 nin = intlist25(ni25)
528C
529 ! Wait and deallocate Send buffers
530 CALL spmd_i25_slide_exch(ibufs ,rbufs ,isiz(ni25) ,rsiz(ni25)
531 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
532 . ,5 ,ni25, comm_pattern)
533
534 ENDDO
535 ENDIF
536! DEALLOCATE(BUFR)
537 DEALLOCATE(nadd)
538 DEALLOCATE(kadd)
539
540C
541C-----------------------------------------------------------------------
542 CALL deallocate_comm_struct(comm_int,nspmd,ninter25)
543 CALL deallocate_comm_struct(comm_real,nspmd,ninter25)
544 CALL deallocate_comm_struct(comm_siz,nspmd,ninter25)
545
546
547!$OMP END SINGLE
548
549
550C-----------------------------------------------------------------------
551 RETURN
552 END
553C
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:308
message_mod
Definition message_mod.F:1249
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:889
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31
h3d_mod::h3d_database
Definition h3d_mod.F:435
mpi_commod::mpi_comm_struct
Definition mpi_comm_mod.F:38
upgrade_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48
upgrade_cand_opt
subroutine upgrade_cand_opt(ni, k_stok, intbuf_tab)
Definition upgrade_multimp.F:1124