c_irbe2.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
 
!||====================================================================
!||    c_irbe2        ../starter/source/restart/ddsplit/c_irbe2.F
!||--- called by ------------------------------------------------------
!||    ddsplit        ../starter/source/restart/ddsplit/ddsplit.F
!||--- calls      -----------------------------------------------------
!||    nlocal         ../starter/source/spmd/node/ddtools.F
!||    plist_ifront   ../starter/source/spmd/node/ddtools.F
!||====================================================================
      SUBROUTINE c_irbe2(IRBE2,LRBE2,PROC  ,NRBE2_L,
     .                   SLMN_L ,NBDDRBE2)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------  
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER PROC, NRBE2_L,SLMN_L,NBDDRBE2,
     .        irbe2(nrbe2l,*), lrbe2(*)
C-----------------------------------------------
C   F u n c t i o n
C-----------------------------------------------
      INTEGER  NLOCAL
      EXTERNAL nlocal
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, K, NSN, ILP, N,P,M,NS,PROC1,SPLIST,SLMN_L0
      INTEGER,DIMENSION(:), ALLOCATABLE :: MAIN_NODES,TAG,PLIST
 
C-----------------------------------------------
      ALLOCATE(main_nodes(nrbe2))
      ALLOCATE(tag(numnod))
      ALLOCATE(plist(nspmd))
! ------------------------
C
C
C NRBE2_L : Same initialization done in ddsplit
C           but cleaner to have it here once again.
C
      nrbe2_l = 0
C
      proc1 = proc + 1
      slmn_l = 0
      nbddrbe2 = 0
      DO i = 1, nrbe2
        nsn = irbe2(5,i)
        k = irbe2(1,i)
        m = irbe2(3,i)
C----- only remove zero NSN (global) one to work the output(H3d)
        IF (nsn==0) cycle
        DO j = 1, nsn
         ns = lrbe2(k+j)
         IF(nlocal(ns,proc1)==1) slmn_l = slmn_l + 1
        ENDDO
C-----remove local nsn_l=0 will get spmd issue in engine (M in front)
        IF (nlocal(m,proc1)==1)THEN
          nrbe2_l = nrbe2_l+1
C Stacking Main nodes.
          main_nodes(nrbe2_l)=m
        END IF
      ENDDO
C
C Memory optimization - avoid NSPMD*NUMNOD array.
C Fill a list with all RBE2 Main present on one domain
C The issue, Main Nodes can appear twice, but one wants to 
C have it only one time.
C One NUMNOD array is acceptable, other treatments in DDSPLIT take more.
C
      tag(1:numnod)=0
C
      DO i=1,nrbe2_l
         m=main_nodes(i)
 
         IF(tag(m)==0)THEN
           tag(m)=1
 
C          List of All domains where M is sticked
           CALL plist_ifront(plist,m,splist)
           DO p=1,splist
              IF( plist(p) /= proc1)THEN
                 nbddrbe2 = nbddrbe2 + 1
              ENDIF
           ENDDO
         ENDIF
      ENDDO 
C --------------------------------
      DEALLOCATE(main_nodes)
      DEALLOCATE(tag)
C --------------------------------
      RETURN
      END