iniebcs_nrf_tcar.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	iniebcs_nrf_tcar (ebcs_tab, x, ixs, ixq, ixtg, pm, ipm, mat_param)
subroutine	ebcs_set_tcarp (ebcs, tcar_p)

Function/Subroutine Documentation

ebcs_set_tcarp()

subroutine ebcs_set_tcarp	(	type(t_ebcs_nrf)	ebcs,
			tcar_p )

Definition at line 196 of file iniebcs_nrf_tcar.F.

      USE ebcs_mod
#include      "implicit_f.inc"
      
      TYPE(t_ebcs_nrf) :: EBCS
      my_real :: tcar_p
      
           IF(ebcs%TCAR_P == zero) ebcs%TCAR_P = tcar_p
      

iniebcs_nrf_tcar()

subroutine iniebcs_nrf_tcar	(	type(t_ebcs_tab), intent(inout)	ebcs_tab,
		dimension(3,numnod), intent(in)	x,
		integer, dimension(nixs,numels), intent(in), target	ixs,
		integer, dimension(nixq,numelq), intent(in), target	ixq,
		integer, dimension(nixtg,numeltg), intent(in), target	ixtg,
		dimension(npropm,nummat), intent(in)	pm,
		integer, dimension(npropmi,nummat), intent(in)	ipm,
		type(matparam_struct_), dimension(nummat), intent(in)	mat_param )

Definition at line 32 of file iniebcs_nrf_tcar.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod    
      USE inigrav 
      USE ebcs_mod
      USE matparam_def_mod, ONLY : matparam_struct_
      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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "com04_c.inc"
#include      "com01_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(t_ebcs_tab), INTENT(INOUT) :: EBCS_TAB
      INTEGER,INTENT(IN),TARGET     :: IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ), IXTG(NIXTG,NUMELTG)
      my_real, INTENT(IN)           :: x(3,numnod)
      my_real,INTENT(IN)            :: pm(npropm,nummat)
      INTEGER,INTENT(IN)            :: IPM(NPROPMI,NUMMAT)
      TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: IMAT,MLN,IADBUF,IMAT_SUB,NIX,NELS,NBPHASE
      INTEGER :: TAGMAT(NUMMAT+1),II, NBMAT, KK
      my_real :: tcp_ref,xmin,ymin,zmin,xmax,ymax,zmax,ssp0,ssp0max,lc,lc0max
      INTEGER, DIMENSION(:, :), POINTER  :: IX      
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
 
       ssp0 = zero
       tagmat(1:nummat) = 0
       nels = -huge(nels)
       nix = -huge(nix)        
       ix => null()
       IF(numels>0)THEN
         nels = numels
         nix=nixs
         ix => ixs(1:nix, 1:nels)
       ELSEIF(numelq >0)THEN
         nels = numelq
         nix=nixq
         ix => ixq(1:nix, 1:nels)
       ELSEIF(n2d /=0 .AND. numeltg >0)THEN
         nels = numeltg
         nix=nixtg
         ix => ixtg(1:nix, 1:nels)    
       ENDIF
       
       !-----------------------------!
       ! CALCULATION OF SSP0MAX           !
       !-----------------------------!
       nbphase = 0
       DO ii=1,nels                                                                                                 
         imat   = ix(1,ii)
         IF(imat == 0)cycle
         IF(tagmat(imat)==1)cycle
         tagmat(imat)=1                                                                                            
         mln    = ipm(2,imat)                                                                                         
         iadbuf = ipm(7,imat)                                                                                         
         IF(mln == 51)THEN
           ssp0=pm(27,imat)
           nbphase=max(nbphase,4)
         ELSEIF(mln == 151)THEN
           nbmat =  mat_param(imat)%MULTIMAT%NB
           nbphase = max(nbphase,nbmat)
           imat_sub =  mat_param(imat)%MULTIMAT%MID(1)
           ssp0 = ipm(27,imat_sub)
           DO kk=2,nbmat
             imat_sub = mat_param(imat)%MULTIMAT%MID(kk)
             ssp0=max(ssp0,pm(27,imat_sub))
           ENDDO
         ELSE
           ssp0=pm(27,imat)
         ENDIF                                                                                  
       ENDDO                                                                                                          
       ssp0max = ssp0                                                                                                 
 
       !-----------------------------!
       ! LC ESTIMATOR            !
       !-----------------------------!
        xmin   = x(1,1)
        ymin   = x(2,1)
        zmin   = x(3,1)
        xmax   = x(1,1)
        ymax   = x(2,1)
        zmax   = x(3,1)
        DO ii=1,numnod
          xmin = min(xmin,x(1,ii))
          ymin = min(ymin,x(2,ii))
          zmin = min(zmin,x(3,ii))
          xmax = max(xmax,x(1,ii))
          ymax = max(ymax,x(2,ii))
          zmax = max(zmax,x(3,ii))
        ENDDO
        lc     = xmax-xmin
        lc     = max(lc,ymax-ymin)
        lc     = max(lc,zmax-zmin)
        lc0max = lc   
 
       !-----------------------------!
       ! CALCULATION AND ASSIGNMENT : Tcp !
       !-----------------------------!  
       IF(ssp0max == zero)THEN
         tcp_ref = ep20
       ELSE     
         tcp_ref    = lc0max/two/ssp0max/log(two)
       ENDIF
       DO kk=1,ebcs_tab%NEBCS
          select type (twf => ebcs_tab%tab(kk)%poly)
            type is (t_ebcs_nrf)
             CALL ebcs_set_tcarp(twf,tcp_ref)
         end select
       ENDDO
       
       !-----------------------------!
       ! ALLOCATION BUFFER VOL FRAC  !
       !-----------------------------!  
        !EBCS%NBMAT= NBPHASE   
        !IF(NBPHASE > 0)THEN            
        !  ALLOCATE(EBCS%PHASE_ALPHA(NBPHASE,EBCS%NB_ELEM))
        !  EBCS%PHASE_ALPHA(1:NBPHASE,1:EBCS%NB_ELEM) = ZERO
        !ENDIF
        
       !-----------------------------!
       ! OUTPUT                      !
       !-----------------------------!          
        WRITE (iout,1001)lc0max,ssp0max,tcp_ref
        
 
 1001 FORMAT(
     .//
     .'     NON REFLECTING FRONTIERS (EBCS)    '/
     .'     -------------------------------    '/
     & 5x,'INITIALIZATION OF GLOBAL PARAMETERS      ',/    
     & 5x,'CHARACTERISTIC LENGTH. . . . . . . . . .=',e12.4/
     & 5x,'REFERENCE SOUND SPEED. . . . . . . . .  =',e12.4/
     & 5x,'CHARACTERISTIC TIME (TCP). . . . . . . .=',e12.4//)