i24setnodes.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/.
!||====================================================================
!||    i24setnodes     ../starter/source/interfaces/inter3d1/i24setnodes.F
!||--- called by ------------------------------------------------------
!||    lectur          ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg          ../starter/source/output/message/message.F
!||    ifrontplus      ../starter/source/spmd/node/frontplus.F
!||    intersurfl      ../starter/source/spmd/node/ddtools.F
!||    nlocal          ../starter/source/spmd/node/ddtools.F
!||--- uses       -----------------------------------------------------
!||    front_mod       ../starter/share/modules1/front_mod.f
!||    i7i10splitmod   ../starter/share/modules1/i710split_mod.F
!||    message_mod     ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE i24setnodes(IPARI,INTBUF_TAB,INTERCEP,ITAB,I24MAXNSNE)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------    
      USE message_mod
      USE i7i10splitmod 
      USE front_mod   
      USE intbufdef_mod    
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),ITAB(*),I24MAXNSNE
      TYPE(intersurfp) :: INTERCEP(3,NINTER)
      TYPE(intbuf_struct_) INTBUF_TAB(*)
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 ITY,NRTM,N,IED,N1,N2,N3,N4,NRTSE,NSNE
      INTEGER S1,S2,P1,P2,PP,NEXT,POS
      INTEGER NI,K,I,PROC,KM1(4),KM2(4),PROC0,IEDGE4
      DATA km1/1,2,3,4/
      DATA km2/2,3,4,1/
      INTEGER  INTERSURFL
      EXTERNAL intersurfl             
C--------------------------------------------------------------
      i24maxnsne = 0
      DO ni=1,ninter
 
        ity    = ipari(7,ni) 
        iedge4 = ipari(59,ni)
        IF (ity==24)THEN
 
C First set SECONDARY surface to avoid issues : Same SECONDARY surface not on same
C domain than MAIN surface
          nrtse = ipari(52,ni) 
          nsne  = ipari(55,ni) 
          i24maxnsne = max(i24maxnsne,nsne)
          IF (iedge4 > 0 ) THEN
            IF (.NOT.(ASSOCIATED(intercep(2,ni)%P)))THEN
C             In Type24 INTERCEP(2 gives Edge MPI Domain
              ALLOCATE(intercep(2,ni)%P(nrtse))
            ENDIF    
C 
            DO i=1,nrtse
              n1= intbuf_tab(ni)%IRTSE((i-1)*5+1)
              n2= intbuf_tab(ni)%IRTSE((i-1)*5+2)
              n3= intbuf_tab(ni)%IRTSE((i-1)*5+3)
              n4= intbuf_tab(ni)%IRTSE((i-1)*5+4)
 
                proc = intersurfl(n1,n2,n3,n4)
    
              intercep(2,ni)%P(i)=proc
           ENDDO
          ENDIF
 
 
          nrtm   = ipari(4,ni)
          DO k=1,nrtm    
             proc = intercep(1,ni)%P(k)
             IF(proc==0)THEN
                 CALL ancmsg(msgid=978,
     .                       msgtype=msgerror,
     .                       anmode=anstop,
     .                       i1=ipari(15,ni))
             ELSE
               DO i=1,8
                 n = iabs(intbuf_tab(ni)%NVOISIN((k-1)*8+i))
                 IF(n /=0) THEN              
                  CALL ifrontplus(n,proc)
                 ENDIF
               ENDDO
             END IF
          ENDDO
 
 
        ENDIF
      ENDDO 
      END
 
 
!||====================================================================
!||    secnd_surface_on_domain   ../starter/source/interfaces/inter3d1/i24setnodes.F
!||--- called by ------------------------------------------------------
!||    ipari_l_ini               ../starter/source/restart/ddsplit/ipari_l_ini.F
!||    prepare_split_i24         ../starter/source/restart/ddsplit/inter_tools.F
!||--- uses       -----------------------------------------------------
!||    front_mod                 ../starter/share/modules1/front_mod.F
!||====================================================================
      INTEGER FUNCTION secnd_surface_on_domain(INTERCEP,SE,PROC)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------    
      USE front_mod   
      USE intbufdef_mod    
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(intersurfp)     :: intercep
       INTEGER se,proc
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER next,p
C-----------------------------------------------
      secnd_surface_on_domain = 0
 
      p= intercep%P(2+2*(se-1)+1)
      next=intercep%P(2+2*(se-1)+2) 
 
      IF (p==proc)THEN
         secnd_surface_on_domain = 1
         RETURN
      ENDIF
 
      DO WHILE(p/=proc.AND.next/=-1)
         p=intercep%P(2+2*(next-1)+1)
         next = intercep%P(2+2*(next-1)+2)
      ENDDO
 
      IF(p==proc)THEN
         secnd_surface_on_domain = 1
      ENDIF
      
      RETURN 
 
      END