r2r_count.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/.
!||====================================================================
!||    r2r_count      ../starter/source/coupling/rad2rad/r2r_count.F
!||--- called by ------------------------------------------------------
!||    r2r_prelec     ../starter/source/coupling/rad2rad/r2r_prelec.F
!||--- calls      -----------------------------------------------------
!||    incoq3         ../starter/source/interfaces/inter3d1/incoq3.F
!||    insol3         ../starter/source/interfaces/inter3d1/insol3.F
!||--- uses       -----------------------------------------------------
!||    nod2el_mod     ../starter/share/modules1/nod2el_mod.F
!||    r2r_mod        ../starter/share/modules1/r2r_mod.F
!||    restmod        ../starter/share/modules1/restart_mod.F
!||====================================================================
      SUBROUTINE r2r_count(PASSE,IPARTS,
     2           IPARTC,IPARTG,IGRPP_R2R ,PM_STACK , IWORKSH,
     3           IGRNOD,IGRSURF,IGRSLIN,IGRBRIC,IXS10,
     4           IXS20,IXS16)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE restmod
        USE nod2el_mod
        USE r2r_mod
        USE groupdef_mod
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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IPARTS(*),IPARTC(*),IPARTG(*),PASSE,IGRPP_R2R(2,*),
     .     IWORKSH(*),IXS10(*), IXS16(*), IXS20(*)
        my_real
     .    pm_stack(*)
C-----------------------------------------------
        TYPE (GROUP_)  , DIMENSION(NGRNOD)  :: IGRNOD
        TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
        TYPE (SURF_)   , DIMENSION(NSLIN)   :: IGRSLIN
        TYPE (GROUP_)  , DIMENSION(NGRBRIC) :: IGRBRIC
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I,J,L,IP,CUR_ID,CUR_TYP,TAG1,TAG2,COMPT,CCPL
        INTEGER ID_ELC,ID_ELTG,ID_ELS,IRECT(4,1)
        INTEGER CCPL_T4_EXPO,CCPL_T4_IMPO,OFF
        my_real area
C=======================================================================
C---Precounting of nodes/elements/surfaces/lines kept after split-------
C=======================================================================
 
        off = npart + numnod
 
C--------------------------------------------------------------------C
C------Precounting of nb of tagged nodes of GRNOD--------------------C
C--------------------------------------------------------------------C
        DO i=1,ngrnod
 
          compt = 0
          ccpl = 0
          ccpl_t4_expo = 0
          ccpl_t4_impo = 0
          DO j=1,igrnod(i)%NENTITY
            cur_id = igrnod(i)%ENTITY(j)
            IF (tagno(cur_id+npart)>=0) compt=compt+1
            IF (tagno(cur_id+npart)>1) ccpl=ccpl+1
            IF (tagno(cur_id+npart)<=0) ccpl=ccpl+1
            IF ((tagno(cur_id+npart)==2).AND.(tagno(cur_id+off)==-1)) ccpl_t4_impo = ccpl_t4_impo + 1
            IF ((tagno(cur_id+npart)==2).AND.(tagno(cur_id+off)==1))  ccpl_t4_expo = ccpl_t4_expo + 1
          END DO
          igrnod(i)%R2R_ALL   = compt    ! temporary storage before split
          igrnod(i)%R2R_SHARE = ccpl     ! temporary storage before split
          igrpp_r2r(1,i)  = ccpl_t4_expo
          igrpp_r2r(2,i)  = ccpl_t4_impo
        ENDDO
 
C--------------------------------------------------------------------C
C------Precounting of internal and external surfaces of the domain---C
C--------------------------------------------------------------------C
 
        IF (passe==0) THEN
          ALLOCATE(isurf_r2r(5,nsurf))
          DO i=1,nsurf
            compt = 0
            DO j=1,igrsurf(i)%NSEG
              IF (igrsurf(i)%ELTYP(j) == 0) THEN
C    -> case of surfaces defined by segments -> identification of elements attached to segments <--
                DO l=1,4
                  irect(l,1)=igrsurf(i)%NODES(j,l)
                END DO
                CALL insol3(x,irect,ixs,0,id_els,1,
     .               area,0,knod2els,nod2els,0,
     .               ixs10,ixs16,ixs20)
                CALL incoq3(irect,ixc,ixtg ,0,id_elc,
     .               id_eltg,1,geo,pm,knod2elc ,
     .               knod2eltg,nod2elc,nod2eltg,thke,2,igeo,
     .               pm_stack , iworksh)
C    -> temporary storage if element found type in segment type <--
                IF (id_els/=0) THEN
                  igrsurf(i)%ELTYP(j) = 11
                  igrsurf(i)%ELEM(j)  = id_els
                ENDIF
                IF (id_elc/=0) THEN
                  igrsurf(i)%ELTYP(j) = 13
                  igrsurf(i)%ELEM(j)  = id_elc
                ENDIF
                IF (id_eltg/=0) THEN
                  igrsurf(i)%ELTYP(j) = 17
                  igrsurf(i)%ELEM(j)  = id_eltg
                ENDIF
              ENDIF
