i25_prepare.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/.
!||====================================================================
!||    spmd_i25_prepare   ../engine/source/interfaces/int25/i25_prepare.F
!||--- called by ------------------------------------------------------
!||    resol              ../engine/source/engine/resol.F
!||--- uses       -----------------------------------------------------
!||    intbufdef_mod      ../common_source/modules/interfaces/intbufdef_mod.F90
!||    message_mod        ../engine/share/message_module/message_mod.F
!||    tri7box            ../engine/share/modules/tri7box.F
!||====================================================================
      SUBROUTINE spmd_i25_prepare(MODE,IPARI, INTBUF_TAB,
     *                         IAD_ELEM, FR_ELEM,INTLIST,NBINTC,
     *                         IAD_I25 , SFR_I25, FR_I25)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      USE message_mod
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "assert.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "com04_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER MODE
      INTEGER IPARI(NPARI,*),IAD_ELEM(2,*),FR_ELEM(*),
     *        intlist(*),nbintc,iad_i25(nbintc+1,nspmd), sfr_i25,
     *        fr_i25(*)
      TYPE(intbuf_struct_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER SZFRI25,IAFR25
      INTEGER P,I,J,NI,NIN,NOD,NTY,NSN,SN
      INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
C-----------------------------------------------
C Partie 1, calcul des tailles de FR_I25
C-----------------------------------------------
      ALLOCATE(itag(numnod))
      itag(1:numnod)=0
      IF (mode==1)THEN
 
        szfri25 = 0
      
        DO p = 1, nspmd
          IF(iad_elem(1,p+1)-iad_elem(1,p)>0) THEN
            DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              itag(nod)=1
            ENDDO
            DO ni=1,nbintc
                nin = intlist(ni)
              nty   = ipari(7,nin)
              nsn   = ipari(5,nin)
 
              IF(nty==25) THEN
                DO i=1,nsn
                  sn = intbuf_tab(nin)%NSV(i)
                  IF(itag(sn)==1)THEN
                    szfri25 = szfri25+1
                  ENDIF
                ENDDO
              ENDIF
            ENDDO          
C Flush ITAG to zero again for next CPU
            DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              itag(nod)=0
            ENDDO
          ENDIF
        ENDDO
        sfr_i25=szfri25
      
C-----------------------------------------------
C Partie 2, on remplis FR_I25 et IAD_I25
C-----------------------------------------------
      ELSEIF(mode==2)THEN
        iad_i25(1,1)=1
        iafr25=0
        DO p = 1, nspmd
          IF(iad_elem(1,p+1)-iad_elem(1,p)>0) THEN
            DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              itag(nod)=1
            ENDDO
 
            DO ni=1,nbintc
                iad_i25(ni+1,p)=iad_i25(ni,p)
                nin = intlist(ni)
              nty   = ipari(7,nin)
              nsn   = ipari(5,nin)
 
              IF(nty==25) THEN
                DO i=1,nsn
                  sn = intbuf_tab(nin)%NSV(i)
                  assert(sn > 0)
                  assert(sn <= numnod)
                  IF(itag(sn)==1)THEN     
                    iad_i25(ni+1,p)=iad_i25(ni+1,p)+1
              iafr25 = iafr25 + 1
                    fr_i25(iafr25)=i
                  ENDIF
                ENDDO
              ENDIF
            ENDDO
C Flush ITAG to zero again for next CPU
            DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              itag(nod)=0
            ENDDO
            ELSE
            DO i=2,nbintc+1
                iad_i25(i,p)=iad_i25(1,p)
              ENDDO    
          ENDIF    ! IF(IAD_ELEM(1,P+1)-IAD_ELEM(1,P)>0)
            IF(p<nspmd)iad_i25(1,p+1)=iad_i25(nbintc+1,p)
        ENDDO
      ENDIF
      
 
      DEALLOCATE(itag)
      RETURN
C-----------------------------------------------
      END