#include "implicit_f.inc"
#include "spmd.inc"
#include "scr05_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "param_c.inc"

Functions/Subroutines
subroutine	spmd_exch_da20 (intbuf_tab, ipari, iad_elem, fr_elem, len20, nbint20, lenr, intlist, nbintc)

Function/Subroutine Documentation

◆ spmd_exch_da20()

subroutine spmd_exch_da20	(	type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(npari,*)	ipari,
		integer, dimension(2,*)	iad_elem,
		integer, dimension(*)	fr_elem,
		integer	len20,
		integer	nbint20,
		integer	lenr,
		integer, dimension(*)	intlist,
		integer	nbintc )

Definition at line 36 of file spmd_exch_da20.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
        USE spmd_comm_world_mod, ONLY : spmd_comm_world
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   M e s s a g e   P a s s i n g
C-----------------------------------------------
#include "spmd.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "scr05_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "task_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IAD_ELEM(2,*),FR_ELEM(*), IPARI(NPARI,*),
     .        INTLIST(*),
     .        NBINTC, LEN20, NBINT20, LENR
 
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
#ifdef MPI
      INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,INDEX, N, MSGOFF,
     .        SIZ,J,K,L,NB_NOD,NBIRECV, II, JJ, NI,INC,
     .        NIN, NLN, LL,IL,IG,
     .        IAD_RECV(NSPMD+1),DEBUT(NSPMD),
     .        STATUS(MPI_STATUS_SIZE),RSTATUS(MPI_STATUS_SIZE,NSPMD),
     .        REQ_R(NSPMD),REQ_S(NSPMD),IRINDEX(NSPMD),
     .        ITAGX(NUMNOD),ISIGN,P
      double precision
     .        rbuf(nbint20*(len20*lenr+nspmd)),
     .        sbuf(nbint20*(len20*lenr+nspmd)),daanc6l(3,6)
      DATA msgoff/172/
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C LEN20 = 1 + 18 + 2  ! (1 : longueur ; 18 : daanc6 et 2 : alphak)
C SIZE = LEN20*NBINT20
C
      loc_proc = ispmd + 1
C
      nbirecv = 0
      l = 1
      iad_recv(1) = 1
      DO i = 1, nspmd
        IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
          siz = nbint20*(len20*(iad_elem(1,i+1)-iad_elem(1,i))+1)
          msgtyp = msgoff 
          nbirecv = nbirecv + 1
          irindex(nbirecv) = i
          CALL mpi_irecv(
     s      rbuf(l),siz,mpi_double_precision,it_spmd(i),msgtyp,
     g      spmd_comm_world,req_r(nbirecv),ierror)
          l = l + siz
        ENDIF
        iad_recv(i+1) = l
        debut(i) = iad_recv(i)
      ENDDO
C
C Pre Traitement interfaces
C
      DO ni = 1, nbintc
        nin = intlist(ni)
        IF(ipari(7,nin)==20)THEN
          nln=ipari(35,nin)
C
          DO i = 1, numnod
            itagx(i) = 0
          ENDDO
#include    "vectorize.inc"
          DO il = 1, nln
            ig = intbuf_tab(nin)%NLG(il)
            itagx(ig) = il
          END DO
C
          DO i = 1, nspmd
            IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
              ll = debut(i)
              sbuf(ll)=0
              l = ll+1
              DO j=iad_elem(1,i),iad_elem(1,i+1)-1
                nod = fr_elem(j)
                IF(itagx(nod)/=0)THEN
                  ii = itagx(nod)
                  sbuf(l) = j+1-iad_elem(1,i)
C ALPHAK(2)
                  sbuf(l+1) =intbuf_tab(nin)%ALPHAK((ii-1)*3+2)
C ALPHAK(3)
                  sbuf(l+2) =intbuf_tab(nin)%ALPHAK((ii-1)*3+3)
                  CALL putdpdaanc(
     .            intbuf_tab(nin)%DAANC6(1+(ii-1)*3*6*2),sbuf(l+3),iresp,inc)
C                 L  = L + 18 car variable en double precision
                  sbuf(ll)  = sbuf(ll)+1
                  l = l + len20
                END IF
              ENDDO
              debut(i) = l
            ENDIF
          ENDDO
        ENDIF
      ENDDO
C
C   echange messages
C
      DO ii = 1, nbirecv
        i = irindex(ii)
        l = iad_recv(i)
        siz = debut(i)-l
        msgtyp = msgoff
        CALL mpi_isend(
     s    sbuf(l),siz,mpi_double_precision,it_spmd(i),msgtyp,
     g    spmd_comm_world,req_s(i),ierror)
      ENDDO
C
C decompactage
C
        CALL mpi_waitall(nbirecv,req_r,rstatus,ierror)
        DO ni = 1, nbintc
          nin = intlist(ni)
          IF(ipari(7,nin)==20)THEN
            nln=ipari(35,nin)
C
c            DO II = 1, NUMNOD
              itagx(1:numnod) = 0
c            ENDDO
#include    "vectorize.inc"
            DO il = 1, nln
              ig = intbuf_tab(nin)%NLG(il)
              itagx(ig) = il
            END DO
C
            DO i=1,nbirecv
 
            p = irindex(i)
            l = iad_recv(p)
 
            nb_nod = nint(rbuf(l))
            l = l + 1
#include    "vectorize.inc"
            DO n = 1, nb_nod
              j = nint(rbuf(l))
              nod = fr_elem(iad_elem(1,p)+j-1)
              ii = itagx(nod)
              if (ii>0)THEN
C ALPHAK(2)
              isign = 1
              IF(intbuf_tab(nin)%ALPHAK((ii-1)*3+2) < zero .OR. rbuf(l+1) <zero)
     *             isign = -1
              intbuf_tab(nin)%ALPHAK((ii-1)*3+2)=isign*
     .                 min(abs(intbuf_tab(nin)%ALPHAK((ii-1)*3+2)),
     .                                       abs(rbuf(l+1)))
C ALPHAK(3)
              intbuf_tab(nin)%ALPHAK((ii-1)*3+3)=min(intbuf_tab(nin)%ALPHAK((ii-1)*3+3),
     .                                       rbuf(l+2))
              CALL getdpdaanc(daanc6l,rbuf(l+3),iresp,inc)
C             L  = L + 18 car variable en double precision
              CALL adddp(intbuf_tab(nin)%DAANC6(1+(ii-1)*3*6*2),daanc6l,18)
              ENDIF
              l = l + len20
            END DO
C Repositionne IAD_RECV pour l'interface suivante
            iad_recv(p)=l
        END DO
          END IF
      END DO
C
C   wait terminaison isend
C
      DO i = 1, nspmd
        IF(iad_elem(1,i+1)-iad_elem(1,i)>0)
     .    CALL mpi_wait(req_s(i),status,ierror)
      ENDDO
C
#endif
      RETURN

OpenRadioss 2025.1.11 OpenRadioss project

Functions/Subroutines

Function/Subroutine Documentation

◆ spmd_exch_da20()