C    -> counting of segments initially in the domain <--
              cur_id  = igrsurf(i)%ELEM(j)
              cur_typ = igrsurf(i)%ELTYP(j)
              ip = 0
              IF (cur_typ>10) cur_typ=cur_typ-10
              IF (cur_typ==1) ip = iparts(cur_id)
              IF (cur_typ==3) ip = ipartc(cur_id)
              IF (cur_typ==7) ip = ipartg(cur_id)
              IF (ip>0) THEN
                IF (tagno(ip)==1) compt=compt+1
              ENDIF
            END DO
            isurf_r2r(1,i) = 0
            isurf_r2r(2,i) = 0
            isurf_r2r(3,i) = compt
          END DO
        ENDIF
 
C-------At each pass - number of added segments is counted--------------C
 
        DO i=1,nsurf
          compt = 0
          ccpl = 0
          ccpl_t4_expo = 0
          ccpl_t4_impo = 0
          DO j=1,igrsurf(i)%NSEG
            cur_id = igrsurf(i)%ELEM(j)
            cur_typ= igrsurf(i)%ELTYP(j)
            ip = 0
            IF (cur_typ>10) cur_typ=cur_typ-10
            IF (cur_typ==1) ip = iparts(cur_id)
            IF (cur_typ==3) ip = ipartc(cur_id)
            IF (cur_typ==7) ip = ipartg(cur_id)
            IF (ip>0) THEN
              IF (tagno(ip)==0) THEN
                IF (cur_typ==1) ip = tag_els(cur_id+npart)
                IF (cur_typ==3) ip = tag_elc(cur_id+npart)
                IF (cur_typ==7) ip = tag_elg(cur_id+npart)
                IF (ip>0) compt=compt+1
                IF (ip==1) ccpl_t4_impo=ccpl_t4_impo+1
              ELSE
                IF (cur_typ==1) ip = tag_els(cur_id+npart)
                IF (cur_typ==3) ip = tag_elc(cur_id+npart)
                IF (cur_typ==7) ip = tag_elg(cur_id+npart)
                IF (ip>0) ccpl=ccpl+1
                IF (ip==1) ccpl_t4_expo=ccpl_t4_expo+1
              ENDIF
            ENDIF
          END DO
          isurf_r2r(1,i) = isurf_r2r(3,i) + compt
          isurf_r2r(2,i) = isurf_r2r(3,i) - ccpl
          isurf_r2r(4,i) = ccpl_t4_expo
          isurf_r2r(5,i) = ccpl_t4_impo
        END DO
 
C--------------------------------------------------------------------C
C------Precounting of internal and external lines of the domain------C
C--------------------------------------------------------------------C
 
        IF (passe==0) THEN
          ALLOCATE(islin_r2r(2,nslin))
        ENDIF
 
C-------At each pass - number of added lined is counted--------------C
 
        DO i=1,nslin
          compt = 0
          ccpl = 0
          DO j=1,igrslin(i)%NSEG
            tag1 = tagno(igrslin(i)%NODES(j,1)+npart)
            tag2 = tagno(igrslin(i)%NODES(j,2)+npart)
            IF ((tag1==1).AND.(tag2/=-1)) THEN
              compt=compt+1
            ELSEIF ((tag1/=-1).AND.(tag2==1)) THEN
              compt=compt+1
            ELSEIF ((tag1/=-1).AND.(tag2/=-1)) THEN
              ccpl=ccpl+1
            ENDIF
          END DO
 
          islin_r2r(1,i) = compt + ccpl
          islin_r2r(2,i) = compt
        END DO
 
C--------------------------------------------------------------------C
C------Precounting of grbric and external lines of the domain--------C
C--------------------------------------------------------------------C
 
        IF (passe==0) THEN
          ALLOCATE(igrbric_r2r(5,ngrbric))
          DO i=1,ngrbric
            compt = 0
            DO j=1,igrbric(i)%NENTITY
C    -> counting of elements initially in the domain  <--
              cur_id  = igrbric(i)%ENTITY(j)
              IF (tagno(iparts(cur_id))==1) compt=compt+1
            END DO
            igrbric_r2r(1,i) = 0
            igrbric_r2r(2,i) = 0
            igrbric_r2r(3,i) = compt
          END DO
        ENDIF
 
C-------At each pass - number of added elements is counted------------C
 
        DO i=1,ngrbric
          compt = 0
          ccpl = 0
          ccpl_t4_expo = 0
          ccpl_t4_impo = 0
          DO j=1,igrbric(i)%NENTITY
            cur_id  = igrbric(i)%ENTITY(j)
            ip = iparts(cur_id)
            IF (ip>0) THEN
              IF (tagno(ip)==0) THEN
                IF (tag_els(cur_id+npart)>0) compt=compt+1
                IF (tag_els(cur_id+npart)==1) ccpl_t4_impo=ccpl_t4_impo+1
              ELSE
                IF (tag_els(cur_id+npart)>0) ccpl=ccpl+1
                IF (tag_els(cur_id+npart)==1) ccpl_t4_expo=ccpl_t4_expo+1
              ENDIF
            ENDIF
          END DO
          igrbric_r2r(1,i) = igrbric_r2r(3,i) + compt
          igrbric_r2r(2,i) = igrbric_r2r(3,i) - ccpl
          igrbric_r2r(4,i) = ccpl_t4_expo
          igrbric_r2r(5,i) = ccpl_t4_impo
        END DO
 
C-----------
        RETURN
      END SUBROUTINE r2r_count