iniphase.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	iniphase (n2d, numels, numeltg, numelq, numnod, ngroup, ixs, ipart_, iphase, idp, kvol, nuparam, uparam, ntrace, itagnsol, isolnod, part_fill, nbip, nbsubmat, mlw, elbuf_tab, ng, multi_fvm, ixq, ixtg, ityp, nel)

Function/Subroutine Documentation

iniphase()

subroutine iniphase	(	integer, intent(in)	n2d,
		integer, intent(in)	numels,
		integer, intent(in)	numeltg,
		integer, intent(in)	numelq,
		integer, intent(in)	numnod,
		integer, intent(in)	ngroup,
		integer, dimension(nixs,numels)	ixs,
		integer, dimension(*)	ipart_,
		integer, dimension(nbsubmat+1,*)	iphase,
		integer	idp,
			kvol,
		integer	nuparam,
			uparam,
		integer	ntrace,
		integer, dimension(numnod)	itagnsol,
		integer	isolnod,
		integer, dimension(*)	part_fill,
		integer, dimension(nbsubmat,nel)	nbip,
		integer, intent(in)	nbsubmat,
		integer, intent(in)	mlw,
		type(elbuf_struct_), dimension(ngroup), intent(in), target	elbuf_tab,
		integer, intent(in)	ng,
		type (multi_fvm_struct), intent(in)	multi_fvm,
		integer, dimension(nixq,numelq), intent(in)	ixq,
		integer, dimension(nixtg,numeltg), intent(in)	ixtg,
		integer, intent(in)	ityp,
		integer, intent(in)	nel )

Parameters

[in]	n2d	2d/3d flag
	nbip	number of internal points
	ntrace	maximum number of internal points (NBIP <= NTRACE, default 7*7*7)
[in]	ixq	quad connectivity buffer
[in]	ixtg	triangles connectivity buffer
[in]	ityp	elem types of the current group (quad, triangles, hexa,)
[in]	ityp	volume fractions
[in]	mlw	material law (type)
[in]	ng	current elem group
[in]	nel	number of elements in the group

Definition at line 29 of file iniphase.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod
      USE multi_fvm_mod
      USE constant_mod , ONLY : nine_over_10
      use element_mod , only :nixs,nixq,nixtg
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-----------------------------------------------
      INTEGER,INTENT(IN) :: N2D !< 2d/3d flag
      INTEGER,INTENT(IN) :: NUMELS, NUMELTG, NUMELQ, NUMNOD, NGROUP !array sizes
      INTEGER,INTENT(IN) :: NBSUBMAT
      INTEGER IXS(NIXS,NUMELS),IPART_(*),IPHASE(NBSUBMAT+1,*),IDP,NUPARAM
      INTEGER ITAGNSOL(NUMNOD)
      INTEGER :: NBIP(NBSUBMAT,NEL)   !< number of internal points
      INTEGER :: NTRACE               !<  maximum number of internal points (NBIP <= NTRACE, default 7*7*7)
      INTEGER ISOLNOD,PART_FILL(*)
      INTEGER,INTENT(IN) :: IXQ(NIXQ,NUMELQ) !< quad connectivity buffer
      INTEGER,INTENT(IN) :: IXTG(NIXTG,NUMELTG) !< triangles connectivity buffer
      INTEGER, INTENT(IN) :: ITYP !< elem types of the current group (quad, triangles, hexa,)
      my_real kvol(nbsubmat,nel)      !< volume fractions
      my_real uparam(nuparam)
      INTEGER,INTENT(IN) :: MLW !< material law (type)
      INTEGER,INTENT(IN) :: NG  !< current elem group
      TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP), INTENT(IN) :: ELBUF_TAB
      TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
      INTEGER, INTENT(IN) :: NEL !< number of elements in the group
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: I,K,J !< loop and temporary integers
      INTEGER :: IMAT  !< submat identifier (in 1:NBSUBMAT)
      INTEGER :: IX(4) !< working array for shell nodes
      my_real :: av(nbsubmat) !< working array for volume fractions
      TYPE(G_BUFEL_) ,POINTER :: GBUF  !< global elem buffer
      TYPE(L_BUFEL_) ,POINTER :: LBUF  !< local elem buffer (submaterials)
C-----------------------------------------------
C---
C FILL ELEMENTS INPUT PHASES
C---
        av(1:nbsubmat) = zero
 
        IF(mlw==51)THEN
          !when using LAW51 nbsubmat=4
          av(1) = uparam(4)
          av(2) = uparam(5)
          av(3) = uparam(6)
          av(4) = uparam(46)
        ELSE
          gbuf => elbuf_tab(ng)%GBUF
          DO i=1,multi_fvm%NBMAT
            lbuf  => elbuf_tab(ng)%BUFLY(i)%LBUF(1,1,1) 
            av(i) = lbuf%VOL(1) / gbuf%VOL(1)              !same value for idx=1,NEL then idx=1 here.
          ENDDO
        ENDIF
C
        DO i=1,nel
          IF(ipart_(i) /= 0) THEN
            IF (ipart_(i) /= idp  .AND. part_fill(ipart_(i)) == 0) THEN
              kvol(1:nbsubmat,i)   = av(1:nbsubmat)
              part_fill(ipart_(i)) = 1
            ELSEIF (ipart_(i) == idp) THEN
              imat=maxloc(av(1:nbsubmat),1) ! The default phase is the one that is most prevalent.
              iphase(1,i)       = imat
              iphase(nbsubmat+1,i) = 1 !number of present submaterials
              kvol(imat,i)         = zero
              IF (nbip(imat,i) == 0) THEN
                nbip(imat,i) = ntrace
              ENDIF
              IF (isolnod == 8) THEN
                DO k=2,9
                  j = ixs(k,i)
                  IF(itagnsol(j) == 0)itagnsol(j) = 1
                END DO
              ELSEIF (isolnod == 4) THEN
                ix(1) =ixs(2,i)
                ix(2) =ixs(4,i)
                ix(3) =ixs(7,i)
                ix(4) =ixs(6,i)
                DO k=1,4
                  j = ix(k)
                  IF(itagnsol(j) == 0)itagnsol(j) = 1
                END do!next K
              ELSEIF(ityp == 7 .AND. n2d > 0)THEN
                  IF(itagnsol(ixtg(2,i)) == 0)itagnsol(ixtg(2,i)) = 1
                  IF(itagnsol(ixtg(3,i)) == 0)itagnsol(ixtg(3,i)) = 1
                  IF(itagnsol(ixtg(4,i)) == 0)itagnsol(ixtg(4,i)) = 1
              ELSEIF(ityp == 2)THEN
                  IF(itagnsol(ixq(2,i)) == 0)itagnsol(ixq(2,i)) = 1
                  IF(itagnsol(ixq(3,i)) == 0)itagnsol(ixq(3,i)) = 1
                  IF(itagnsol(ixq(4,i)) == 0)itagnsol(ixq(4,i)) = 1
                  IF(itagnsol(ixq(5,i)) == 0)itagnsol(ixq(5,i)) = 1
              endif!ISOLNOD
              part_fill(idp) = 1
            END if!(IPART_(I) /= IDP )
          ENDIF !IF(ipart(i) /= 0)
        END do!next I
C-----
      RETURN