int18_law151_init.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	int18_law151_init (s_append_array, ninter, npari, numnod, numels, ngrbric, multi_fvm, igrbric, ipari, ixs, x, v, ms, kinet, x_append, v_append, mass_append, kinet_append)

Function/Subroutine Documentation

int18_law151_init()

subroutine int18_law151_init	(	integer, intent(in)	s_append_array,
		integer, intent(in)	ninter,
		integer, intent(in)	npari,
		integer, intent(in)	numnod,
		integer, intent(in)	numels,
		integer, intent(in)	ngrbric,
		type(multi_fvm_struct)	multi_fvm,
		type (group_), dimension(ngrbric), intent(in)	igrbric,
		integer, dimension(npari,ninter), intent(in)	ipari,
		integer, dimension(nixs,numels), intent(in)	ixs,
		intent(in)	x,
		intent(in)	v,
		intent(in)	ms,
		integer, dimension(numnod), intent(in)	kinet,
		intent(inout)	x_append,
		intent(inout)	v_append,
		intent(inout)	mass_append,
		integer, dimension(s_append_array), intent(inout)	kinet_append )

Parameters

[in]	s_append_array	size of append arrays
[in]	ninter	number of interface
[in]	npari	size of IPARI
[in]	numnod	number of node
[in]	numels	number of solid
[in]	ngrbric	size of IGRBRIC structure

Definition at line 29 of file int18_law151_init.F.

        
!$COMMENT
!       INT18_LAW151_INIT description
!       initialization of array for /INT18 + LAW 151
!       
!       INT18_LAW151_INIT organization :
!       - x/V/MASS_append :
!            * (1:NUMNOD) : classical x/v/mass
!            * (NUMNOD+1:NUMNOD+NUMELS) : phantom node x/v/mass
!       - kinet_append :
!            * (1:NUMNOD) : classical kinet
!            * (NUMNOD+1:NUMNOD+NUMELS) : =0 (no kinet for phantom node)
!$ENDCOMMENT
C-----------------------------------------------
C     M o d u l e s
C-----------------------------------------------   
        USE multi_fvm_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   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(in) :: S_APPEND_ARRAY !< size of append arrays
        INTEGER, INTENT(in) :: NINTER !< number of interface
        INTEGER, INTENT(in) :: NPARI !< size of IPARI
        INTEGER, INTENT(in) :: NUMNOD !< number of node
        INTEGER, INTENT(in) :: NUMELS !< number of solid
        INTEGER, INTENT(in) :: NGRBRIC !< size of IGRBRIC structure
        INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI
        my_real, DIMENSION(3,NUMNOD), INTENT(in) :: x,v
        my_real, DIMENSION(3,S_APPEND_ARRAY), INTENT(inout) :: x_append,v_append
        my_real, DIMENSION(NUMNOD), INTENT(in) :: ms
        INTEGER, DIMENSION(NUMNOD), INTENT(in) :: KINET
        my_real, DIMENSION(S_APPEND_ARRAY), INTENT(inout) :: mass_append
        INTEGER, DIMENSION(S_APPEND_ARRAY), INTENT(inout) :: KINET_APPEND
        INTEGER, DIMENSION(NIXS,NUMELS), INTENT(in) :: IXS
        TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
        TYPE (GROUP_)  , DIMENSION(NGRBRIC), INTENT(in) :: IGRBRIC
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER :: N,NN,II,JJ
        INTEGER :: ISU1,NSN,NODE_ID,IBRIC
        LOGICAL, DIMENSION(:), ALLOCATABLE :: TAG
C-----------------------------------------------
        ! X/V/MASS extended 
        ! 1:NUMNOD --> classical x/v/mass
        ! NUMNOD+1:NUMNOD+NUMELS --> x/v/mass of phantom nodes (located to the center of 
        !                              the ALE elements)
        ! INT18_GLOBAL_LIST --> true if /INT18 + LAW151 for the NIN interface
        multi_fvm%INT18_GLOBAL_LIST(1:ninter) = .false.
        ALLOCATE(tag(numels))
        tag(1:numels)=.false.
        IF( multi_fvm%IS_INT18_LAW151 ) THEN
            DO n=1,multi_fvm%NUMBER_INT18
                nn = multi_fvm%INT18_LIST(n)
                multi_fvm%INT18_GLOBAL_LIST(nn) = .true.
            ENDDO
!            ! 1:NUMNOD --> classical x/v/mass
            x_append(1:3,1:numnod) = x(1:3,1:numnod)
            v_append(1:3,1:numnod) = v(1:3,1:numnod)
            mass_append(1:numnod) = ms(1:numnod)
            kinet_append(1:numnod) = kinet(1:numnod)
!            ! initialization of phantom nodes
            x_append( 1:3,numnod+1:numnod+numels ) = zero
            v_append( 1:3,numnod+1:numnod+numels ) = zero
            ! KINET : not used for phantom nodes, always equal to 0
            mass_append(numnod+1:numnod+numels) = zero
            kinet_append(numnod+1:numnod+numels) = 0
 
            DO nn=1,multi_fvm%NUMBER_INT18
                n = multi_fvm%INT18_LIST(nn)
                isu1 = ipari(45,n)
                nsn = ipari(5,n)    ! number of secondary nodes 
                DO ii = 1,nsn
                    ibric = igrbric(isu1)%ENTITY(ii) ! id of the phantom element
                    IF(.NOT. tag(ibric)) THEN ! otherwise already done with a previous interface
                      !   mass
                      mass_append(numnod + ibric) = zero
                      !   position
                      DO jj = 2, 9
                        node_id = ixs(jj, ibric) ! id of node of the phantom element
                        x_append(1, numnod + ibric) = x_append(1, numnod + ibric) + one_over_8 * x(1, node_id)
                        x_append(2, numnod + ibric) = x_append(2, numnod + ibric) + one_over_8 * x(2, node_id) 
                        x_append(3, numnod + ibric) = x_append(3, numnod + ibric) + one_over_8 * x(3, node_id)         
                      ENDDO
                      !   velocity
                      v_append(1, numnod + ibric) = multi_fvm%VEL(1, ibric)
                      v_append(2, numnod + ibric) = multi_fvm%VEL(2, ibric)
                      v_append(3, numnod + ibric) = multi_fvm%VEL(3, ibric)
                      tag(ibric)=.true.
                    ENDIF
                ENDDO
            ENDDO
        ENDIF
        IF(ALLOCATED(tag))DEALLOCATE(tag)
 
        RETURN