r2r_count.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	r2r_count (passe, iparts, ipartc, ipartg, igrpp_r2r, pm_stack, iworksh, igrnod, igrsurf, igrslin, igrbric, ixs10, ixs20, ixs16)

Function/Subroutine Documentation

r2r_count()

subroutine r2r_count	(	integer	passe,
		integer, dimension(*)	iparts,
		integer, dimension(*)	ipartc,
		integer, dimension(*)	ipartg,
		integer, dimension(2,*)	igrpp_r2r,
			pm_stack,
		integer, dimension(*)	iworksh,
		type (group_), dimension(ngrnod)	igrnod,
		type (surf_), dimension(nsurf)	igrsurf,
		type (surf_), dimension(nslin)	igrslin,
		type (group_), dimension(ngrbric)	igrbric,
		integer, dimension(*)	ixs10,
		integer, dimension(*)	ixs20,
		integer, dimension(*)	ixs16 )

Definition at line 35 of file r2r_count.F.

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