pornod.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	pornod (geo, ixs, ixq, nodpor, icode, itab, npby, lpby, igeo)

Function/Subroutine Documentation

pornod()

subroutine pornod	(	dimension(npropg,numgeo), intent(inout)	geo,
		integer, dimension(nixs,numels), intent(in)	ixs,
		integer, dimension(nixq,numelq), intent(in)	ixq,
		integer, dimension(*), intent(inout)	nodpor,
		integer, dimension(numnod), intent(in)	icode,
		integer, dimension(numnod), intent(in)	itab,
		integer, dimension(nnpby,*), intent(in)	npby,
		integer, dimension(*), intent(in)	lpby,
		integer, dimension(npropgi,numgeo), intent(in)	igeo )

Definition at line 34 of file pornod.F.

C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is marking and storing nodes related to porous option 
C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
      use element_mod , only : nixs,nixq
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"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),IGEO(NPROPGI,NUMGEO)
      INTEGER,INTENT(IN) :: ICODE(NUMNOD),ITAB(NUMNOD),NPBY(NNPBY,*),LPBY(*)
      INTEGER,INTENT(INOUT) :: NODPOR(*)
      my_real,INTENT(INOUT) :: geo(npropg,numgeo)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER, DIMENSION(NUMNOD) :: ITAG
      INTEGER IG,N,I,J,K,IC,IC1,IC2,IC3,IC4,JWARN,IRB,KRB,P
      INTEGER, DIMENSION(:,:),ALLOCATABLE :: INDEX
      INTEGER IWORK(70000),IT
      CHARACTER(len=nchartitle) :: TITR
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      !--------------------!
      !      TAGGING       !
      !--------------------!
      numpor=0
      DO i=1,numnod
        itag(i)=0
      END DO
C-----------------------------------------------      
      DO ig=1,numgeo
        IF(int(geo(12,ig)) /= 15)cycle !IG
        IF(n2d == 0)THEN
          DO i=1,numels
            IF(ixs(10,i) /= ig)cycle !I
            DO j=2,9
              IF(itag(ixs(j,i)) == 0)itag(ixs(j,i))=ig
            END DO !J=2,9
          END DO ! I=1,NUMELS
        ELSE
          DO i=1,numelq
            IF(ixq(6,i) /= ig)cycle !I
            DO j=2,5
              IF(itag(ixq(j,i)) == 0)itag(ixq(j,i))=ig
            END DO ! J=2,5
          END DO !I=1,NUMELQ
        ENDIF
 
      !--------------------!
      !  COUNT AND STORE   !
      !--------------------!
      n=0
      jwarn=0
      DO i=1,numnod
        IF(itag(i) /= ig)cycle !I
        ic=icode(i)
        ic1=ic/512
        ic2=(ic-512*ic1)/64
        ic3=(ic-512*ic1-64*ic2)/8
        ic4=ic-512*ic1-64*ic2-8*ic3
        IF(n2d == 0)THEN
          IF(ic4 == 7)cycle !I
        ELSE
          IF(ic4 >= 6)cycle !I
        ENDIF
        IF(int(geo(30,ig)) /= 0 .AND. ic1 /= 0)THEN
           jwarn = jwarn+1
           CALL fretitl2(titr,igeo(npropgi-ltitr+1,ig),ltitr)
           CALL ancmsg(msgid=358,msgtype=msgwarning,anmode=aninfo_blind_2,i1=igeo(1,ig),c1=titr,i2=itab(i))
        ENDIF
        n=n+1
        nodpor(numpor+n)=i
      END DO !I=1,NUMNOD
 
      !---------------------------!
      ! Sorting nodes by porosity !
      ! (spmd order)              !
      !---------------------------!
      ALLOCATE(index(n,3))
      DO i=1,n
        index(i,3)=nodpor(numpor+i)
      ENDDO
      IF(n > 0) CALL my_orders(0,iwork,index(1,3),index,n,1)
      DO i=1,n
        it = index(i,1)
        nodpor(numpor+i)=index(it,3)
      ENDDO
      DEALLOCATE(index)
      !-----------------------------------------
      !WARNING HONEYCOMB POROUS MEDIUM PID=',IG
      !-----------------------------------------      
      IF(jwarn > 0) THEN
         CALL fretitl2(titr,igeo(npropgi-ltitr+1,ig),ltitr)
         CALL ancmsg(msgid=359,msgtype=msgwarning,anmode=aninfo,i1=igeo(1,ig),c1=titr,i2=jwarn)
      ENDIF      
      geo(31,ig)=n+.1
      numpor=numpor+n
      irb=int(geo(29,ig))
      IF(irb /= 0)THEN
        k=1
        DO krb=1,nrbykin
          IF(npby(1,krb) == irb)THEN
            geo(33,ig) = krb+ em01
            geo(34,ig) = lpby(k)+em01
          ENDIF
          k=k+npby(2,krb)
        END DO !KRB=1,NRBYKIN
        IF(geo(33,ig) == zero)THEN
          geo(29,ig)=em01
          CALL fretitl2(titr,igeo(npropgi-ltitr+1,ig),ltitr)
          CALL ancmsg(msgid=360,msgtype=msgwarning,anmode=aninfo_blind_1,i1=igeo(1,ig),c1=titr,i2=irb)
        ELSE
        ! main node RB replicate on all procs for SPMD calculation of porosity
          DO p = 1, nspmd
           CALL ifrontplus(irb,p) 
          ENDDO
        ENDIF !IF (GEO(33,IG) == ZERO)
      ENDIF !IF(IRB /= 0)
      END DO !IG=1,NUMGEO
C-----------------------------------------------      
      RETURN